IdTcpServer иногда не получает информацию при событии Disconnect

Question

Я не знаю, почему, но иногда, когда событие отключения в журнале, он не получает IP-адрес и имя хоста, может быть, потому что уже отключен до получения информации? и если да, то как это решить?

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  DadosConexao : TClient;
begin
  DadosConexao := TClient(AContext);

  DadosConexao.PeerIP      := AContext.Connection.Socket.Binding.PeerIP;
  DadosConexao.HostName    := GStack.HostByAddress(DadosConexao.PeerIP);
  DadosConexao.Connected   := Now;
  DadosConexao.LastAction  := DadosConexao.Connected;

  TThread.Queue(nil,
  procedure
  begin
    Memo2.Lines.Add(Format('[%s][%s] connect', [TimeToStr(Now), DadosConexao.PeerIP, DadosConexao.HostName]));
  end);

  RefreshListBox;
end;

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

  TThread.Queue(nil,
  procedure
  begin
    Memo2.Lines.Add(Format('[%s][%s] disconnect', [TimeToStr(Now), DadosConexao.PeerIP, DadosConexao.HostName]));
  end);

  RefreshListBox;
end;

пример, здесь он получает информацию:

[17:12:38] [192.168.15.3] connect

[17:12:38] [192.168.15.3] отключить

и здесь нет:

[17:12:38] [192.168.15.3] подключить

[17:12:38] [] отключить

Answer 1

TThread.Queue() является асинхронным, не блокирует вызывающий поток. Он ставит в очередь указанный метод / процедуру и немедленно завершает работу. Основной поток пользовательского интерфейса проверяет очередь на наличие методов / процедур, запускаемых при первой возможности. Таким образом, объект TIdContext, вероятно, будет уничтожен до того, как анонимная процедура будет фактически запущена в главном потоке пользовательского интерфейса.

Вам необходимо изменить код регистрации, чтобы анонимная процедура записывала отдельные строковые значения, а не собиралаTClient сам объект, например:

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  DadosConexao : TClient;
  PeerIP, HostName: string;
begin
  DadosConexao := TClient(AContext);

  DadosConexao.PeerIP := AContext.Connection.Socket.Binding.PeerIP;
  DadosConexao.HostName := GStack.HostByAddress(DadosConexao.PeerIP);
  DadosConexao.Connected := Now;
  DadosConexao.LastAction := DadosConexao.Connected;

  PeerIP := DadosConexao.PeerIP;
  HostName := DadosConexao.HostName;

  TThread.Queue(nil,
    procedure
    begin
      Memo2.Lines.Add(Format('[%s][%s][%s] connect', [TimeToStr(Now), PeerIP, HostName]));
    end
  );

  RefreshListBox;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  DadosConexao : TClient;
  PeerIP, HostName: string;
begin
  DadosConexao := TClient(AContext);

  PeerIP := DadosConexao.PeerIP;
  HostName := DadosConexao.HostName;

  TThread.Queue(nil,
    procedure
    begin
      Memo2.Lines.Add(Format('[%s][%s][%s] disconnect', [TimeToStr(Now), PeerIP, HostName]));
    end
  );

  RefreshListBox;
end;

Который затем можно продвинуть дальше, обернув код регистрации в свою собственную процедуру:

procedure TForm1.ClientStateUpdated(Client: TClient; Connected: Boolean);
var
  PeerIP, HostName: string;
begin
  PeerIP := Client.PeerIP;
  HostName := Client.HostName;

  TThread.Queue(nil,
    procedure
    begin
      Memo2.Lines.Add(Format('[%s][%s][%s] %s', [TimeToStr(Now), PeerIP, HostName, iif(Connected, 'connect', 'disconnect')]));
    end
  );

  RefreshListBox;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  DadosConexao : TClient;
  PeerIP, HostName: string;
begin
  DadosConexao := TClient(AContext);

  DadosConexao.PeerIP := AContext.Connection.Socket.Binding.PeerIP;
  DadosConexao.HostName := GStack.HostByAddress(DadosConexao.PeerIP);
  DadosConexao.Connected := Now;
  DadosConexao.LastAction := DadosConexao.Connected;

  ClientStateUpdated(DadosConexao, true);
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  ClientStateUpdated(TClient(AContext), false);
end;