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;
