Delphi XE2服务不能正常停止

前端之家收集整理的这篇文章主要介绍了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请求(服务启动,停止,…),直到服务停止.
当您在Service.Execute中进行循环时,必须通过调用ProcessRequests(False)来自己处理SCM请求.一个好习惯是不要使用Service.execute,并在Service.OnStart事件中启动你的workerthread,并在Service.OnStop事件中终止/释放它.

正如在评论中所说,另一个问题在于FUpdateThread.Terminate部分.大卫·赫夫南(David Heffernan)正在对Free / WaitFor发表评论.确保使用同步对象以正确的方式结束线程.

猜你在找的Delphi相关文章