Delphi IdTCPClient 点对点传送文件

客户端向另一个客户端传送文件，不通过服务端中转
那一个很重要的点是，这个客户端也要放一个IdTCPServer，也就是说这个客户端既是客户端，当接收文件的时候也是服务端，必须相应其它客户

端对它的连接，这个时候客户端相当与服务端，好了，明白这个道理就好办了

A客户端（放一个IdTCPClient控件，发送文件）

procedure TFormFileSend.FormShow(Sender: TObject);//连接到服务端，同时自己变成服务端

begin

  //自己变成服务端

  IdTCPServer1.Bindings.Clear;

  IdTCPServer1.Bindings.Add.IP:='192.168.252.1';

  IdTCPServer1.Bindings.Add.Port:=8831;

  IdTCPServer1.Active:=true;

  if  IdTCPServer1.Active then

  begin

    Memo1.Lines.Add('服务器已启动');

  end

  else

  begin

    Memo1.Lines.Add('服务器已停止');

  end;

  //连接到服务端

  IdTCPClient1.Host:=FormMain.host;//'192.168.252.1';

  IdTCPClient1.Port:=StrToInt(FormMain.port);//8829;

  if IdTCPClient1.Connected then

    IdTCPClient1.Disconnect;

  Try

    IdTCPClient1.Connect;

    IdTCPClient1.WriteLn(FormMain.qm+'|'+FormMain.bh);

  except

    MessageBox(Handle,'服务器没有开启','提示',MB_OK);

    Exit;

  end;

  loading();//连接到服务端，显示上线的客户端

end;

procedure TFormFileSend.loading();

var

  Node: TTreeNode;

begin

  RzCheckTree1.Items.Clear;

  sleep(500);//这里一定要延时，不然下面的数据明明有，但是读不出来， 2016-12-31

  

  with ADOQuery2 do

  begin

    SQL.Clear;

    SQL.Add('select a.ip,a.bh,a.qm,c.qm as bm from ipdz a left join zy b on a.bh=b.bh left join bm c on b.szbm=c.bh ');

    Open;

    while not Eof do

    begin

      Node := RzCheckTree1.Items.AddChild(nil,FieldByName('qm').AsString+'（'+FieldByName('bm').AsString+'）'+FieldByName('ip').AsString);

      Node.Data:=strnew(PChar(FieldByName('ip').AsString));

      Next;

    end;

  end;

end;

procedure TFormFileSend.SpeedButton1Click(Sender: TObject);//发送文件
var
  iFileHandle:integer;
  iFileLen,cnt:integer;
  buf:array[0..4096] of byte;

  i: integer;
  zt:Boolean;
begin
  if Edit1.Text='' then
  begin
    ShowMessage('请选择要上传的文件');
    Exit;
  end;

  zt:=False;
  for i:=0 to RzCheckTree1.Items.Count - 1 d
4000
o
  begin
    if RzCheckTree1.ItemState[i] = cschecked then
    begin
      zt:=True;
    end;
  end;
  if zt=False then
  begin
    Application.MessageBox('请选择接收人！','提示',64);
    exit;
  end;

  for i:=0 to RzCheckTree1.Items.Count - 1 do
  begin
    if RzCheckTree1.ItemState[i] = cschecked then
    begin
      IdTCPClient2.Host:=PChar(RzCheckTree1.Items.Item[i].Data);
      IdTCPClient2.Port:=8831;
      if IdTCPClient2.Connected then
        IdTCPClient2.Disconnect;
      Try
        IdTCPClient2.Connect;
      except
        Memo1.Lines.Add(RzCheckTree1.Items.Item[i].Text+'不在线');
        continue;
      end;

      iFileHandle:=FileOpen(Edit1.Text,fmOpenRead);
      iFileLen:=FileSeek(iFileHandle,0,2);
      FileSeek(iFileHandle,0,0);
      ProgressBar1.Max:=iFileLen;
      ProgressBar1.Position := 0;
      IdTCPClient2.WriteLn(ExtractFileName(Edit1.Text)+'|'+IntToStr(iFileLen));
      while true do
      begin
        Application.ProcessMessages;
        cnt:=FileRead(iFileHandle,buf,4096);
        IdTCPClient2.WriteBuffer(buf,cnt);
        ProgressBar1.Position:=ProgressBar1.Position + cnt;
        Memo1.Lines.Add('正在传送文件...'+DateTimeToStr(Now));
        if cnt<4096 then
          break;
      end;
      FileClose(iFileHandle);
      Memo1.Lines.Add('文件传送完成!'+DateTimeToStr(Now));
    end;
  end;

