IdTcpServer some times don't retrieve the informations at Disconnect event

问题

I don't know why but sometimes when disconnect event on log he don't retrieve the ip and hostname, maybe because already disconnected before retrieve the informations? and if yes how solve it?

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;

example, here it get the informations:

[17:12:38][192.168.15.3] connect

[17:12:38][192.168.15.3] disconnect

and here no:

[17:12:38][192.168.15.3] connect

[17:12:38][] disconnect

回答1:

TThread.Queue() is asynchronous, it does not block the calling thread. It queues the specified method/procedure and then exits immediately. The main UI thread checks the queue for methods/procedures to run at its earliest convenience. So the TIdContext object is likely being destroyed before your the anonymous procedure actually runs in the main UI thread.

You need to change your logging code to have the anonymous procedure capture the individual string values rather than capturing the TClient object itself, eg:

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;

Which can then be taken a step further by wrapping the logging code into its own procedure:

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;

来源：https://stackoverflow.com/questions/58476904/idtcpserver-some-times-dont-retrieve-the-informations-at-disconnect-event

标签

Delphi