Отключите неизвестные соединения в TIdTcpServer OnConnect

Question

У меня проблема. Я создал TIdTCPServer, но мне нужно предотвратить ложные / неизвестные соединения.

Я пробовал это:

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:

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;

Если яТестирование создания небольшого числа неизвестных клиентов, это работает хорошо, но если я залил его МНОГИМИ соединениями, приложение вылетает. Мне нужно что-то вроде этого, чтобы предотвратить неизвестные соединения в моем TIdTCPServer.

Я попытался вызвать

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

в IdTCPServer1Connect, чтобы определить, было ли соединение моим приложением, но является ли клиенттолько соединяется и ничего не отправляет, строка не выполняется.

Answer 1

Запуск рабочего потока внутри конструктора TClient совершенно не нужен (объект TClient уже запущен в потоке, созданном сервером). Вы можете просто установить 5-секундный таймаут для самого вызова ReadLn() и покончить с ним.

Кроме того, TIdTCPServer является многопоточным компонентом, его события запускаются в контексте рабочих потоков,поэтому доступ к элементам управления пользовательского интерфейса, например Memo2, ДОЛЖЕН быть синхронизирован с потоком пользовательского интерфейса, иначе произойдет что-то плохое.

Попробуйте что-то еще, похожее на это:

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;