德尔福服务无法自行停止

问题描述：

我运行一项简单的服务。我可以启动它并使用SCM停止它。当条件成立时，我也需要服务来停止自己。德尔福服务无法自行停止

问题1：服务在我使用SCM时停止。我点击“停止服务”，服务几乎立即停止。但是我注意到exe在停止之前停留在窗口任务列表中约10秒钟。这是一种正常的行为？

问题2：我模拟了一个条件，我需要服务通过在下面的代码示例中增加一个变量来停止自己。在这种情况下，服务从不停止。我必须杀死Windows任务管理器中的任务来停止它。

我尝试了几件没有成功的事情。

当我停止使用SCM的服务时，ServiceStop调用线程Kill方法，因此线程停止并且服务可以轻轻停止。

当服务想要自己停止时，条件在线程本身内进行测试。线程自行停止，但不是服务。所以我想我必须拨打DoShutDown来告诉它必须停止的服务。但它并没有停止。无论有没有DoShutDown呼叫，服务都会继续。

我在做什么错？

unit TestSvc; 

interface 

uses 
System.SyncObjs 
,SysUtils 
,Windows 
,SvcMgr 
,Classes 
; 


Type 
    TSvcTh = class(TThread) 
    private 
    FEvent : TEvent; 
    FInterval : Cardinal; 
    vi_dbg : byte; 
    protected 
    procedure Execute; override; 
    procedure DoTimer; 
    public 
    procedure Kill; 
    Constructor Create(); 
    Destructor Destroy; override; 
end; 

type 
    TMyService = class(TService) 
    procedure ServiceCreate(Sender: TObject); 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    procedure ServiceShutdown(Sender: TService); 
    procedure ServiceStop(Sender: TService; var Stopped: Boolean); 
    private 
    SelfStop : Boolean; 
    Svc : TSvcTh; 
    public 
    function GetServiceController: TServiceController; override; 
    end; 
    var MyService: TMyService; 




implementation 

procedure ServiceController(CtrlCode: DWord); stdcall; 
const sname='ServiceController'; 
begin 
    MyService.Controller(CtrlCode); 
end; 
function TMyService.GetServiceController: TServiceController; 
const sname='TMyService.GetServiceController'; 
begin 
    Result := ServiceController; 
end; 
procedure TMyService.ServiceCreate(Sender: TObject); 
const sname='TMyService.ServiceCreate'; 
begin 
    try 
    Name := SvcName; 
    except 
    on e: exception do begin 
    end; 
    end; 
end; 


procedure TMyService.ServiceShutdown(Sender: TService); 
const sname='TMyService.ServiceShutdown'; 
var Stopped : boolean; 
begin 
    ServiceStop(Self, Stopped); 
end; 

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean); 
const sname='TMyService.ServiceStart'; 
begin 
    SelfStop := false; 
    Started := false; 
    try 
     Dbg(sname + ' ******* STARTING THREAD'); 
     Svc := TSvcTh.Create; 
     Dbg(sname + '******* THREAD STARTED'); 
     Started := true; 
    except 
     on e : exception do begin 
     Dbg(sname + '============== EXCEPTION =============>' + e.Message); 
     end; 
    end; 
end; 

procedure TMyService.ServiceStop(Sender: TService; var Stopped: Boolean); 
const sname='TMyService.ServiceStop'; 
begin 
    try 

    Stopped := True; 

    if not SelfStop then begin 
     Dbg(sname + '*** Stop using service controller'); 
     Svc.Kill; 
     Svc.WaitFor; 
     Svc.Free; 
     Svc := nil; 
    end 
    else begin 
     dbg(sname + ' *** Stop by the service itself ') ; 
    end; 

    except 
    on E : Exception do 
    begin 
     dbg(sname + ' Exception ! ' + e.Message); 
    end; 
    end; 
    Dbg(sname + '*** END'); 
end; 

