procedure TForm1. Button2Click (Sender: TObject);//send a file 
Var 
Buf: an array of Byte; 
AFilehand: Integer; 
AFilesize: Int64; 
CMD: string; 
AFilename: string; 
The begin 
If OpenDialog1. Execute then 
The begin 
AFilename:=OpenDialog1. FileName; 
AFilehand:=FileOpen (AFilename fmOpenRead); 
AFilesize:=FileSeek (AFilehand, 0, 2); 
FileSeek (AFilehand, 0, 0); 
CMD=IntToStr (AFilesize); 
WSocket1. SendStr (AnsiString (CMD)); 
SetLength (Buf, 4096); 
While AFilesize> 4096 do 
The begin 
FileRead (AFilehand, Buf [0], 4096); 
WSocket1. Send (@ Buf, 4096); 
Memo1. Lines. The Add (' is sending file... '+ TimeToStr (Now)); 
AFilesize:=AFilesize - 4096; 
end; 
FileRead (AFilehand, Buf [0], AFilesize); 
WSocket1. Send (Buf, AFilesize); 
Memo1. Lines. The Add (' files sent '); 
SetLength (Buf, 0); 
FileClose (AFilehand); 
end; 

end; 

Procedure TForm1. WSocketServer1DataAvailable (Sender: TObject; ErrCode: Word);//accept file 
Var 
Buf: an array of Byte; 
AFilehand: Integer; 
CMD: string; 
AFilesize: Int64; 
Client: TWSocketClient; 
The begin 
Client:=TWSocketClient (Sender); 
If Assigned (Client) then 
The begin 
CMD:=Client. ReceiveStr; 
Memo2. Lines. The Add (CMD); 
AFilesize:=StrToInt64 (CMD); 
AFilehand:=FileCreate (' E: \ tmp888 JPG); 
SetLength (Buf, 4096); 
While AFilesize> 4096 do 
The begin 
Client. The Receive (@ Buf, 4096); 
FileWrite (AFilehand, Buf [0], 4096); 
Memo2. Lines. The Add (' is undergoing file... '+ TimeToStr (Now)); 
AFilesize:=AFilesize - 4096; 
end; 
Client. The Receive (@ Buf, AFilesize); 
FileWrite (AFilehand, Buf [0], AFilesize); 
Memo2. Lines. The Add (' file to accept to complete... '+ TimeToStr (Now)); 
SetLength (Buf, 0); 
FileClose (AFilehand); 
end; 
end; 

This code to the wrong where why cannot accept file! And in addition to the size of the display file and the code in memo2

CodePudding user response:

Refer to https://www.cnblogs.com/devcjq/articles/2474699.html

 

The service side 
Var 
FS: TFileStream; 
FileSize: Int64; 

Procedure TForm1. WSocketServer1DataAvailable (Sender: TObject; 
ErrCode: Word); 
Var 
ILen iCmdType: Integer; 
Client: TWSocketClient; 
SFN: string; 
Buf: Pointer; 
MS: TMemoryStream; 
The begin 
Client:=TWSocketClient (Sender); 
If Assigned (Client) then 
The begin 
ILen:=Client. RcvdCount; 
GetMem (Buf, iLen); 
Try 
Client. The Receive (Buf, iLen); 
MS:=TMemoryStream. Create; 
Try 
Ms. WriteBuffer (Buf ^ iLen); 
Ms. Position:=0; 
Ms. Read (iCmdType, sizeof (iCmdType)); 
If iCmdType=1 then 
The begin 
Ms. ReadBuffer (iLen, sizeof (iLen)); 
SetLength (sFN, iLen); 
Ms. ReadBuffer (sFN [1], iLen); 
Ms. ReadBuffer (FileSize, sizeof (FileSize)); 
If Assigned (FS) then FreeAndNil (FS); 
FS:=TFileStream. Create ('/' + sFN, fmCreate); 
ICmdType:=11; 
Client. The Send (@ iCmdType, sizeof (iCmdType)); 
End 
Else if iCmdType=2 then 
The begin 
ICmdType:=- 12; 
Client. The Send (@ iCmdType, sizeof (iCmdType)); 
End 
Else if iLen> 0 then 
The begin 
FS. WriteBuffer (Buf ^ iLen); 
ICmdType:=- 12; 
Client. The Send (@ iCmdType, sizeof (iCmdType)); 
If the FS. Position>=FileSize then FreeAndNil (FS); 
end; 
The finally 
MS. The Free; 
end; 
The finally 
FreeMem (Buf); 
end; 
end; 
end; 

Procedure TForm1. FormCreate (Sender: TObject); 
The begin 
WSocketServer1. Close; 
WSocketServer1. Addr:='127.0.0.1; 
WSocketServer1. Port:='1235'; 

WSocketServer1. Listen; 
end; 

Procedure TForm1. WSocketServer1ClientConnect (Sender: TObject; 
Client: TWSocketClient; Error: Word); 
The begin 
Client. OnDataAvailable:=WSocketServer1DataAvailable; 
end; 

The client 
Var 
FS: TFileStream; 
FFileSize: Int64; 

Procedure TForm1. Button1Click (Sender: TObject); 
Var 
ICmdType iLen: Integer; 
SFN: string; 
FS: TFileStream; 

Procedure SendFileInfo; 
Var 
MS: TMemoryStream; 
The begin 
MS:=TMemoryStream. Create; 
Try 
ILen:=length (sFN); 
ICmdType:=1; 
Ms. Write (iCmdType, sizeof (iCmdType)); 
Ms. Write (iLen, sizeof (iLen)); 
Ms. Write (sFN [1], iLen); 
Ms. Write (FFileSize, sizeof (FFileSize)); 
Ms. Position:=0; 
WSocket1. Send (Ms. Memory, Ms. Size); 
The finally 
MS. The Free; 
end; 
end; 
The begin 
If OpenDialog1. Execute then 
The begin 
SFN:=ExtractFileName (OpenDialog1. FileName); 
FS:=TFileStream. Create (sFN, fmOpenRead); 
Try 
FFileSize:=FS. Size; 
The finally 
FS. Free; 
end; 

SendFileInfo; 
end; 
end; 

Procedure TForm1. FormCreate (Sender: TObject); 
The begin 
WSocket1. Addr:='127.0.0.1; 
WSocket1. Port:='1235'; 
WSocket1. Connect; 
WSocket1. OnDataAvailable:=WSocket1DataAvailable; 
end; 

Procedure TForm1. WSocket1DataAvailable (Sender: TObject; ErrCode: Word); 
nullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnullnull