德爾福服務無法自行停止

我運行一項簡單的服務。我可以啓動它並使用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

來源

2017-10-13 user2244705

爲什麼他們從來沒有使用過每個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.

來源

2017-10-13 21:18:36 whosrdaddy

謝謝@whorsdaddy，我不在我的辦公室，直到星期三，我會盡快嘗試。 – user2244705

非常感謝whorsdaddy，這就像一個魅力。 – user2244705

德爾福服務無法自行停止

回答

相關問題