procedure TSvcTh.DoTimer; 
const sname = 'TSvcTh.DoTimer'; 
begin 
    try 
    inc(vi_dbg); 
    Dbg(sname + '******* DoTimer'); 
    except 
    on e : exception do begin 
     Dbg(sname +' ============== EXCEPTION =============>' + e.Message); 
    end; 
    end; 
end; 

procedure TSvcTh.Execute; 
const sname = 'TSvcTh.Execute'; 
begin 
    while not Terminated do begin 
     try 
     case FEvent.WaitFor(FInterval) of 
     wrSignaled : begin // Triggered when we stop the service using service controller 
      Terminate; 
     end; 
     wrTimeout : begin 
      if not Servicemni.SelfStop then begin 
      DoTimer; 
      if vi_dbg > 5 then begin 
       MyService.SelfStop := true; // Testing auto stop 
       terminate; 
      end; 
      end; 
     end; 
     end; 
     except 
     on e : exception do begin 
      Dbg(sname + ' ============== EXCEPTION =============>' + e.Message); 
     end; 
     end; 
    end; 


    if MyService.SelfStop then begin 
    MyService.DoShutdown; 
    end; 

    Dbg(sname + ' ARRET ... ' + StrLog(MyService.Terminated)); 
    if MyService.SelfStop then begin 
    MyService.ReportStatus; 
    end; 


end; 

Constructor TSvcTh.Create(); 
const sname = 'TSvcTh.Create'; 
begin 
    FEvent := TEvent.Create(nil, False, False, ''); 
    FInterval := heartbeat; 
    vi_dbg := 0; 
    inherited Create(False); 
end; 
destructor TSvcTh.Destroy; 
const sname = 'TSvcTh.Destroy'; 
begin 
    try 
    if assigned(FEvent) then begin 
     FreeAndNil(FEvent); 
    end; 
    except 
    on e:exception do begin 
     Dbg(sname + '==========================> EXCEPTION : '+ e.Message); 
    end; 
    end; 
    inherited; 
end; 

procedure TSvcTh.Kill; 
const sname = 'TSvcTh.Kill'; 
begin 
    try 
    FEvent.SetEvent; 
    except 
    on e:exception do begin 
     dbg(sname + ' ==========================> EXCEPTION : '+ e.Message); 
    end; 
    end; 
end; 



end.

UPDATE：

如果我添加一个ServiceExecute方法和修改SVC线程刚刚成立SelfStop为true（不终止它），服务结束。但它看起来不太优雅。而我无法弄清楚为什么它是需要的。事实上，该服务似乎无论如何创建一个线程“ServiceExecute”。但是如果我不写这个方法，那么ProcessRequest永远不会被调用，并且当Svc线程结束时，“ServiceExecute”永远不会结束。此外，该过程在服务结束后的windows任务管理器（sysinternals的Process Explorer）中仍然保持约30秒。

procedure TSvcTh.Execute; 
const sname = 'TSvcTh.Execute'; 
begin 
    while not Terminated do begin 
     try 
     case FEvent.WaitFor(FInterval) of 
     wrSignaled : begin // Triggered when we stop the service using service controller 
      Terminate; 
     end; 
     wrTimeout : begin 
      DoTimer; 
      if vi_dbg > 5 then begin 
      MyService.SelfStop := true; // Testing auto stop 
      end; 
     end; 
     end; 
     except 
     on e : exception do begin 
      Dbg(sname + ' ============== EXCEPTION =============>' + e.Message); 
     end; 
     end; 
    end; 
end; 

procedure TMyService.ServiceExecute(Sender: TService); 
    begin 
    while not terminated do begin 
     ServiceThread.ProcessRequests(false); 
     if SelfStop then begin 
     ServiceThread.terminate; 
     Svc.Terminate; 
     Svc.WaitFor; 
     Svc.Free; 
     Svc := nil; 
     end; 
     sleep(1000);  
    end;

更新2：The explication for the delay of 30 seconds for the service to terminate seems to be here

为什么他们从来没有使用过每个PROC说明那些consts和停止变量从未设置。我会发现它是否令人惊讶 –

