delphi - 如何防止 TIdTcpServer 泛滥和连接卡住

Question

我的 TIdTcpServer 上的洪水出现了一些问题，并且阻止了客户在 TIdTcpServer 上连接，其他问题是 TIdTcpServer 上的连接卡住了，所以我们需要在几个小时后重新启动服务器应用程序才能恢复工作，如果不是客户端不连接。

这是我在服务器端的代码：

type
  TCommand = (
    CustomerConnect,
    CustomerDisconnect,
    CustomerNotification);

type
  TClient = record
    CustomerName : String[40];
    Notification : String[40];
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
    Queue             : TIdThreadSafeStringList;

    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;

我只使用 OnExecute 方法，这些函数是谁：

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

  ToSend : TBytes;
  Protocol    : TProtocol;

  Con     : TClientContext;

  Queue       : TStringList;
  List        : TStringList;
  x           : Integer;
begin   
  Con := TClientContext(AContext);

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

    if List <> nil then
    begin
      Con.Lock;

      for x := 0 to List.Count-1 do
      begin
        if List.Strings[x] = 'Notification' then
        begin
          InitProtocol(Protocol);
          Protocol.Command     := CustomerNotification;
          Protocol.Sender.Notification := 'Custom Notification';
          ToSend                := ProtocolToBytes(Protocol);
          Con.Connection.IOHandler.Write(PTIdBytes(@ToSend)^);
          ClearBuffer(ToSend);
        end;
      end;

      Con.Unlock;
    end;
  finally
    List.Free;
  end;

  // Protocol

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

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

  case LProtocol.Command of
    CustomerConnect: begin
     TLog.AddMsg('Connect');  
    end;

    CustomerDisconnect: begin
     TLog.AddMsg('Disconnect');  
    end;
  end;

  ClearBufferId(LBuffer);
  IndySleep(10);

这是 TLog 函数：

constructor TLog.Create(const AMsg: String);
begin
  FMsg := AMsg;
  inherited Create;
end;

procedure TLog.DoSynchronize;
var
  LogName: String;
  ToFile: TextFile;
begin
  try
    LogName := ExtractFilePath(ParamStr(0))+'Logs\LogFile.txt';
    AssignFile(ToFile, LogName);

    if FileExists(LogName) then Append(ToFile) else ReWrite(ToFile);
    try
      WriteLn(ToFile, FMsg);
    finally
      CloseFile(ToFile);
    end;
  except
  end;

  Form1.Memo1.Lines.Add(FMsg);
end;

class procedure TLog.AddMsg(const AMsg: String);
begin
  with Create(AMsg) do
  try
    Synchronize;
  finally
    Free;
  end;
end;

我还在 TIdTcpServer 上使用了 IdSchedulerOfThreadPool1 实例。

任何想法？

标签： delphiindy