53959175
December 31, 2016 23:40:15Hits: 2295Delphi Idtcpclient Point-to-point transfer file
The client transfers files to another client and does not transit through the server
The important point is that the client also put a idtcpserver, that is, the client is both the client, when receiving the file is also the service side, must be corresponding to other customers
End of the connection to it, this time the client is quite with the server, well, understand this truth is good to run
A client (put a idtcpclient control, send a file)
Procedure Tformfilesend.formshow (Sender:tobject);//Connect to the server and turn yourself into a service side
Begin
Turn yourself into a service side
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 (' server started ');
End
Else
Begin
MEMO1.LINES.ADD (' server stopped ');
End
Connect to the service side
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, ' Server not open ', ' hint ', MB_OK);
Exit;
End
Loading ();//Connect to the server, display the on-line client
End
Procedure tformfilesend.loading ();
Var
Node:ttreenode;
Begin
RzCheckTree1.Items.Clear;
Sleep (500);//must be delayed here, otherwise the following data clearly have, but cannot read, 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 don't 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);//Send File
Var
Ifilehandle:integer;
Ifilelen,cnt:integer;
buf:array[0..4096] of Byte;
I:integer;
Zt:boolean;
Begin
If edit1.text= ' Then
Begin
ShowMessage (' Please select the file to upload ');
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 (' Please select recipient! ', ' hint ', 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+ ' not online ');
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 does
Begin
Application.processmessages;
Cnt:=fileread (ifilehandle,buf,4096);
Idtcpclient2.writebuffer (BUF,CNT);
Progressbar1.position:=progressbar1.position + cnt;
MEMO1.LINES.ADD (' Transferring files ... ' +datetimetostr (now));
If cnt<4096 Then
Break
End
FileClose (Ifilehandle);
MEMO1.LINES.ADD (' File transfer complete! ') +datetimetostr (now));
End
End
End
Procedure Tformfilesend.speedbutton5click (Sender:tobject);//Cancel Send
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+ ' not online ');
Continue
End
Idtcpclient2.writeln (' Cancel send ');
Idtcpclient2.disconnect;
End
End
Sleep (500);
Memo1.Lines.Add (' Cancel file send ' +datetimetostr (now));
End
b Client (to put a idtcpserver control, equivalent to server-side receive)
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//note here
Begin
With Athread.connection do
Begin
Try
STR:=ATHREAD.CONNECTION.READLN;
If POS (' | ', str) >0 Then
Begin
Cmd:=pos (' | ', str); Find delimiter
Filename:=copy (str,1,cmd-1); Extract file name
Filesize:=strtoint (Copy (Str,cmd+1,length (str)-cmd+1)); Extract File Size
If MessageBox (0,pchar (' Do you have files ' ' +filename+ ' "Do you accept or reject? '), ' file accepted ', Mb_yesno or mb_iconquestion) =id_yes
then//ask whether to receive
Begin
Progressbar1.max:=filesize Div 100; Initializing the progress bar
progressbar1.position:=0;
Savedialog1.filename:=filename; Specify the saved default file name, be sure to Savedialog1.execute before, otherwise the file name is empty
Savedialog1.execute;
Sfile:=tfilestream.create (savedialog1.filename,fmcreate); Create a file stream to write to
While filesize>4096 do
Begin
Application.processmessages;
AThread.Connection.ReadBuffer (rbyte,4096);//Read file stream
Progressbar1.position:=progressbar1.position + (4096 div 100); Update Display Progress
MEMO1.LINES.ADD (' Receiving files ... ' +datetimetostr (now));
Sfile.write (rbyte,4096); Write file stream
Inc (FILESIZE,-4096);
End
AThread.Connection.ReadBuffer (rbyte,filesize);//. Readbuffer (Rbyte,ilen);
Sfile.write (rbyte,filesize);
Sfile.free;
MEMO1.LINES.ADD (' File receive complete! ') +datetimetostr (now));
End
End
Finally
disconnect;//disconnecting
End
End
End
End
Delphi idtcpclient Idtcpserver Point-to-point transfer file
