IdTCPServer Freeze on Delphi

[3ddark]

Thank you Remy for answer.

I edited and tested the code with your suggestion. The result is the same for Delphi.

I test on Ubuntu(18.04) Console app. I got the same result on Linux

Code:

//Delphi Vcl App for Windows
unit Unit1;

interface

uses
    Winapi.Windows
  , Winapi.Messages
  , System.SysUtils
  , System.Variants
  , System.Classes
  , Vcl.Controls
  , Vcl.StdCtrls
  , Vcl.Forms
  , IdTCPServer
  , IdContext
  , IdBaseComponent
  , IdComponent
  , IdCustomTCPServer;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    procedure HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: Integer);
    procedure HandleClientDisconnected(AContext: TIdContext);
    procedure UpdateClientsCount;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.Active := True;
end;

procedure TForm1.HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: Integer);
begin
  ListBox1.Items.AddObject(APeerIP + ':' + APeerPort.ToString, AContext);
  UpdateClientsCount;
end;

procedure TForm1.HandleClientDisconnected(AContext: TIdContext);
var
  n1: Integer;
begin
  n1 := ListBox1.Items.IndexOfObject(AContext);
  if n1 > -1 then
    ListBox1.Items.Delete(n1);
  UpdateClientsCount;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  PeerPort: Integer;
begin
  PeerIP := AContext.Binding.PeerIP;
  PeerPort := AContext.Binding.PeerPort;

  TThread.Queue(nil,
    procedure
    begin
      Form1.HandleClientConnected(AContext, PeerIP, PeerPort);
    end
  );
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    begin
      Form1.HandleClientDisconnected(AContext);
    end
  );
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  data: string;
begin
  data := AContext.Connection.IOHandler.ReadLn;
  if data = 'E' then
    AContext.Connection.Disconnect;
end;

procedure TForm1.UpdateClientsCount;
var
  List : TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    Caption := 'Server - Client : ' + List.Count.ToString;
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

end.

Code:

//Delphi Console App for Linux
program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    System.SysUtils
  , System.Classes
  , System.Threading
  , IdContext
  , IdBaseComponent
  , IdComponent
  , IdCustomTCPServer
  , IdTCPServer;

type
  TSocketServer = class
  private
    procedure HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: Integer);
    procedure HandleClientDisconnected(AContext: TIdContext);
    procedure UpdateClientsCount;
  public
    IdTCPServer1: TIdTCPServer;

    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    constructor Create();
    destructor Destroy; override;
  end;

var
  Server: TSocketServer;

constructor TSocketServer.Create();
begin
  inherited;
  IdTCPServer1 := TIdTCPServer.Create;
  IdTCPServer1.DefaultPort := 20000;

  IdTCPServer1.OnConnect := IdTCPServer1Connect;
  IdTCPServer1.OnDisconnect := IdTCPServer1Disconnect;
  IdTCPServer1.OnExecute := IdTCPServer1Execute;

  IdTCPServer1.Active := True;
end;

destructor TSocketServer.Destroy;
begin
  IdTCPServer1.Active := False;
  inherited;
end;

procedure TSocketServer.HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: Integer);
begin
  Writeln(AContext.Binding.PeerIP + ':' + AContext.Binding.PeerPort.ToString);
  UpdateClientsCount;
end;

procedure TSocketServer.HandleClientDisconnected(AContext: TIdContext);
begin
  UpdateClientsCount;
end;

procedure TSocketServer.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  PeerPort: Integer;
begin
  PeerIP := AContext.Binding.PeerIP;
  PeerPort := AContext.Binding.PeerPort;

  TThread.Queue(nil,
    procedure
    begin
      HandleClientConnected(AContext, PeerIP, PeerPort);
    end
  );
end;

procedure TSocketServer.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    begin
      HandleClientDisconnected(AContext);
    end
  );
end;

procedure TSocketServer.IdTCPServer1Execute(AContext: TIdContext);
var
  data: string;
begin
  data := AContext.Connection.IOHandler.ReadLn;
  if data= 'E' then
    AContext.Connection.Disconnect;
end;

procedure TSocketServer.UpdateClientsCount;
var
  List : TIdContextList;
begin
  if IdTCPServer1.Active then
  begin
    List := IdTCPServer1.Contexts.LockList;
    try
      Writeln('Server - Client : ' + List.Count.ToString);
    finally
      IdTCPServer1.Contexts.UnlockList;
    end;
  end;
end;

begin
  Server := TSocketServer.Create;
  try
    while True do
    begin
      try
        Sleep(1);
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;
    end;
  finally
    Server.Free;
  end;
end.