Server (Receive) :
Procedure TFrmServer. FormCreate (Sender: TObject);
The begin
IdTCPServer1. DefaultPort:=5616;
IdTCPServer1. Active:=True;
The end;
Procedure TFrmServer. IdTCPServer1Execute (AThread: TIdPeerThread);
Var
Rbyte: an array of byte [0.. 4096];
SFile: TFileStream;
CNT, CMD, FileSize: integer;
STR, FileName: string;
The begin
STR:=AThread. Connection. ReadLn;//receive file size and file name
CMD:=pos (' | ', STR);//find delimiters
FileName:=copy (STR, 1, CMD - 1);//extract filename
FileSize:=StrToInt (copy (STR, CMD + 1, Length (STR) - CMD + 1));//to extract the file size
If MessageBox (0, Pchar (' users' + AThread. Connection. Socket. Binding. The PeerIP + 'to give you to send file "' + FileName + '" you are to accept or reject? '), 'file accept', MB_YesNo or MB_ICONQUESTION)=ID_Yes then//ask if receive
The begin
ProgressBar1. Max:=FileSize;//initialize the progress bar
ProgressBar1. Position:=0;
SaveDialog1. FileName:=FileName;//save the default file name specified, must be in SaveDialog1. Execute; Before, otherwise empty file named
SaveDialog1. Execute;
SFile:=TFileStream. Create (SaveDialog1 FileName, fmCreate);//create a flow to write file
While FileSize> 4096 do
The begin
AThread. Connection. ReadBuffer (rbyte, 4096);//read the file flow
SFile. Write (rByte, 4096);//write file stream
CNT:=AThread. Connection. ReadInteger;//position from the sender to receive the latest schedule information
ProgressBar1. Position:=ProgressBar1. Position + CNT;//update the display progress
Label1. Caption:='current receiving schedule.. ';
StatusBar1. Panels [0]. Text:='receiving file... ';
Inc (FileSize - 4096);
The end;
AThread. Connection. ReadBuffer (rbyte FileSize);//ReadBuffer (rbyte iLen);
SFile. Write (rByte FileSize);
SFile. Free;
StatusBar1. Panels [0]. Text:='file receiving complete! ';
Label1. Caption:='file receiving complete! ';
The end;
END;
Procedure TFrmServer. FormDestroy (Sender: TObject);
The begin
IdTCPServer1. Active:=False;
Application. The Terminate;
The end;
The Client (Send) :
Procedure TFrmClient. SpeedButton1Click (Sender: TObject);
The begin
OpenDialog1. Execute;
EdtFileName. Text:=OpenDialog1. FileName;
The end;
Procedure TFrmClient. BtnSendClick (Sender: TObject);
Var
IFileHandle: integer;
IFileLen, CNT: integer;
Buf: an array of byte [0.. 4096];
The begin
If (edtAddress. Text<> ") and (edtFileName. Text<> ") then
The begin
IdTCPClient1. Host:=edtAddress. Text;
IdTCPClient1. Port:=5616;
Try
IdTCPClient1. Connect (5000);
Except,
StatusBar1. Panels [0]. Text:='connection recipients failed! ';
exit;
The end;
If IdTCPClient1. Connected then
The begin
IFileHandle:=FileOpen (edtFileName. Text, fmOpenRead);
IFileLen:=FileSeek (iFileHandle, 0, 2);
FileSeek (iFileHandle, 0, 0);
ProgressBar1. Max:=iFileLen;
ProgressBar1. Position:=0;
IdTCPClient1. WriteLn (ExtractFileName (edtFileName. Text) + '|' + IntToStr (iFileLen));
While true do
The begin
Application. ProcessMessages;
CNT:=FileRead (iFileHandle, buf, 4096);
IdTCPClient1. WriteBuffer (buf, CNT);
IdTCPClient1. WriteInteger (CNT);
ProgressBar1. Position:=ProgressBar1. Position + CNT;
StatusBar1. Panels [0]. Text:='are transferring files... ';
If cnt
The end;
FileClose (iFileHandle);
Label2. Caption:='file transfer! ';
StatusBar1. Panels [0]. Text:='file transfer! ';
The end;
End
The else
ShowMessage (' please select a file to be transmitted and/or receiver address ');
The end;
My problem out on while true do
The begin
Application. ProcessMessages;
CNT:=FileRead (iFileHandle, buf, 4096);
IdTCPClient1. WriteBuffer (buf, CNT);
IdTCPClient1. WriteInteger (CNT);
ProgressBar1. Position:=ProgressBar1. Position + CNT;
StatusBar1. Panels [0]. Text:='are transferring files... ';
If cnt
The end; Seemingly program cannot be IdTCPClient1. Continuous WriteBuffer (buf, CNT); Write operations, I will IdTCPClient1 WriteBuffer (buf, CNT);
IdTCPClient1. WriteInteger (CNT); Two commented after the program can run normally, which means file block code is no problem, wrong is wrong on this two sentences
Baidu for a long time without resolution Process Error class EIdSocketError with message 'Socket Error # 0' Error Process stopped
But on a IdTCPClient1. WriteLn (ExtractFileName (edtFileName. Text) + '|' + IntToStr (iFileLen)); Server side can normal to receive this information
Excuse me each warrior, how to troubleshoot the error online waiting for
CodePudding user response:
There is no back, his topCodePudding user response:
Look at the IdTCPClient1. WriteBuffer (buf, CNT); To IdTCPClient1. WriteBuffer (buf, CNT, true); Line not line?CodePudding user response:
Look at theIdTCPClient1. WriteBuffer (buf, CNT);
Instead of
IdTCPClient1. WriteBuffer (buf, CNT, true);
Line not line?