Pass from OnRead event to separated Thread

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.