[英]Delphi XE2 Service not stopping properly
我已经在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.
查看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评论。 确保使用同步对象以正确的方式结束线程。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.