Предотвращение застрявших соединений TIdTcpServer

Question

как дела? Я прихожу сюда, чтобы спросить решение, как предотвратить TIdTcpServer застрял соединения?

Версия indy 10.6.2.5341 и Rad Studio 10.1 Berlin

На обоих изображениях показано количество соединений на TIdTcpServer, эти номера получены из этой функции:

var
  NumClients: Integer;
begin
  with Form1.IdTCPServer1.Contexts.LockList do
  try
    NumClients := Count;
  finally
    Form1.IdTCPServer1.Contexts.UnlockList;
  end;

  Result := NumClients;

Что происходит, почти всегда эти числа только увеличиваются, а не уменьшаются. так что я верю, что соединения застряли на TIdTcpServer.

Я использую IdSchedulerOfThreadDefault1 в Планировщике, я не знаю, изменило ли это что-то или нет, но я добавил.

Для управления подключениями я использую ContextClass:

IdTCPServer1.ContextClass := TClientContext;

Кто это определение:

    type
  TCommand = (
    cmdConnect,
    cmdDisconnect,
    cmdHWID,
    cmdScreenShotData,
    cmdMensagem);

type
  TClient = record
    HWID  : String[40];
    Tempo : TDateTime;
    Msg   : String[100];
end;

const
  szClient = SizeOf(TClient);

type
  TProtocol = record
    Command: TCommand;
    Sender: TClient;
    DataSize: Integer;
end;

const
  szProtocol = SizeOf(TProtocol);

type
  TClientContext = class(TIdServerContext)
  private
    FCriticalSection  : TCriticalSection;
    FClient           : TClient;
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
  public
    procedure Lock;
    procedure Unlock;
  public
    property Client: TClient read FClient write FClient;
end;

Другие используемые функции:

procedure InitProtocol(var AProtocol: TProtocol);
begin
  FillChar(AProtocol, szProtocol, 0);
end;

function ProtocolToBytes(const AProtocol: TProtocol): TBytes;
begin
  SetLength(Result, szProtocol);
  Move(AProtocol, Result[0], szProtocol);
end;

constructor TClientContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  FCriticalSection := TCriticalSection.Create;
end;

destructor TClientContext.Destroy;
begin
  FreeAndNil(FCriticalSection);
  inherited;
end;

procedure TClientContext.Lock;
begin
  FCriticalSection.Enter;
end;

procedure TClientContext.Unlock;
begin
  FCriticalSection.Leave;
end;

function BytesToProtocol(const ABytes: TBytes): TProtocol;
begin
  Move(ABytes[0], Result, szProtocol);
end;

procedure ClearBuffer(var ABuffer: TBytes);
begin
  SetLength(ABuffer, 0);
end;

procedure ClearBufferId(var ABuffer: TIdBytes);
begin
  SetLength(ABuffer, 0);
end;

Все события (подключить / отключить), которыми я управляю IdTCPServer1Execute как в примере выше:

    type
  PTBytes   = ^TBytes;
  PTIdBytes = ^TIdBytes;
var
  LBuffer     : TIdBytes;
  LProtocol   : TProtocol;
  FTempBuffer : TIdBytes;

  Enviar    : TBytes;
  Protocolo : TProtocol;

  Conexao   : TClientContext;

  //

  Queue: TStringList;
  List: TStringList;
  x : Integer;

  //

  procedure AddToMemo(const AStr: string);
  begin
    TThread.Synchronize(nil,
      procedure
      begin
        Memo1.Lines.Add(AStr);
        Form1.StatusBar1.Panels[0].Text := Format('Connections [%d]', [RetornaOn]);
      end
    );
  end;
