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.

How is this any different than your [previous question](https://stackoverflow.com/questions/57533637/)? — Remy Lebeau, Aug 22 '19 at 15:19
@RemyLebeau, on previous question i had asked how send/receive the frames and i found a solution. Here i'm asking how modify this solution to work in a separated thread (Socket NonBlocking). — FLASHCODER, Aug 22 '19 at 15:45
as I told you earlier, you should NOT be using non-blocking mode with threads, thread-blocking mode works better and is easier to work with. And you should be using the `TServerSocket.OnGetThread` event instead of using `TThread` manually in the `TServerSocket.OnAccept` event — Remy Lebeau, Aug 22 '19 at 18:02
@RemyLebeau, i understood your recomendation, but my project already using NonBlocking and `TThread` for others tasks and by i now not want change this. Then you could , if possible, show me a code example about how stays this code above with `TThread` + **Socket NonBlocking** please? — FLASHCODER, Aug 22 '19 at 18:10
You use threads to offload blocking tasks, that would be a pointless exercise. — Sertac Akyuz, Aug 22 '19 at 19:05
@BrowJr like Sertac said. It is pointless to use non-blocking sockets inside of threads. But, if you must do so, then you must run a message loop inside the thread, because in non-blocking mode `TCustomWinSocket` allocates an HWND to use with Winsock's `WSAAsyncSelect()` to detect activity on the socket. Such a message loop with just complicate your thread design. So please, just use thread-blocking mode in a thread, it exists for a reason, use it. — Remy Lebeau, Aug 22 '19 at 20:40
@RemyLebeau, then [this](https://stackoverflow.com/a/15079703/9708179) is the solution, ok? — FLASHCODER, Aug 22 '19 at 21:20
@BrowJr no, because the HWND created by the accepted socket will not be associated with your worker thread, so a message loop inside your thread will not work. Please, just use the server in thead-blocking mode. Let the server handle the threading for you. — Remy Lebeau, Aug 22 '19 at 21:27
@RemyLebeau, *"`Please, just use the server in thead-blocking mode. Let the server handle the threading for you.`"*, but not exists none "small" modification that can be made on code above to not need mandatory use blocking mode? when you said in message loop i thinked that example that linked could works, but if really not exists a possibility of modification on code, i will accept your sugestion of socket in blocking mode. — FLASHCODER, Aug 22 '19 at 21:36
@BrowJr no, the answer you linked to will not work in this case, because you are not activating the server in the same thread that processes clients. The non-blocking HWND allocated for each client will not be associated with your worker threads, so adding message loops will not solve your problem. I've now written up an answer that demonstrates how to use the server in thread-blocking mode in this situation. — Remy Lebeau, Aug 22 '19 at 22:05
@RemyLebeau, *"`no, the answer you linked to will not work in this case, because you are not activating the server in the same thread that processes clients. The non-blocking HWND allocated for each client will not be associated with your worker threads, so adding message loops will not solve your problem`"* OK, understood, thank you by this explanation. — FLASHCODER, Aug 22 '19 at 23:35
@RemyLebeau, after in your free moments, can see (if want) [this project](https://github.com/Maickonn/Delphi_Remote_Access_PC) of Remote Access in Delphi. He is using the `ServerSocket` of same way that my code above. This was my reference. To you (and others Delphi professional programmers here), not seems the right when is working with Sockets NonBloking + Threads, but he have the same approach of my code above :-) — FLASHCODER, Aug 22 '19 at 23:45
@BrowJr I see a LOT of mistakes in that project's code. A lot of assumptions, bad IO/error handling, thread-unsafe operations, etc. It is not a good example to base your code on. — Remy Lebeau, Aug 23 '19 at 00:05
@BrowJr Anybody and everybody can put their code on GitHub, regardless of quality. Looks like that project was originally written in Delphi 7, which even at that time those components were quite aged. — Jerry Dodge, Aug 23 '19 at 18:18

Remy Lebeau · Accepted Answer · 2019-08-23T00:08:10.220

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.

`StreamSize := ntohl(TempSize);`, on first code, where **`TempSize`** is filled? — FLASHCODER, Aug 23 '19 at 00:04
@BrowJr I had removed `TempSize` as it was not needed, but I forgot to remove it from that `ntohl()` call. It is fixed now. — Remy Lebeau, Aug 23 '19 at 00:08

Pass from OnRead event to separated Thread

1 Answers1