Question

我在Delphi中使用TIdTCPServer，有时它在没有任何客户端的情况下将CPU加载到100％。这是因为不断创建实例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;套接字读取操作将为您执行必要的让步。

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

1 个答案: