Question

我刚刚遇到一个我前段时间写过的服务的问题。此服务旨在通过CreateProcess调用multilizer应用程序来翻译各种程序。问题是，一旦清除了给定目录的检查并调用了实际的转换方法，即使所有文件都已处理，cpu加载也将上升到大约15-20％并保持在此水平。该服务的OnStart事件创建一个非延迟线程，其执行方法如下所示：

procedure TTranslateThread.Execute;
var count : integer;

begin
  sleep(ServiceObject.hInterval);
  while not Terminated do
  begin
    Inc(Count);
    if Count>= 10 then
    begin
      Count :=0;
      if ServiceObject.CheckDirCount>0 then
      begin
      ServiceObject.TranslateService;
      sleep(ServiceObject.hInterval);
    end;
   end;
end;

但是我认为问题的主要原因在于我必须调用multilizer的方式。这是因为服务必须等待multilizer完成翻译。我使用WaitForSingleObject等待多工作器完成，虽然我知道这是一个坏主意。这是调用multilizer的方法：

procedure WaitForML7(hName: string);
var
  si: TStartupInfo;
  pi: TProcessInformation;
  hCreateOK: Boolean;
  AParameterFinal,AFileName: String;
begin
  AFileName := hMultilizerPath+'Ml7Build.exe';
  AParameterFinal := 'b '+hName+'.exe.m7p';


  FillChar(si,SizeOf(TStartupInfo),#0);
  FillChar(pi,SizeOf(TProcessInformation),#0);
  si.cb := SizeOf(TStartupInfo);
  AParameterFinal := Format ('"%s" %s', [AFilename, TrimRight(AParameterFinal)]);
  slog.Info('CreateProcess wird versucht');

  hCReateOK := CreateProcess(nil,PChar(AParameterFinal), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
  PChar(hMultilizerPath) ,si,pi);
  if hCreateOK then
  begin
    slog.Error('Multilizeraufruf war erfolgreich für Prg: '+hName);
    WaitForSingleObject(pi.hProcess,INFINITE);
  end
  else
  begin
  slog.Error('Aufruf war nicht erfolgreich -> keine Uebersetzung');
  end;
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
end;

我真的不明白为什么处理器负载仍然很高，即使没有其他事可做。提前谢谢。

Answer 1

您的线程运行繁忙的循环。

while not Terminated do
begin
  Inc(Count);
  if Count>= 10 then
  begin
    Count :=0;
    if ServiceObject.CheckDirCount>0 then
    begin
      ServiceObject.TranslateService;
      sleep(ServiceObject.hInterval);
    end;
  end;
end;

请注意，我已从您的代码中添加了缺失的end。我希望这是您犯的唯一错误，因为很明显，当您发布的代码不是真正的代码时，问题在于真正的代码而不是您发布的代码。

无论如何，假设CheckDirCount总是评估为0，那么循环看起来像这样：

while not Terminated do
begin
  Inc(Count);
  if Count>= 10 then
  begin
    Count :=0;
    ServiceObject.CheckDirCount;
  end;
end;

这是一个繁忙的循环。当您运行繁忙的循环时，处理器会变热。

我真的不想为此提出解决方案，因为我不知道您的计划正在做什么的任何细节。我只想回答你的线程消耗CPU的原因。

Answer 2

您的等待循环将在Sleep()内无需等待，因此会在达到Sleep()之前刻录一些CPU。这不是一个好的实现模式。

一个常见的解决方案是使用信号量来通知线程唤醒并处理挂起的任务。在触发信号量（例如TEvent）之前，它不会使用任何CPU。

看看TEvent documentation。

对于更复杂的多线程内容，请考虑using a dedicated library like OmniThreadLibrary。它具有高级列表和并行处理，调整和稳定。使用这样的库将为您节省大量的时间和金钱。多线程编程很难稳定，因此OmniThreadLibrary is worth a look。

Answer 3

除了大卫的回答：

可以简化主执行块，无条件地执行Sleep以防止忙循环：

procedure TTranslateThread.Execute;
begin
 while not Terminated do
  begin
   sleep(ServiceObject.hInterval);
   if ServiceObject.CheckDirCount>0 then
    ServiceObject.TranslateService;
  end;
end;

请注意，您可以使用Shell notification events来避免睡眠循环。

Delphi服务总是以15％的处理器负载运行

3 个答案: