执行过程如下所示:
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未被记录).
在我上面的代码中,我有两个程序启动和清理.这些只是创建/破坏和初始化/初始化我的必要的东西…
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.
解决方法
procedure TServiceThread.Execute; var msg: TMsg; Started: Boolean; begin PeekMessage(msg,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事件中启动你的workerthread,并在Service.OnStop事件中终止/释放它.
正如在评论中所说,另一个问题在于FUpdateThread.Terminate部分.大卫·赫夫南(David Heffernan)正在对Free / WaitFor发表评论.确保使用同步对象以正确的方式结束线程.