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;

Delphi和Indy - TCPServer OnExecute奇怪的行为

1 个答案: