TIdTcpServer Прекратить прием новых подключений через некоторое время - PullRequest
Новая
       37

TIdTcpServer Прекратить прием новых подключений через некоторое время

0 голосов
/ 25 октября 2019

Я уже пытался использовать TIdTcpServer много раз, и у меня всегда одна и та же проблема. после некоторого времени работы (получения подключений) он прекращает получать новые подключения и должен перезапустить его для возврата.

код, который я использую сейчас, очень прост, но проблема все еще возникает. и я не знаю, что делать дальше, я почти покупаю фреймворк подключения, чтобы увидеть, решит ли это проблему. 

procedure TForm1.ClientStateUpdated(Client: TClient; Texto: String);
var
  PeerIP, HostName: string;
begin
  PeerIP    := Client.IP;
  HostName  := Client.HWID;

  TThread.Queue(nil,
  procedure
  begin
    if ((PeerIP <> '') and (HostName <> '')) then Memo2.Lines.Add(Format(Texto, [TimeToStr(Now), PeerIP, HostName]));
  end);
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Conexao : TClient;
  Retorno : TArray<String>;
  Query   : TFDQuery;
  Libera  : Boolean;
  IPEX    : Boolean;
begin
  Libera  := True;
  IPEX    := True;
  Conexao := TClient(AContext);
  Retorno := AContext.Connection.IOHandler.ReadLn(LF, 5000).Split(['#']);

  if Length(Retorno) = 0 then
  begin
    AContext.Connection.Disconnect;
    Exit;
  end;

  if Retorno[0] = 'cmdPing' then Retorno[1] := Retorno[2];

  Conexao.IP          := AContext.Connection.Socket.Binding.PeerIP;
  Conexao.HWID        := Retorno[1];
  Conexao.Connected   := Now;
  Conexao.Ping        := Ticks;

  ClientStateUpdated(Conexao, "%s %s %s");
  Conexao.Connection.IOHandler.WriteLn('cmdContinue');
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  ClientStateUpdated(TClient(AContext), RetornaTraducao(32));
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Conexao       : TClient;
  Retorno       : TArray<String>;
begin
  Conexao := TClient(AContext);
  Retorno := AContext.Connection.IOHandler.ReadLn.Split(['#']);
end;

Другие объявления: 

type
  TClient = class(TIdServerContext)
    private
      FCriticalSection  : TCriticalSection;
    public
      IP          : String;
      HWID        : String;

      Connected   : TDateTime;
      Ping        : Cardinal;   
      Queue       : TIdThreadSafeStringList;

      constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
      destructor  Destroy; override;
      procedure   Lock;
      procedure   Unlock;
  end;

constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);

  FCriticalSection  := TCriticalSection.Create;
  Queue             := TIdThreadSafeStringList.Create;
end;

destructor TClient.Destroy;
begin
  Queue.Free;
  FreeAndNil(FCriticalSection);

  inherited;
end;

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

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

Странная вещь, если я создаю приложение, которое подключается / отключается и запускает его в течение МНОГИХ часов, приложение работает нормально, но когда я выпускаю его для общественности, возникает проблема.

Я не использую IdSchedulerOfThreadDefault1 / IdSchedulerOfThreadPool1

...