Question

我已经尝试过多次使用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

TIdTcpServer在一段时间后停止接受新连接

0 个答案: