防止TIdTcpServer卡住连接(Prevent TIdTcpServer Stuck Conn

2019-10-30 08:48发布

站内文章 / 移动开发
45 0 0

你好吗？ 我来这里问一个解决方案，如何防止TIdTcpServer卡连接？

印10.6.2.5341的版本和公司的RAD Studio 10.1柏林

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

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

  Result := NumClients;

什么发生的是，几乎在这种情况下，仅数增加，不会减少。 所以我相信，连接被stucked上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 stucked？ 也许，如果我所有环路conenctions并尝试发送一个文本将切断他们如果不真正连接到IdTcpServer没有？

谢谢。

文章来源: Prevent TIdTcpServer Stuck Connections
标签： sockets delphi indy
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~