Search code examples
delphiindyindy10

TIdTCPServer disconnect a client totally from the server


I am using TIdTCPServer. I have a client that has disconnected abnormally. I am trying to disconnect this client like the following:

//class TClientConnection = class(TIdServerContext)

var
  Clienttodisconnect: TClientConnection;

List := Server.Contexts.LockList;
try
  for I := 0 to List.Count - 1 do
  begin
    Clienttodisconnect := TClientConnection(List.Items[I]);
    if Clienttodisconnect.uuid = idtodiscnnect then
    begin
      try    
        Clienttodisconnect.Connection.Disconnect;    
      except
      end;
    end;
  end;
finally
  Server.Contexts.UnlockList;
end;

Sometimes the client gets disconnected from the server, and sometimes it gets stuck until the server is restarted.

What am I doing wrong? I just want to disconnect the client from the context.

here is the server onexecute event

var
  Connection: TClientConnection;
  CMD: String;
  Cache, OutboundCmds: TStringList;
  I: integer;
  UConnected : Boolean;
  Len: Integer;
begin

sleep(10);

Try
UConnected := AContext.Connection.Connected;
Except
UConnected := False;
End;

If UConnected <> True Then
begin
AContext.Connection.Disconnect;
exit;
end;

Len := AContext.Connection.IOHandler.InputBuffer.Size;


If Len >= 200000 then
begin
AContext.Connection.Disconnect;
exit;

end;

Connection := AContext as TClientConnection;



  // check for pending outbound commands...
  OutboundCmds := nil;
  try
    Cache := Connection.OutboundCache.Lock;
    try
      if Cache.Count > 0 then
      begin
        OutboundCmds := TStringList.Create;
        OutboundCmds.Assign(Cache);
        Cache.Clear;
      end;
    finally
      Connection.OutboundCache.Unlock;
    end;

    if OutboundCmds <> nil then
    begin
      for I := 0 to OutboundCmds.Count - 1 do
      begin
        AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
          IndyTextEncoding_UTF8);
      end;
      Connection.LastSendRecv := Ticks64;
    end;




  finally
    if OutboundCmds <> nil then
    begin
      for I := 0 to OutboundCmds.Count - 1 do
      begin
        OutboundCmds.Objects[I].Free;
      end;
    end;
    OutboundCmds.Free;
  end;

  // check for a pending inbound command...
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
    if GetElapsedTicks(Connection.LastSendRecv) >= 30000 then
     AContext.Connection.Disconnect;
     Exit;
    end;
  end;

.......

........ 

Solution

  • I would suggest something more like this:

    type
      TClientConnection = class(TIdServerContext)
      public
        Cache: TIdThreadSafeStringList;
        uuid: string; // or TGuid or whatever you are using...
        ForceDisconnect: Boolean; // <-- add this
      end;
    
    ...
    
    var
      List: TList; // or TIdContextList in modern Indy versions
      I: Integer;
      Client: TClientConnection;
    begin
      List := Server.Contexts.LockList;
      try
        for I := 0 to List.Count - 1 do
        begin
          Client := TClientConnection(TIdContext(List.Items[I]));
          if Client.uuid = idtodiscnnect then
          begin
            Client.ForceDisconnect := True; // <-- don't actually disconnect here, just signal it
            Break;
          end;
        end;
      finally
        Server.Contexts.UnlockList;
      end;
    end;
    
    ...
    
    procedure TMyForm.ServerConnect(AContext: TIdContext);
    begin
      (AContext as TClientConnection).LastSendRecv := Ticks64;
      AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
      AContext.Connection.IOHandler.ReadTimeout := 30000;
    end;
    
    procedure TMyForm.ServerExecute(AContext: TIdContext);
    var
      Client: TClientConnection;
      CMD: String;
      Cache, OutboundCmds: TStringList;
      I: integer;
      Len: Integer;
    begin
      Client := AContext as TClientConnection;
    
      if Client.ForceDisconnect then // <-- do the actual disconnect here
      begin
        AContext.Connection.Disconnect;
        Exit;
      end;
    
      Len := AContext.Connection.IOHandler.InputBuffer.Size;
      if Len >= 200000 then
      begin
        AContext.Connection.Disconnect;
        Exit;
      end;
    
      // check for pending outbound commands...
      OutboundCmds := nil;
      try
        Cache := Connection.OutboundCache.Lock;
        try
          if Cache.Count > 0 then
          begin
            OutboundCmds := TStringList.Create;
            OutboundCmds.Assign(Cache);
            Cache.Clear;
          end;
        finally
          Connection.OutboundCache.Unlock;
        end;
    
        if OutboundCmds <> nil then
        begin
          for I := 0 to OutboundCmds.Count - 1 do
          begin
            if Client.ForceDisconnect then // <-- and here, for good measure
            begin
              AContext.Connection.Disconnect;
              Exit;
            end;
            AContext.Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
          end;
          Connection.LastSendRecv := Ticks64;
        end;
    
      finally
        if OutboundCmds <> nil then
        begin
          for I := 0 to OutboundCmds.Count - 1 do
          begin
            OutboundCmds.Objects[I].Free;
          end;
        end;
        OutboundCmds.Free;
      end;
    
      // check for a pending inbound command...
      if AContext.Connection.IOHandler.InputBufferIsEmpty then
      begin
        AContext.Connection.IOHandler.CheckForDataOnSource(100);
        AContext.Connection.IOHandler.CheckForDisconnect;
    
        if AContext.Connection.IOHandler.InputBufferIsEmpty then
        begin
          // if the client wants to stay connected, it should
          // send a command every so often...
          if GetElapsedTicks(Client.LastSendRecv) >= 30000 then
          begin
            AContext.Connection.Disconnect;
            Exit;
          end;
        end;
      end;
    
      CMD := AContext.Connection.IOHandler.ReadLn;
      Client.LastSendRecv := Ticks64;
    
      ...
    end;