Pass from OnRead event to separated Thread - multithreading

Question

I'm working in a project where want receive continuous frames of a live webcam and i found this code example that in my tests worked fine. Now want know how can make this receiving inside a TThread (Socket NonBlocking) similar to approach of Server multiclient/multithread? I tried this, but the server not received none frame from client. I hope that you can help me.
Server:
uses
System.Win.ScktComp, Winapi.WinSock, Vcl.Imaging.jpeg, System.Math;
type
TMyThread = class(TThread)
private
Socket: TCustomWinSocket;
protected
procedure Execute; override;
public
constructor Create(aSocket: TCustomWinSocket);
end;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
ServerSocket1: TServerSocket;
procedure ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Button1Click(Sender: TObject);
procedure ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
MyThread: TMyThread;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TMyThread.Create(aSocket: TCustomWinSocket);
begin
inherited Create(True);
Socket := aSocket;
FreeOnTerminate := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ServerSocket1.Port := 1234;
ServerSocket1.Active := true;
end;
procedure TForm1.ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket);
begin
MyThread := TMyThread.Create(Socket);
MyThread.Start;
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := nil;
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
if Socket.Data <> nil then
TMemoryStream(Socket.Data).Free;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
end;
procedure TForm1.ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
begin
ShowMessage('Server listen on port: ' + IntToStr(Socket.LocalPort));
end;
procedure TMyThread.Execute;
var
Stream: TMemoryStream;
BytesReceived: Integer;
StreamSize, TempSize: Int32;
BytesRemaining: Int64;
P: PByte;
ChunkSize: Integer;
jpg: TJpegImage;
const
MaxChunkSize: Int64 = 8192;
begin
while Socket.Connected do
begin
Stream := TMemoryStream(Socket.Data);
if Stream = nil then
begin
if Socket.ReceiveLength < SizeOf(TempSize) then
Exit;
BytesReceived := Socket.ReceiveBuf(TempSize, SizeOf(TempSize));
if BytesReceived <= 0 then
Exit;
StreamSize := ntohl(TempSize);
Stream := TMemoryStream.Create;
Socket.Data := Stream;
Stream.Size := StreamSize;
BytesRemaining := StreamSize;
end
else
BytesRemaining := Stream.Size - Stream.Position;
if BytesRemaining > 0 then
begin
P := PByte(Stream.Memory);
if Stream.Position > 0 then
Inc(P, Stream.Position);
repeat
ChunkSize := Integer(Min(BytesRemaining, MaxChunkSize));
BytesReceived := Socket.ReceiveBuf(P^, ChunkSize);
if BytesReceived <= 0 then
Exit;
Inc(P, BytesReceived);
Dec(BytesRemaining, BytesReceived);
Stream.Seek(BytesReceived, soCurrent);
until BytesRemaining = 0;
end;
try
jpg := TJpegImage.Create;
try
Stream.Position := 0;
jpg.LoadFromStream(Stream);
Synchronize(
procedure
begin
Form1.Image1.Picture.Assign(jpg);
end);
finally
jpg.Free;
end;
finally
Socket.Data := nil;
Stream.Free;
end;
end;
end;
end.

Answer 1

You need to use the TServerSocket in thread-blocking mode in order to effectively use worker threads with its accepted clients. Non-blocking mode and worker threads don't mix well together.
Non-blocking mode was invented to be able to use TClientSocket and TServerSocket in the main UI thread without blocking it. But when using sockets outside of the main UI thread, there is very little use for non-blocking mode (just some corner cases that don't apply to your situation). Internally, TCustomWinSocket allocates an HWND to detect socket activity when used in non-blocking, and that HWND requires a message loop. But since each accepted client socket is created outside of your worker threads, their HWNDs will not be able to be serviced by any message loop you run in your threads. So all the more reason why you need to use thread-blocking mode anyway.
Also, using thread-blocking mode will greatly simplify your socket I/O code anyway.
Try something more like this:
unit Unit1;
interface
uses
..., System.Win.ScktComp;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
ServerSocket1: TServerSocket;
procedure Button1Click(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ServerSocket1GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
procedure ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Winapi.WinSock, Vcl.Imaging.jpeg, System.Math;
{$R *.dfm}
type
TMyThread = class(TServerClientThread)
protected
procedure ClientExecute; override;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// this can be set at design-time, if desired...
ServerSocket1.ServerType := TServerType.stThreadBlocking;
// so can this...
ServerSocket1.Port := 1234;
ServerSocket1.Active := True;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
end;
procedure TForm1.ServerSocket1GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
SocketThread := TMyThread.Create(False, ClientSocket);
end;
procedure TForm1.ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
begin
ShowMessage('Server listen on port: ' + IntToStr(Socket.LocalPort));
end;
procedure TMyThread.ClientExecute;
var
Stream: TMemoryStream;
StreamSize: Int32;
jpg: TJpegImage;
function DoRead(Buffer: Pointer; BufSize: Int64): Boolean;
const
MaxChunkSize: Int64 = 8192;
var
P: PByte;
BytesReceived: Integer;
ChunkSize: Integer;
begin
Result := False;
P := PByte(Buffer);
while BufSize > 0 do
begin
ChunkSize := Integer(Min(BufSize, MaxChunkSize));
BytesReceived := ClientSocket.ReceiveBuf(P^, ChunkSize);
if BytesReceived <= 0 then
Exit;
Inc(P, BytesReceived);
Dec(BufSize, BytesReceived);
end;
Result := True;
end;
begin
while (not Terminated) and ClientSocket.Connected do
begin
if not DoRead(#StreamSize, SizeOf(StreamSize)) then Exit;
StreamSize := ntohl(StreamSize);
if StreamSize <= 0 then Continue;
jpg := TJpegImage.Create;
try
Stream := TMemoryStream.Create;
try
Stream.Size := StreamSize;
if not DoRead(Stream.Memory, StreamSize) then Exit;
Stream.Position := 0;
jpg.LoadFromStream(Stream);
finally
Stream.Free;
end;
Synchronize(
procedure
begin
Form1.Image1.Picture.Assign(jpg);
end
);
finally
jpg.Free;
end;
end;
end;
end.
That being said, I strongly suggest you stop using these outdated and deprecated socket components from Borland's legacy. For instance, Indy 10 ships pre-installed in the IDE, and has a TIdTCPServer component that will greatly simplify the above threading logic even further (TIdTCPServer is a multi-threaded component and will manage per-client threads for you), eg:
unit Unit1;
interface
uses
..., IdContext, IdTCPServer;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
IdTCPServer1: TIdTCPServer;
procedure Button1Click(Sender: TObject);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer1Execute(AContext: TIdContext);
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
IdTCPServer1.DefaultPort := 1234;
IdTCPServer1.Active := True;
ShowMessage('Server listen on port: ' + IntToStr(IdTCPServer1.DefaultPort));
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
// tell ReadStream() to read the stream size as an Int32 and not as an Int64...
AContext.Connection.IOHandler.LargeStream := False;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Stream: TMemoryStream;
jpg: TJpegImage;
begin
// OnExecute is a looped event, it is called in a continuous
// loop for the lifetime of the TCP connection...
jpg := TJpegImage.Create;
try
Stream := TMemoryStream.Create;
try
// ReadStream() can read the stream size first, then read the stream data...
AContext.Connection.IOHandler.ReadStream(Stream, -1, False);
Stream.Position := 0;
jpg.LoadFromStream(Stream);
finally
Stream.Free;
end;
TThread.Synchronize(nil,
procedure
begin
Form1.Image1.Picture.Assign(jpg);
end
);
finally
jpg.Free;
end;
end;
end.