Why does the service OnCreate get called multiple times? - delphi

Question

The code below, via...
procedure TTimetellServiceServerMonitor.ServiceDebugLog(const AMsg: String);
const cDebugLogFile = 'd:\temp\service.log';
... outputs this debug info showing that we go through the OnCreate several times (I added the - - descriptions):
- testsvcserverMonitor /install -
S 1802 servicecreate
S 1802 AfterInstall
- start from services app -
S 1741 servicecreate
S 1741 servicestart
S 1741 MonitorThread.Start
- stop from services app -
S 1741 servicestop
- testsvcserverMonitor /uninstall -
S 1336 servicecreate
S 1336 beforeuninstall
I assign a random tag value to the service in its OnCreate and you can see that these are different.
Why does this happen, is there a bug, should I prevent it and how?
(Windows 32 bit, Delphi 10.4.2. Sydney)
.pas code:
unit USvcServerMonitor;
interface
uses
WinApi.Windows, WinApi.Messages, System.SysUtils, System.Classes, Vcl.SvcMgr, WinApi.WinSvc;
type
TMonitorServiceThread = class(TThread) // Worker thread
private
FCheckLiveEvery,
FLastLiveCheck : TDateTime;
public
procedure Execute; override;
end;
type
TApplicationMonitor = class(TService)
procedure ServiceBeforeUninstall(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
// procedure ServiceExecute(Sender: TService); Not necessary, WorkerThread does the work
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceAfterInstall(Sender: TService);
private
procedure ServiceDebugLog(const AMsg: String);
public
function GetServiceController: TServiceController; override;
end;
var
MonitorThread : TMonitorServiceThread;
ApplicationMonitor: TApplicationMonitor;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
ApplicationMonitor.Controller(CtrlCode);
end;
function TApplicationMonitor.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TApplicationMonitor.ServiceAfterInstall(Sender: TService);
begin
ServiceDebugLog('AfterInstall');
// StartType is stAuto, but start manually after install
end;
procedure TApplicationMonitor.ServiceBeforeUninstall(Sender: TService);
begin
ServiceDebugLog('beforeuninstall');
end;
procedure TApplicationMonitor.ServiceCreate(Sender: TObject);
begin
Self.Tag := 1000 + Random(1000); // For debugging
ServiceDebugLog('servicecreate');
end;
procedure TApplicationMonitor.ServiceStart(Sender: TService; var Started: Boolean);
begin
ServiceDebugLog('servicestart');
MonitorThread := TMonitorServiceThread.Create(true); // Suspended
ServiceDebugLog('MonitorThread.Start');
MonitorThread.Start;
Started := true;
end;
procedure TApplicationMonitor.ServiceDebugLog(const AMsg: String);
// Quick-n-dirty debugging routine
const cDebugLogFile = 'd:\temp\service.log';
var t: textfile;
begin
if not fileexists(cDebugLogFile) then
begin
assignfile(t,cDebugLogFile);
Rewrite(t);
end
else
begin
assignfile(t,cDebugLogFile);
Append(T);
end;
writeln(T,'S ' + Inttostr(self.Tag) + ' ' + AMsg);
closefile(t);
end;
procedure TApplicationMonitor.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceDebugLog('servicestop');
MonitorThread.Terminate;
Sleep(100);
MonitorThread.Free;
Sleep(100);
Stopped := True;
end;
{ TMonitorServiceThread }
procedure TMonitorServiceThread.Execute;
begin
inherited;
FLastLiveCheck := Now;
FCheckLiveEvery := 1;
while not Terminated do
begin
try
if (FCheckLiveEvery > 0) and (Now-FLastLiveCheck > FCheckLiveEvery/1440) then
begin
// Do some checks
FLastLiveCheck := Now;
end;
Sleep(500);
finally
end;
end;
end;
end.
.dfm file:
object ApplicationMonitor: TApplicationMonitor
Tag = 123
OldCreateOrder = False
OnCreate = ServiceCreate
AllowPause = False
DisplayName = 'Test Application Monitor Service'
AfterInstall = ServiceAfterInstall
BeforeUninstall = ServiceBeforeUninstall
OnStart = ServiceStart
OnStop = ServiceStop
Height = 250
Width = 400
end

Answer 1

TService is derived from TDataModule, so OnCreate will be called when the TService instance is created. That obviously happens when the service is going to be started, but also when it is installed and uninstalled.
So, no, it is not a bug and you also should not prevent it.
Perhaps it is just that your expectations are wrong?