为什么多次调用服务 OnCreate？

Question

下面的代码，通过...

procedure TTimetellServiceServerMonitor.ServiceDebugLog(const AMsg: String);
const cDebugLogFile = 'd:\temp\service.log';

... 输出此调试信息，显示我们多次通过 OnCreate（我添加了 - - 描述）：

- 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

我在其 OnCreate 中为服务分配了一个随机标记值，您可以看到它们是不同的。

为什么会发生这种情况，是否存在错误，我是否应该阻止它以及如何阻止它？

(Windows 32 位, Delphi 10.4.2.悉尼)

. 密码：

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 文件：

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 派生自 TDataModule，因此 OnCreate 将在 TService 实例已创建。这显然会在服务将要启动时发生，但也会在安装和卸载时发生。

所以，不，这不是错误，您也不应该阻止它。

或许只是你的预期有误？

为什么多次调用服务 OnCreate？

Why does the service OnCreate get called multiple times?

delphi

service

delphi-10.4-sydney