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事件中終止/釋放它。

如評論中所述，另一個問題在於FUpdateThread.Terminate部分。 David Heffernan接受了Free / WaitFor評論。 確保使用同步對象以正確的方式結束線程。