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,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;