你在谈论sname常量吗？仅用于调试目的。只有在日志中获取proc名称的方法。该代码被简化为张贴在这里。我没有删除常量。就这样。停止的变量已设置，未读取。我猜测它是由SCM使用的。 – user2244705

了解我认为你应该从问题中删除它们。顺便说一下，函数的名称显示在callstack窗口中，所以你不需要这个我认为 –

答

如果线程要终止本身，它可以调用SCM，通知该服务需要停止这反过来将终止线程所示的概念证明代码下面。为了做到这一点，我将一个匿名方法传递给线程构造函数，以避免对服务本身产生依赖（并且线程代码可以在服务之外进行测试）。如果您启动服务并且什么都不做，它将在10秒后自行关闭。

服务代码：

unit Unit1; 

interface 

uses 
    Unit2, 
    WinApi.WinSvc, 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs; 

type 
    TService1 = class(TService) 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    procedure ServiceStop(Sender: TService; var Stopped: Boolean); 
    private 
    { Private declarations } 
    MyThread : TMyThread; 
    Eventlog : TEventLogger; 
    public 
    function GetServiceController: TServiceController; override; 
    { Public declarations } 
    end; 

var 
    Service1: TService1; 

implementation 

{$R *.dfm} 

procedure ServiceController(CtrlCode: DWord); stdcall; 
begin 
    Service1.Controller(CtrlCode); 
end; 

function TService1.GetServiceController: TServiceController; 
begin 
    Result := ServiceController; 
end; 

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean); 
begin 
EventLog := TEventLogger.Create('Service1'); 
// call our thread and inject code for premature service shutdown 
MyThread := TMyThread.Create(procedure begin Service1.Controller(SERVICE_CONTROL_STOP) end); 
MyThread.Start; 
EventLog.LogMessage('Started'); 
end; 

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean); 
begin 
EventLog.LogMessage('Stop'); 
MyThread.Terminate; 
// Give some time to the thread to cleanup, then bailout 
WaitForSingleObject(MyThread.Handle, 5000); 
EventLog.LogMessage('Stopped'); 
EventLog.Free; 
Stopped := True; 
end; 

end.

工作线程：

unit Unit2; 

interface 

uses 
    SysUtils, 
    Vcl.SvcMgr, 
    Windows, 
    System.Classes; 

type 
    TSimpleProcedure = reference to procedure; 

    TMyThread = class(TThread) 
    private 
    { Private declarations } 
    ShutDownProc : TSimpleProcedure; 
    EventLog  : TEventLogger; 
    protected 
    procedure Execute; override; 
    public 
    constructor Create(AShutDownProc: TSimpleProcedure); 
    destructor Destroy; override; 
    end; 

implementation 

{ MyThread } 
constructor TMyThread.Create(AShutDownProc: TSimpleProcedure); 
begin 
inherited Create(True); 
ShutDownProc := AShutDownProc; 
end; 

procedure TMyThread.Execute; 

var 
    Count : Integer; 
    Running : Boolean; 

begin 
EventLog := TEventLogger.Create('MyThread'); 
EventLog.LogMessage('Thread Started'); 
Count := 0; 
Running := True; 
while not Terminated and Running do 
    begin 
    EventLog.LogMessage(Format('Count: %d', [Count])); 
    Running := Count <> 10; 
    Inc(Count); 
    if Running then 
    Sleep(1000); // do some work 
    end; 
// if thread wants to stop itself, call service thread shutdown and wait for termination 
if not Running and not Terminated then 
    begin 
    EventLog.LogMessage(Format('Thread Wants to Stop', [Count])); 
    ShutDownProc(); 
    end; 
EventLog.LogMessage(Format('Thread Await terminate', [Count])); 
// await termination 
while not Terminated do Sleep(10); 
EventLog.LogMessage(Format('Thread Terminated', [Count])); 
EventLog.Free; 
end; 

end.

谢谢@whorsdaddy，我不在我的办公室，直到星期三，我会尽快尝试。 – user2244705

非常感谢whorsdaddy，这就像一个魅力。 – user2244705

德尔福服务无法自行停止

相关推荐