begin
  Conexao := TClientContext(AContext);

  // QUEUE

  List := nil;
  try
    Queue := Conexao.Queue.Lock;
    try
      if Queue.Count > 0 then
      begin
        List := TStringList.Create;
        List.Assign(Queue);
        Queue.Clear;
      end;
    finally
      Conexao.Queue.Unlock;
    end;

    if List <> nil then
    begin
      for x := 0 to List.Count-1 do
      begin
        InitProtocol(Protocolo);

        Protocolo.Command     := cmdMensagem;
        Protocolo.Sender.Msg  := Edit2.Text;
        Enviar                := ProtocolToBytes(Protocolo);

        Conexao.Connection.IOHandler.Write(PTIdBytes(@Enviar)^);

        ClearBuffer(Enviar);
      end;

      // Delete Queue

      for x := 0 to List.Count-1 do
      begin
        List.Delete(x);
      end;
    end;
  finally
    List.Free;
  end;

  // QUEUE

  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    //AddToMemo(Format('[%s] Running 1 ...', [TimeToStr(Now)]));

    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
      {AddToMemo(Format('[%s] Running 2 ...', [TimeToStr(Now)]));

      if GetTickDiff(Conexao.Client.Tick, Ticks) >= 10000 then
      begin
        AddToMemo(Format('[%s] Running 3 [%d] ...', [TimeToStr(Now), Conexao.Client.Tick]));

        AContext.Connection.Disconnect;
        Exit;
      end;}

      Exit;
    end;
  end;

  AContext.Connection.IOHandler.ReadBytes(LBuffer, szProtocol, False);

  LProtocol := BytesToProtocol(PTBytes(@LBuffer)^);

  case LProtocol.Command of
    cmdConnect: begin
      Conexao.Client := LProtocol.Sender;
      Conexao.FClient.Tick := Ticks;


        AddToMemo(Format('[%s] : [%s][%s]', ['Connect', AContext.Connection.Socket.Binding.PeerIP, Protocolo.Sender.HWID]));
    end;

    cmdMensagem: begin
      AddToMemo(Format('[%s] : [%s][%s][%s]', ['Msg', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID, LProtocol.Sender.Msg]));
    end;

    cmdDisconnect: begin
      AddToMemo(Format('[%s] : [%s][%s]', ['Disconnect', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID]));
    end;
  end;

В следующем коде я показываю, как клиентская часть подключается к TIdTcpServer:

type
  PTIdBytes = ^TIdBytes;
var
  LBuffer   : TBytes;
  LProtocol : TProtocol;
begin
  ClientThread := TClientThread.Create(False);

  InitProtocol(LProtocol);
  LProtocol.Command       := cmdConnect;
  LProtocol.Sender.HWID   := Edit1.Text;
  LProtocol.Sender.Tempo  := Now;
  LBuffer                 := ProtocolToBytes(LProtocol);
  IdTCPClient1.IOHandler.Write(PTIdBytes(@LBuffer)^);
  ClearBuffer(LBuffer);

  AddToMemo('IdTCPClient1 connected to server');

ClientThread на клиенте:

procedure TClientThread.Execute;
type
  PTBytes   = ^TBytes;
  PTIdBytes = ^TIdBytes;
var
  LBuffer     : TIdBytes;
  LDataSize   : Integer;
  LProtocol   : TProtocol;

  procedure AddToMemo(const AStr: string);
  begin
    TThread.Synchronize(nil,
      procedure
      begin
        Form1.Memo1.Lines.Add('Received From Server: ' + AStr);
      end
    );
  end;
begin
  inherited;
  while NOT Terminated and Form1.IdTCPClient1.Connected do begin
    //LDataSize := Form1.IdTCPClient1.IOHandler.InputBuffer.Size;

    //if LDataSize >= szProtocol then begin
      try
        Form1.IdTCPClient1.IOHandler.ReadBytes(LBuffer, szProtocol);

        LProtocol := BytesToProtocol(PTBytes(@LBuffer)^);

        case LProtocol.Command of
          cmdHWID:
          begin
            HWID := LProtocol.Sender.HWID;
            AddToMemo('HWID > ' + LProtocol.Sender.HWID);
          end;

          cmdDisconnect:
          begin
            AddToMemo('DC > ' + LProtocol.Sender.HWID);
          end;

          cmdMensagem:
          begin
            AddToMemo('MSG > ' + LProtocol.Sender.Msg);
          end;
        end;
      finally
        ClearBufferId(LBuffer);
      end;
    //end;

    Sleep(50);
  end;
end;

Кто-нибудь знает, почему эти соединения зависают на TIdTcpServer? Может быть, если я зациклю все соединения и попытаюсь отправить один текст, они отключатся, если они действительно не подключены к IdTcpServer нет?

Спасибо.