Question

我在TIdTcpServer上遇到了一些问题，并阻止了客户在TIdTcpServer上进行连接，其他问题是TIdTcpServer上的连接被卡住了，因此，如果不是客户端，我们需要在几个小时后重新启动服务器应用程序以恢复工作不要连接。

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

type
  TCommand = (
    CustomerConnect,
    CustommerDisconenct,
    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实例。有想法吗？

如何防止TIdTcpServer泛洪和卡死的连接

0 个答案: