Le service Delphi ne parvient pas à s'arrêter

Question

Je cours un service simple. Je peux le démarrer et l'arrêter en utilisant SCM. J'ai aussi besoin que le service s'arrête quand une condition devient vraie.

Question 1: Le service s'arrête lorsque j'utilise le SCM. Je clique sur "Stop service", et le service s'arrête presque instantanément. Cependant, j'ai remarqué que l'exe reste dans la liste des tâches Windows pendant environ 10 secondes avant de s'arrêter. Est-ce un comportement normal?

Question 2: J'ai simulé une condition où j'ai besoin que le service s'arrête en incrémentant une variable dans l'exemple de code ci-dessous. Dans ce cas, le service ne s'arrête jamais. Je dois tuer la tâche dans le gestionnaire de tâches Windows pour l'arrêter.

J'ai essayé plusieurs choses sans succès.

Lorsque j'arrête le service à l'aide de SCM, ServiceStop appelle la méthode thread Kill, le thread s'arrête et le service peut s'arrêter doucement.

Lorsque le service veut s'arrêter, la condition est testée à partir du thread même. Le thread s'arrête lui-même, mais pas le service. Donc je suppose que je dois appeler DoShutDown pour dire au service qu'il doit s'arrêter. Mais ça ne s'arrête pas. Avec ou sans l'appel DoShutDown, le service continue.

Qu'est-ce que je fais mal?

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. 

MISE À JOUR:

Si j'ajoute une méthode ServiceExecute et modifier le fil Svc juste mettre SelfStop true (sans y mettre fin), fin de service. Mais cela ne semble pas très élégant. Et je ne peux pas comprendre pourquoi c'est nécessaire. En fait, le service semble créer un thread "ServiceExecute" de toute façon. Mais si je n'écris pas cette méthode, ProcessRequest n'est jamais appelé et le "ServiceExecute" ne se termine jamais lorsque le thread Svc se termine. En outre, le processus reste toujours environ 30 secondes dans le gestionnaire de tâches Windows (Process Explorer de sysinternals) après la fin du service.

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; 

MISE À JOUR 2: The explication for the delay of 30 seconds for the service to terminate seems to be here

Answer 1

Si le thread veut se terminer, il peut invoquer le SMC informant que le service doit cesser à son tour prendra fin le fil comme indiqué dans la démonstration du code d'exploitation au dessous de. Pour que cela fonctionne, je passe une méthode anonyme au constructeur Thread pour éviter d'avoir une dépendance sur le service lui-même (et le code thread peut être testé en dehors d'un service). Si vous démarrez le service et ne faites rien, il s'éteindra après 10 secondes.

Code de service:

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. 

fil des travailleurs:

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.