Delphi 和 Indy - TCPServer OnExecute 奇怪的行为

Question

我有以下代码，“改编”自 Lebeau 在另一篇文章中的回答：Delphi XE2 / Indy TIdTCPServer / "Connection reset by peer"

type
  TClient = class(TObject)
  public
    Host: String;                 
    Queue: TIdThreadSafeStringList;
  end;

var
  Clients: TThreadList;

function TMain.HostOnTList(const Host: String): Pointer;
var
  I: Integer;
  List: TList;
begin
  Result := nil;
  List := Clients.LockList;
  try
    for I := 0 to List.Count - 1 do
      if (TClient(List[I]).Host = Host) then
      begin
        Result := List[I];
        Break;
      end;
  finally
    Clients.UnlockList;
  end;
end;

procedure TMain.FormCreate(Sender: TObject);
const
  Hosts: Array[0..4] of String = (
    'HOST1', 'HOST2', 'HOST3', 'HOST4, 'HOST5'
  );
var
  I: Integer;
  List: TList;
  Client: TClient;
begin
  Clients := TThreadList.Create;
  Clients.Duplicates := dupAccept;
  for I := Low(Hosts) to High(Hosts) do
  begin
    Client := TClient.Create;
    Client.Host := Hosts[I];
    Client.Queue := TIdThreadSafeStringList.Create;
    Clients.Add(Client);
    Client := nil;
  end;
end;

procedure TMain.FormDestroy(Sender: TObject);
var
  I: Integer;
  List: TList;
begin
  if TCPServer.Active Then
    TCPServer.Active := False;
  List := Clients.LockList;
  try
    for I := 0 to List.Count - 1 do
      TClient(List[I]).Free;
  finally
    Clients.UnlockList;
    Clients.Free;
  end;
end;

procedure TMain.TCPServerConnect(AContext: TIdContext);
var
  Host: String;  // Host String
  CIdx: Pointer; // Client Pointer
begin
  ... (get context hostname)
  CIdx := HostOnTList(Host);
  if (CIdx <> nil) then
    AContext.Data := TClient(CIdx);
  else
    ... (disconnect client)
end;

procedure TMain.TCPServerDisconnect(AContext: TIdContext);
var
  List: TList;
  Host: String;
  Client: TClient;
begin
  Host := '';
  Client := TClient(AContext.Data);
  List := Clients.LockList;
  try
    Host := Client.Host;
    if (Host <> '') then
    begin
      Client.Queue := nil;
      AContext.Data := nil;
    end;
  finally
    Clients.UnlockList;
  end;
end;

procedure TMain.idTCPServerExecute(AContext: TIdContext);
var
  I: Integer;
  List: TStringList;
begin
  Client := TClient(AContext.Data);
  ...
  List := Client.Queue.Lock;
  try
    while List.Count > 0 do
    begin
      WriteLn(List[0]);
      List.Delete(0);
    end;
  finally
    Client.Queue.Unlock;
  end;
  ...
end;

function TMain.SendMessage(const Host, Msg: String): Boolean;
var
  List: TList;
  CIdx: Pointer;
begin
  Result := False;
  CIdx := HostOnTList(Host);
  if (CIdx <> nil) then
  begin
    List := TCPServer.Contexts.LockList;
    try
      TClient(CIdx).Queue.Add(Msg);
      Result := True;
    finally
      TCPServer.Contexts.UnlockList;
    end;
  end;
end;

但是发生了一个奇怪的行为......客户端可以连接，但是一旦断开并尝试再次连接，它就被断开了。

我试图注释代码行直到找到问题所在，它发生在这一行：“List := Client.Queue.Lock;”在 idTCPServerExecute 过程中。

请问有谁知道怎么回事？

谢谢！

Answer 1

您在启动时预分配TClient 对象，并在它们连接时将它们与客户端匹配。问题是您的OnDisconnect 代码将TClient.Queue 成员设置为nil（实际上没有释放Queue 对象，从而泄漏它）但将TClient 对象留在列表中。如果客户端重新连接，OnExecute 事件在尝试访问 now-nil Queue 时崩溃。

如果您真的想重用 TClient 对象，请将您的 FormDestroy 和 OnDisconnect 事件改为：

procedure TMain.FormDestroy(Sender: TObject);
var
  I: Integer;
  List: TList;
  Client: TClient;
begin
  if TCPServer.Active Then
    TCPServer.Active := False;
  List := Clients.LockList;
  try
    for I := 0 to List.Count - 1 do
    begin
      Client := TClient(List[I]);
      Client.Queue.Free;
      Client.Free;
    end;
  finally
    Clients.UnlockList;
    Clients.Free;
  end;
end;

procedure TMain.TCPServerDisconnect(AContext: TIdContext);
var
  Client: TClient;
begin
  Client := TClient(AContext.Data);
  if Client <> nil then
  begin
    Client.Queue.Clear;
    AContext.Data := nil;
  end;
end;