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

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

CodePudding user response：

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?