Delphi and Indy - TCPServer OnExecute strange behavior

Question

I have the following code, "adapted" from Lebeau's answer in another post: 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;

But is happening a strange behavior... Client can connect, but once disconnect and try to connect again, it is been disconnected.

I tried to comment the lines of code until find the problem, and it happens with this line: "List := Client.Queue.Lock;" inside idTCPServerExecute procedure.

Please, anyone knows what is going on?

Thanks!

Does your `OnConnect` handler assign `AContext.Data := Client;`? You did not show that, but your `OnExecute` handler is expecting it (the code I provided in the linked discussion does that assignment). And do you have a `OnDisconnect` handler that frees the `TClient` and `Queue` objects? That being said, I would suggest deriving `TClient` from `TIdServerContext` and assign that to the server's `ContextClass` property, and get rid of the `Clients` list altogether. The server have its own public `Contexts` list that keeps track of connected clients. — Remy Lebeau, Dec 20 '14 at 19:50
I see you are still using your own `Clients` list, instead of eliminating it like I suggested in the other discussion you linked to. I do strongly recommend you get rid of your ownlist, since you are just duplicating what `TIdTCPServer` already does for you. — Remy Lebeau, Dec 20 '14 at 20:02
@RemyLebeau, actually my code is some different, because I need to have a populated list of tclients, and change their status OnConnect and OnDisconnect events. Something like this http://stackoverflow.com/questions/27555342/threadlist-of-tobject-with-delphi-how-to-populate. But I am assigning AContext.Data := Client on connect and AContext.Data := nil on disconnect. I will update the code in my question. Thanks! — Guybrush, Dec 20 '14 at 20:46

Remy Lebeau · Accepted Answer · 2014-12-21T08:48:11.883

You are pre-allocating TClient objects at startup and matching them to clients when they connect. The problem is that your OnDisconnect code is setting the TClient.Queue member to nil (without actually freeing the Queue object, thus leaking it) but leaving the TClient object in the list. If a client re-connects, the OnExecute event crashes trying to access the now-nil Queue.

If you really want to re-use TClient objects, then change your FormDestroy and OnDisconnect events to this instead:

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;

Thank you again Mr. Lebeau! I hope this topic can help other people with same problem. — Guybrush, Dec 21 '14 at 12:47

Delphi and Indy - TCPServer OnExecute strange behavior

1 Answers1