為什么服務OnCreate被多次呼叫？

下面的代碼，通過...

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。悉尼）

.pas 代碼：

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

uj5u.com熱心網友回復：

TService派生自TDataModule，因此在創建TService實體時將呼叫OnCreate。這顯然會在服務啟動時發生，也會在安裝和卸載時發生。

所以，不，這不是一個錯誤，你也不應該阻止它。

也許只是你的期望是錯誤的？

標籤：德尔福 服务 delphi-10.4-悉尼

上一篇：您的實時資料庫有不安全的規則

下一篇：如何將流從Delphi傳遞到C#？[復制]