end;

procedure TFormFileSend.SpeedButton5Click(Sender: TObject);//取消发送

var

  i:Integer;

begin

  FileClose(iFileHandle);

  IdTCPClient2.Disconnect;

  for i:=0 to RzCheckTree1.Items.Count - 1 do

  begin

    if RzCheckTree1.ItemState[i] = cschecked then

    begin

      IdTCPClient2.Host:=PChar(RzCheckTree1.Items.Item[i].Data);

      IdTCPClient2.Port:=8831;

      if IdTCPClient2.Connected then

        IdTCPClient2.Disconnect;

      Try

        IdTCPClient2.Connect;

      except

        Memo1.Lines.Add(RzCheckTree1.Items.Item[i].Text+'不在线');

        continue;

      end;

      IdTCPClient2.WriteLn('取消发送');

      IdTCPClient2.Disconnect;

    end;

  end;

  //Sleep(500);

  Memo1.Lines.Add('取消文件发送'+DateTimeToStr(Now));

end;

B客户端（要放一个IdTCPServer控件，相当于服务端接收）

procedure TFormFileSend.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  rbyte:array[0..4096] of byte;
  sFile:TFileStream;
  cmd,FileSize:integer;
  str,FileName:string;
begin
  if not AThread.Terminated and AThread.Connection.Connected then  //注意这里
  begin
    with AThread.Connection do
    begin
      Try
        str:=AThread.Connection.ReadLn;
        if POS('|',str)>0 then
        begin
          cmd:=pos('|',str); //查找分隔符
          FileName:=copy(str,1,cmd-1); //提取文件名
          FileSize:=StrToInt(copy(str,cmd+1,Length(str)-cmd+1)); //提取文件大小
          if MessageBox(0,Pchar('您有文件 "'+FileName+'" 您是接受还是拒绝?'),'文件接受',MB_YesNo or MB_ICONQUESTION)=ID_Yes 

then //询问是否接收
          begin
              ProgressBar1.Max:=FileSize div 100;   //初始化进度条
              ProgressBar1.Position:=0;
              SaveDialog1.FileName:=FileName; //指定保存的默认文件名,一定要在 SaveDialog1.Execute;之前,不然文件名为空
              SaveDialog1.Execute;
              sFile:=TFileStream.Create(SaveDialog1.FileName,fmCreate); //创建待写入的文件流
              While FileSize>4096 do
              begin
                Application.ProcessMessages;

                AThread.Connection.ReadBuffer(rbyte,4096);// 读取文件流

                ProgressBar1.Position:=ProgressBar1.Position + (4096 div 100); //更新显示进度
                Memo1.Lines.Add('正在接收文件中...'+DateTimeToStr(Now));

                sFile.Write(rByte,4096);      //写入文件流
                inc(FileSize,-4096);
              end;
              AThread.Connection.ReadBuffer(rbyte,FileSize);// .ReadBuffer(rbyte,iLen);
              sFile.Write(rByte,FileSize);
              sFile.Free;
              Memo1.Lines.Add('文件接收完成!'+DateTimeToStr(Now));
          end;
        end;
      Finally
        //Disconnect;//断开连接
      end;
    end;
  end;      
end;