Delphi service fails to stop itself

Question

I run a simple service. I can start it and stop it using SCM. I also need the service to stop itself when a condition becomes true.

Question 1 : The service stops when I use the SCM. I click "Stop service", and the service to stop almost instantaneously. However I noticed that the exe stays in the windows task list for about 10 second before stopping. Is that a normal behavior ?

Question 2 : I simulated a condition where I need the service to stop itself by incrementing a variable in the code example below. In this case, the service never stops. I have to kill the task in windows task manager to stop it.

I tried several things without success.

When I stop the service using SCM, the ServiceStop calls the thread Kill method, so thread stops and the service can stop gently.

When the service want to stop itself, the condition is tested from within the thread itself. The thread stops itself, but not the service. So I guess I have to call DoShutDown to tell the service it has to stop. But it does not stop. With or without the DoShutDown call, the service keeps going on.

What am I doing wrong ?

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 :

If I add a ServiceExecute method and modify the Svc thread to just set SelfStop to true (without terminate it), the service ends. But it does not seem very elegant. And I can't figure out why it is needed. In fact, the service seems to create a thread "ServiceExecute" anyway. But if I don't write this method, ProcessRequest is never called and the "ServiceExecute" never ends when the Svc thread ends. Furthermore, the process still stays about 30 seconds in windows task manager (Process Explorer from sysinternals) after the service 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
          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;

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

Answer 1

If the thread wants to terminate itself, it can invoke the SCM informing that the service needs to stop which in turn will terminate the thread as shown in the proof of concept code below. To make this work, I pass an anonymous method to the Thread constructor to avoid to have a dependency on the Service itself (and the thread code can be tested outside a service). If you start the service and do nothing, it will shutdown itself after 10 seconds.

Service code:

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.

Worker thread:

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.