Delphi IdTCPClient IdTCPServer 点对点传送文件

概述https://blog.csdn.net/luojianfeng/article/details/53959175   2016年12月31日 23:40:15 阅读数：2295 Delphi     IdTCPClient 点对点传送文件 客户端向另一个客户端传送文件，不通过服务端中转 那一个很重要的点是，这个客户端也要放一个IdTCPServer，也就是说这个客户端既是客户端，当接收文件的时

https://blog.csdn.net/luojianfeng/article/details/53959175

 

2016年12月31日 23:40:15 阅读数：2295

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 do
  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,2);
      fileSeek(ifileHandle,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; 总结

以上是内存溢出为你收集整理的Delphi IdTCPClient IdTCPServer 点对点传送文件全部内容，希望文章能够帮你解决Delphi IdTCPClient IdTCPServer 点对点传送文件所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。