Disconnect unknow connections at TIdTcpServer OnConnect

Question

I'm having a problem. I created a TIdTCPServer but I need to prevent false/unknown connections.

I tried this:

procedure Wait(millisecs: Integer);
var
  tick: dword;
  AnEvent: THandle;
begin
  AnEvent := CreateEvent(nil, False, False, nil);
  try
    tick := GetTickCount + dword(millisecs);
    while (millisecs > 0) and (MsgWaitForMultipleObjects(1, AnEvent, False, millisecs, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin
      Application.ProcessMessages;
      if Application.Terminated then Exit;
      millisecs := tick - GetTickcount;
    end;
  finally
    CloseHandle(AnEvent);
  end;
end;

procedure CheckCon(Con: Pointer);
begin
  Wait(5000);

  if TClient(Con).HWID = '' then TClient(Con).Connection.Disconnect;
  EndThread(0);
end;

constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
var
  ThreadId : Cardinal;
begin
  inherited Create(AConnection, AYarn, AList);

  FCriticalSection  := TCriticalSection.Create;
  Queue             := TIdThreadSafeStringList.Create;

  BeginThread(nil, 0, @CheckCon, Self, 0, ThreadId);
end;

OnConnect event code:

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Conexao : TClient;
  Retorno : TArray<String>;
  Query   : TFDQuery;
  Libera  : Boolean;
  IPEX    : Boolean;
begin
  Libera  := True;
  IPEX    := True;
  Conexao := TClient(AContext);
  Retorno := AContext.Connection.IOHandler.ReadLn.Split(['#']);

  if Length(Retorno) = 0 then
  begin
    AContext.Connection.Disconnect;
    Exit;
  end;

  Conexao.IP          := AContext.Connection.Socket.Binding.PeerIP;
  Conexao.HWID        := Retorno[1];
  Conexao.Connected   := Now;
  Conexao.Ping        := Ticks;

  ClientStateUpdated(Conexao, RetornaTraducao(40));

TThread.Queue(nil,
              procedure
              begin
                Memo2.Lines.Add(Format(RetornaTraducao(36), [TimeToStr(Now), Conexao.IP, Conexao.HWID]));
              end);
end;

If I test creating a low number of unknown clients, it works good, but if I flood it with MANY connections, the application crashes. I need something like this to prevent unknown connections in my TIdTCPServer .

I tried calling

Memo2.Lines.Add(Format('[%s]', [AContext.Connection.IOHandler.ReadLn]));

in IdTCPServer1Connect to determine if the connection was my application, but if the client only connects and doesn't send anything, the line doesn't execute.

Answer 1

Starting a worker thread inside of TClient 's constructor is completely unnecessary (the TClient object is already run in a thread created by the server). You can simply set a 5 second timeout on the ReadLn() call itself and be done with it.

Also, TIdTCPServer is a multi-threaded component, its events are fired in the context of worker threads, so access to UI controls like Memo2 MUST by synchronized with the UI thread or else bad things happen.

Try something more like this:

constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);

  FCriticalSection  := TCriticalSection.Create;
  Queue             := TIdThreadSafeStringList.Create;
end;

...

// code adapted from my reply to your previous question:
//
// https://stackoverflow.com/a/58479489/65863
//
// tweak as needed...
//
procedure TForm1.ClientStateUpdated(Client: TClient; const Msg: string);
var
  IP, HWID: string;
begin
  IP := Client.IP;
  HWID := Client.HWID;

  TThread.Queue(nil,
    procedure
    begin
      Memo2.Lines.Add(Format(RetornaTraducao(36), [TimeToStr(Now), IP, HWID, Msg]));
    end
  );
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Conexao : TClient;
  Retorno : TArray<String>;
begin
  Conexao := TClient(AContext);
  Retorno := AContext.Connection.IOHandler.ReadLn(LF, 5000).Split(['#']);

  if (Length(Retorno) < 2) or (Retorno[1] = '') then
  begin
    AContext.Connection.Disconnect;
    Exit;
  end;

  Conexao.IP          := AContext.Binding.PeerIP;
  Conexao.HWID        := Retorno[1];
  Conexao.Connected   := Now;
  Conexao.Ping        := Ticks;

  ClientStateUpdated(Conexao, RetornaTraducao(40){'connect'});
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Conexao : TClient;
begin
  Conexao := TClient(AContext);

  if Conexao.Connected <> 0 then
    ClientStateUpdated(Conexao, RetornaTraducao(...){'disconnect'});
end;