Delphi service fails to stop itself - multithreading

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.