Delphi：Indy ContextClasses 是在没有客户端连接的情况下创建的

Question

我在 Delphi 中使用 TIdTCPServer，有时它会在没有任何客户端的情况下以 100% 的速度加载 CPU。这是由于不断创建实例 TIdContextClass 的事实。我该怎么做才能更正它？

这是服务器代码。

TMyTCPServer = class
private
  FTCPServer: TIdTCPServer;
  procedure ServerExecute(AIdContext: TIdContext);
public
  constructor Create();
  destructor Destroy(); override;
end;

{ TMyTCPServer }

constructor TMyTCPServer.Create;
begin
  try
    FTCPServer := TIdTCPServer.Create(nil);
    FTCPServer.OnExecute := ServerExecute;
    FTCPServer.DefaultPort := TServerSettingsSupport.Instance.Application_TCPConnectionPort;
    FTCPServer.ContextClass := TSServerContext;
    FTCPServer.Active := True;
  except
    on E: Exception do raise Exception.CreateFmt('Ошибка при подключениии к TCP-порту "%s"', [E.Message]);
  end;
end;

destructor TMyTCPServer.Destroy;
begin
  FTCPServer.Active := False;
  FreeAndNil(FTCPServer);
end;

procedure TMyTCPServer.ServerExecute(AIdContext: TIdContext);
begin
  //
end;

TSServerContext = class(TIdContext)
private
  FClientService: ISClientService;
  FStatFormer: IStatForm_ServerCallFullStat;

  procedure WaitingForData(out AWithoutResult: Boolean);
  procedure ContextExecute;
protected
  function Run: Boolean; override;
end;

后代类 TContext

{ TServerThread }

procedure TSServerContext.ContextExecute;
var
  Stream: TMemoryStream;
  Mess, RMess: IAbstractMessage;
  Size: Integer;
  MDisp: TMessageDispatcher;
  WithoutResult: Boolean;
  isNeedBuffering: Boolean;
begin
  FClientService := TClientServiceFactory.CreateClientService;
  FStatFormer := TStatForm_ServerCallFullStat.Create();
  isNeedBuffering := TServerSettingsSupport.Instance.Application_NeedBufferingQueryResult; 

  MDisp := TMessageDispatcher.Create(FClientService);
  Stream := TMemoryStream.Create;
  try
    try
      while Assigned( Connection ) and Connection.Connected do
      begin
        // Ждем первых данных сообщения. Периодически проверяем очередь
        // сообщений потока на сообщения завершения (WM_QUIT)
        WaitingForData(WithoutResult);

        FStatFormer.Start();
        Size := Connection.IOHandler.ReadInteger;

        // Новая активность клиента
        FClientService.NewActivity;

        Stream.Clear;
        Connection.IOHandler.ReadStream(Stream,Size);
        Stream.Position := 0;

        Mess := TAbstractMessage.RestoreMessage(Stream);
        Stream.Clear;
        FStatFormer.FinishReadInputData(Mess.GetInstance().ClassName());
        RMess := MDisp.Process(Mess);
        FStatFormer.FinishProcessData();
        if not WithoutResult then
        begin
          TAbstractMessage.StoreMessage(RMess,Stream);
          if ((Stream.Size / 1024 / 1024) <= 60) and isNeedBuffering then
            Connection.IOHandler.WriteBufferOpen;
          try
            Connection.IOHandler.Write(Stream,0,True);
          finally
            if Connection.IOHandler.WriteBufferingActive then
              Connection.IOHandler.WriteBufferClose;
            Stream.Clear;
            RMess := nil;
          end;
        end;
        FStatFormer.FinishWriteOutputData();
      end;
    except
      raise;
    end;
  finally
    Stream.Free;
    MDisp.Free;

    FClientService := nil;
    FStatFormer := nil;
  end;
end;

function TSServerContext.Run: Boolean;
begin
  try
    CoInitialize(nil);
    try
      ContextExecute;
      Result := True;
    finally
      CoUninitialize;
    end;
  except
    on E: EIdSocketError do
    begin
      case E.LastError of
        Id_WSAECONNABORTED,
          Id_WSAECONNRESET:
          Connection.Disconnect;
      end;

      Result := False;
    end;

    on EIdClosedSocket do
    begin
      Result := False;
    end;

    on E: Exception do
    begin
      if E is EIdSilentException then
      begin
        raise;
      end
      else
      begin
        raise;
        Result := False;
      end;
    end;
  end;
end;

procedure TSServerContext.WaitingForData(out AWithoutResult: Boolean);
var
  dataReceived: Boolean;
  MSG: TMsg;
begin
  dataReceived := False;
  while (not dataReceived) do
  begin
    // Обрабатываем сообщения из очереди. Проверка на завершение.
    while (PeekMessage(MSG, 0, 0, 0, PM_REMOVE)) do
    begin
      case (MSG.message) of
        WM_QUIT:
          begin
            Connection.Disconnect;
          end;
      end;
    end;

    Connection.IOHandler.ReadTimeout := cReadTimeout;
    try
      try
        AWithoutResult := Boolean(Connection.IOHandler.ReadInteger);
        dataReceived := True;
      except
        on E: EIdReadTimeout do
        begin
          // Таймаут - обрабатываем сообщение из очереди
        end;
      end;
    finally
      Connection.IOHandler.ReadTimeout := IdTimeoutInfinite;
    end;
  end;
end;

Answer 1

TIdTCPServer 不会“不断创建上下文对象”。它创建一个上下文对象 ，等待客户端连接，将两者关联并运行一个线程来管理它们，然后重复。该逻辑中的任何错误都会终止创建上下文对象和接受客户端的线程。因此，TIdTCPServer 可以利用这么多 CPU 的唯一方法是，如果您有一个或多个未产生 CPU 时间的失控线程。 TIdContext 本身不是线程，它只是在线程内部使用。这种高 CPU 使用率最常见的原因是 OnExecute 代码错误地处理了 Indy 错误/异常并且没有让 TIdTCPServer 处理它们，从而导致客户端线程中的无限循环而不是让它自行终止。

更新：您的OnExecute 事件处理程序为空。该事件是多线程的，并在每个客户端连接的生命周期内循环调用。一个空的处理程序会导致每个客户端线程运行一个紧密的不屈不挠的循环，这将导致您的 CPU 使用率很高。你必须定期让步。在这种情况下，您的处理程序应该调用TSServerContext(AIdContext).Run;，然后套接字读取操作将为您执行必要的让步。