Question

你好吗？我来这里寻求解决方案，如何防止TIdTcpServer卡住连接？

indy 10.6.2.5341和Rad Studio 10.1 Berlin的版本

在两个图像上均显示了TIdTcpServer上的连接数，这些数字是从此函数中检索的：

oc login https://192.219.152.34.nip.io –token=adfasdfsdaf23423  

Teams Once logged in as using their token , they are able to peform any api oerations in the scope of testproject. 
eg: oc create -f testproject-deploymentconfig.yml
    oc create -f testproject-service.yml

发生的事情是，在大多数情况下，这个数字只会增加而不会减少。所以我认为连接一直停留在TIdTcpServer上。

我在Scheduler上使用了一个IdSchedulerOfThreadDefault1，我不知道这是否有所改变，但我添加了。

对于管理连接，我使用ContextClass：

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

  Result := NumClients;

谁的定义是：

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

在下面的代码中，我演示客户端如何连接到TIdTcpServer：

    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;

客户端上的ClientThread：

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');

有人知道为什么这些连接被卡在TIdTcpServer上吗？也许如果我循环所有连接并尝试发送单个文本会断开连接，如果没有真正连接到IdTcpServer否？

谢谢。

防止TIdTcpServer卡死连接

0 个答案: