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
