Delphi XE2 服务未正确停止

Question

我在 Delphi 7 中构建了一些服务，没有遇到这个问题。现在我在 XE2 中启动了一个新的服务应用程序，它不会正确停止。我不知道是我做错了什么还是 XE2 服务中的错误。

执行过程如下所示：

procedure TMySvc.ServiceExecute(Sender: TService);
begin
  try
    CoInitialize(nil);
    Startup;
    try
      while not Terminated do begin
        DoSomething; //Problem persists even when nothing's here
      end;
    finally
      Cleanup;
      CoUninitialize;
    end;
  except
    on e: exception do begin
      PostLog('EXCEPTION in Execute: '+e.Message);
    end;
  end;
end;

我从来没有异常，你可以看到我记录了任何异常。 PostLog 保存到一个 INI 文件，它工作正常。现在我确实使用 ADO 组件，所以我使用 CoInitialize() 和 CoUninitialize。它确实连接到数据库并正确完成其工作。仅当我停止此服务时才会出现问题。 Windows 给我以下信息：

然后服务继续。我必须第二次阻止它。第二次确实停止了，但显示以下消息：

日志文件表明该服务已成功释放（OnDestroy 事件已记录）但它从未成功停止（OnStop 从未记录）。

在我上面的代码中，我有两个过程Startup 和Cleanup。这些只是创建/销毁和初始化/取消初始化我必要的东西......

procedure TMySvc.Startup;
begin
  FUpdateThread:= TMyUpdateThread.Create;
    FUpdateThread.OnLog:= LogUpdate;
    FUpdateThread.Resume;
end;

procedure TMySvc.Cleanup;
begin
  FUpdateThread.Terminate;
end;

如您所见，我有一个辅助线程正在运行。这个服务实际上有很多这样运行的线程，主服务线程只记录每个线程的事件。每个线程都有不同的职责。线程正在正确报告，并且它们也被正确终止。

什么可能导致停止失败？如果我发布的代码没有公开任何内容，那么我可以稍后发布更多代码 - 由于内部命名等原因，只需“转换”它即可。

编辑

我刚刚在 Delphi XE2 中启动了新的服务项目，并且遇到了同样的问题。这是我下面的所有代码：

unit JDSvc;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, JDSvcMgr;

type
  TJDService = class(TService)
    procedure ServiceExecute(Sender: TService);
  private
    FAfterInstall: TServiceEvent;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  JDService: TJDService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  JDService.Controller(CtrlCode);
end;

function TJDService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TJDService.ServiceExecute(Sender: TService);
begin
  while not Terminated do begin

  end;
end;

end.

Answer 1

查看 Execute 方法的源代码：

procedure TServiceThread.Execute;
var
  msg: TMsg;
  Started: Boolean;
begin
  PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
  try
    // Allow initialization of the Application object after
    // StartServiceCtrlDispatcher to prevent conflicts under
    // Windows 2003 Server when registering a class object with OLE.
    if Application.DelayInitialize then
      Application.Initialize;
    FService.Status := csStartPending;
    Started := True;
    if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
    if not Started then Exit;
    try
      FService.Status := csRunning;
      if Assigned(FService.OnExecute) then
        FService.OnExecute(FService)
      else
        ProcessRequests(True);
      ProcessRequests(False);
    except
      on E: Exception do
        FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
    end;
  except
    on E: Exception do
      FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
  end;
end;

如您所见，如果您不分配 OnExecute 方法，Delphi 将处理 SCM 请求（服务启动、停止...），直到服务停止。 当您在 Service.Execute 中创建循环时，您必须通过调用 ProcessRequests(False) 自己处理 SCM 请求。一个好习惯是不要使用 Service.execute 并在 Service.OnStart 事件中启动您的工作线程并在 Service.OnStop 事件中终止/释放它。

正如 cmets 所述，另一个问题在于 FUpdateThread.Terminate 部分。 大卫·赫弗南 (David Heffernan) 对 Free/WaitFor 评论发表了看法。 确保使用同步对象以正确的方式结束线程。