Delphi XE2服务不能正常停止
我在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未被记录). 在我上面的代码中,我有两个程序启动和清理.这些只是创建/破坏和初始化/初始化我的必要的东西… 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. 解决方法
看看Execute方法的源代码:
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请求(服务启动,停止,…),直到服务停止. 正如在评论中所说,另一个问题在于FUpdateThread.Terminate部分.大卫·赫夫南(David Heffernan)正在对Free / WaitFor发表评论.确保使用同步对象以正确的方式结束线程. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |