Your sender code is not handling the possibility of SendText() and SendStream() sending partial data, especially in non-blocking mode. SendStream() MAY OR MAY NOT free the TStream before exiting and you have no way of knowing one way or the other. SendText() doesn't handle Unicode strings correctly in D2009+.
Your receiver code is not taking into account that ReceiveText() MAY NOT and likely WILL NOT receive all of the data in a single read. It CAN and likely WILL take multiple OnClientRead events to receive all of the data. Or that ReceiveText() MAY receive portions of your image data and incorrectly try to convert those bytes into string characters. Also, you are not caching unprocessed bytes between OnClientRead events if data is incomplete in a single read.
So, just DON'T use SendText()/SendStream() or ReceiveText() at all! You are not using them correctly, especially in non-blocking mode. Always use SendBuf() and ReceiveBuf() instead, and pay attention to their return values so you know when you need to call them again to handle more data.
Try something more like this:
unit Unit1;
interface
uses
..., System.Win.ScktComp;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Vcl.Imaging.jpeg, System.Math;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Host := '192.168.0.10';
ClientSocket1.Port := 1234;
ClientSocket1.Active := True;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
var
B: TBitmap;
J: TJpegImage;
MS: TMemoryStream;
Sent: Boolean;
function htonll(Value: UInt64): UInt64;
var
UL: Windows.ULARGE_INTEGER;
L: UInt32;
begin
UL.QuadPart := Value;
L := htonl(UL.HighPart);
LParts.HighPart := htonl(UL.LowPart);
LParts.LowPart := L;
Result := UL.QuadPart;
end;
function DoSend(Buf: Pointer; BufLen: Integer): Boolean;
var
P: PByte;
BytesSent: Integer;
begin
Result := False;
P := PByte(Buf);
while BufLen > 0 do
begin
BytesSent := Socket.SendBuf(P^, BufLen);
if BytesSent = -1 then
begin
if WSAGetLastError = WSAEWOULDBLOCK then
begin
// TODO: use Winsock.select() or TClientSocket.OnWrite to detect when
// the socket can accept more bytes again...
Continue;
end;
Exit;
end;
Inc(P, BytesSent);
Dec(BufLen, BytesSent);
end;
Result := True;
end;
function DoSendStream(Stream: TStream): Boolean;
const
MaxChunkSize: UInt64 = 1024;
var
Size, TempSize: UInt64;
Buf: array[0..1023] of Byte;
ChunkSize: Integer;
begin
Result := False;
Size := Strm.Size - Strm.Position;
TempSize := htonll(Size);
if not DoSend(@TempSize, SizeOf(TempSize)) then Exit;
while Size > 0 do
begin
ChunkSize := Integer(Min(Size, MaxChunkSize));
Stream.ReadBuffer(buf[0], ChunkSize);
if not DoSend(@buf[0], ChunkSize) then Exit;
Dec(Size, ChunkSize);
end;
Result := True;
end;
begin
// NOTE: the DoSend...() functions above are written to operate in a blocking
// manner, even if the socket is set to non-blocking mode! If you truly want
// to operate in a non-blocking manner, you need to handle the case where
// SendBuf() reports a WSAEWOULDBLOCK error by stopping the sending immediately,
// cache any unsent bytes, exit and let code flow return to the main message loop,
// and wait for the TClientSocket.OnWrite event to fire before sending the cached
// and subsequent bytes. Repeat every time WSAEWOULDBLOCK is reported...
try
MS := TMemoryStream.Create;
try
J := TJpegImage.Create;
try
B := TBitmap.Create;
try
B.LoadFromFile('sent.bmp');
J.Assign(B);
finally
B.Free;
end;
J.CompressionQuality := 100;
J.SaveToStream(MS);
finally
J.Free;
end;
MS.Position := 0;
//ShowMessage(IntToStr(Round(MS.Size / 1024)));
Sent := DoSendStream(MS);
finally
MS.Free;
end;
finally
Socket.Close;
end;
ShowMessage(BoolToStr(Sent));
end;
end.
unit Unit1;
interface
uses
... System.Win.ScktComp;
type
TForm1 = class(TForm)
Button1: TButton;
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Vcl.Imaging.jpeg, System.Math;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ServerSocket1.Port := 1234;
ServerSocket1.Active := True;
end;
type
SocketState = (ReadingSize, ReadingData);
TSocketHelper = class
public
Buffer: array[0..1023] of Byte;
BufSize: Integer;
ExpectedSize: UInt64;
Stream: TMemoryStream;
State: SocketState;
constructor Create;
destructor Destroy; override;
end;
constructor TSocketHelper.Create;
begin
BufSize := 0;
ExpectedSize := 0;
Stream := TMemoryStream.Create;
State := ReadingSize;
end;
destructor TSocketHelper.Destroy;
begin
Stream.Free;
inherited;
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TSocketHelper.Create;
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketHelper(Socket.Data).Free;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
SH: TSocketHelper;
jpg: TJpegImage;
function ntohll(Value: UInt64): UInt64;
var
UL: Windows.ULARGE_INTEGER;
L: UInt32;
begin
UL.QuadPart := Value;
L := ntohl(UL.HighPart);
LParts.HighPart := ntohl(UL.LowPart);
LParts.LowPart := L;
Result := UL.QuadPart;
end;
begin
SH := TSocketHelper(Socket.Data);
repeat
case SH.State of
ReadingSize: begin
while SH.BufSize < SizeOf(UInt64) do
begin
BytesReceived := Socket.ReceiveBuf(SH.Buffer[SH.BufSize], SizeOf(UInt64) - SH.BufSize);
if BytesReceived <= 0 then Exit;
Inc(SH.BufSize, BytesReceived);
end;
SH.ExpectedSize := ntohll(PUInt64(@SH.Buffer)^);
SH.Data.Clear;
SH.State := ReadingData;
//ShowMessage(IntToStr(Round(SH.ExpectedSize / 1024)));
Continue;
end;
ReadingData: begin
while SH.ExpectedSize > 0 do
begin
BytesReceived := Socket.ReceiveBuf(SH.Buffer[0], Integer(Min(SH.ExpectedSize, SizeOf(SH.Buffer))));
if BytesReceived <= 0 then Exit;
Dec(SH.ExpectedSize, BytesReceived);
SH.Data.WriteBuffer(SH.Buffer[0], BytesReceived);
end;
try
jpg := TJpegImage.Create;
try
SH.Data.Position := 0;
jpg.LoadFromStream(SH.Data);
jpg.SaveToFile('received.jpg');
finally
jpg.Free;
end;
finally
SH.Data.Clear;
SH.BufSize := 0;
SH.State := ReadingSize;
end;
Continue;
end;
end;
until False;
end;
end.
