Delphi、WinSvc.StartService 参数未成功传递给服务应用程序

Question

我正在 Delphi 10.2 pro 中编写一些服务应用程序，我想添加一个启动时间可控参数来强制服务应用程序进入启动等待循环足够长的时间，以便我可以单击进入“运行\附加到进程”窗口(在应用程序开始初始化代码之前)。

为了实现此目的，我想将一个 sleep 循环放入 TService.OnCreate 处理程序中，只有当 Winapi.WinSvc.StartService 传递指定所需延迟长度(以秒为单位)的参数时，该处理程序才会被激活。

我遇到的问题:放置到 lpServiceArgVectors(StartService 第三个参数)中的值在服务内的 ParamStr(1) 函数中不可用。我读到该参数的 VAR 参数传递存在问题，但我认为我已经在我的测试应用程序中解决了这个问题(StartService 始终返回 TRUE)。

我只是无法获取在服务中看到的参数，我需要一些帮助来绕过这堵墙。

我整理了一个简短的独立示例。此示例的关键在于 TMainWindow.StartService(其中 lpServiceArgVector 被组装并传递)与 TSimpleServiceDelayTest 中的 ServiceCreate -> CheckStartUpDelayParam 过程之间的交互。该服务将日志记录到一个文本文件中，该文件显示一些诊断日志记录；日志按降序排列，以便最新的数据插入到顶部。

有 3 个不同的菜单项可调用 StartService(以改变调用参数)请注意，无论选择哪个 Start Service 菜单选项，ParamStr(1) 的记录值始终为:

//-------------- SimpleHeartbeatService.dpr --------------

program SimpleHeartbeatService;

uses
  Vcl.SvcMgr,
  ServiceUnit in 'ServiceUnit.pas' {SimpleServiceDelayTest: TService};

{$R *.RES}

begin
  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TSimpleServiceDelayTest, SimpleServiceDelayTest);
  Application.Run;
end.

//------------------ ServiceUnit.pas ------------------------ -----

unit ServiceUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs;

type
  TSimpleServiceDelayTest = class(TService)
    procedure ServiceExecute(Sender: TService);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceDestroy(Sender: TObject);
  private
    PrevHeartbeatStr: String;
    ServiceLog: TStringList;
    Procedure CheckStartUpDelayParam;
    Procedure DriveHeartbeatLogging;
    Procedure Log(Const Msg: String);
    Function LogFileName: String;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  SimpleServiceDelayTest: TSimpleServiceDelayTest;

implementation

{$R *.dfm}

// =============================================================================

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  SimpleServiceDelayTest.Controller(CtrlCode);
end;

// =============================================================================

Procedure TSimpleServiceDelayTest.CheckStartUpDelayParam;
Const
  OneSec = 1 / 86400;
Var
  DelaySecs: Integer;
  TZero: TDateTime;
Begin
  Log('CheckStartUpDelayParam');
  Log('ParamStr(0)=' + ParamStr(0));
  Log('ParamStr(1)=' + ParamStr(1));
  // ********** THIS IS THE GOAL OF THIS WHOLE ENDEAVOR: **********
  // I want to pause the initialization long enough to attach the
  // Delphi  debugger (via Run | Attach to Process...)
  // I want to pass a command line parameter via the NumArgs/pArgVectors args
  // from: Winapi.WinSvc.StartService(Svc, NumArgs, pArgVectors)
  // So far, I have not been able to pass arguments this way.
  DelaySecs := StrToIntDef(ParamStr(1), 0);
  If DelaySecs > 0 Then
  Begin
    TZero := Now;
    While Now - TZero > DelaySecs * OneSec do
      Sleep(250);
  End;
End;

// =============================================================================

Procedure TSimpleServiceDelayTest.DriveHeartbeatLogging;
Var
  HeartbeatStr: String;
begin
  HeartbeatStr := FormatDateTime('hh:mm', Now);
  If HeartbeatStr <> PrevHeartbeatStr Then
    Try
      Log('HeartbeatStr = ' + HeartbeatStr);
    Finally
      PrevHeartbeatStr := HeartbeatStr;
    End;
end;

// =============================================================================

function TSimpleServiceDelayTest.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

// =============================================================================

Procedure TSimpleServiceDelayTest.Log(const Msg: string);
begin
  ServiceLog.Insert(0, FormatDateTime('yyyy/mm/dd hh:mm:ss.zzz ', Now) + Msg);
  While ServiceLog.Count > 500 do
    ServiceLog.Delete(ServiceLog.Count-1);
  // Save after every addition; inefficient, but thorough for debugging
  ServiceLog.SaveToFile(LogFileName);
end;

// =============================================================================

Function TSimpleServiceDelayTest.LogFileName: String;
Begin
  Result := System.SysUtils.ChangeFileExt(ParamStr(0), '.txt');
End;

// =============================================================================

procedure TSimpleServiceDelayTest.ServiceCreate(Sender: TObject);
begin
  ServiceLog := TStringList.Create;
  If FileExists(LogFileName) Then
    ServiceLog.LoadFromFile(LogFileName);
  Log('^^^ ServiceCreate ^^^');
  CheckStartUpDelayParam;
end;

// =============================================================================

procedure TSimpleServiceDelayTest.ServiceDestroy(Sender: TObject);
begin
  PrevHeartbeatStr := '';
  ServiceLog.Free;
end;

// =============================================================================

procedure TSimpleServiceDelayTest.ServiceExecute(Sender: TService);
begin
  Try
    Log('Entering ServiceExecute loop');
    While Not Terminated do
    Begin
      ServiceThread.ProcessRequests(False);
      DriveHeartbeatLogging;
      // Do other stuff
      Sleep(1000);
    End;
    Log('Exiting due to normal termination');
  Except
    On E: Exception do
      Log('Exiting due to Exception:' + #13#10 + E.Message);
  End;
End;

// =============================================================================

procedure TSimpleServiceDelayTest.ServiceShutdown(Sender: TService);
begin
  Log('ServiceShutdown');
end;

// =============================================================================

procedure TSimpleServiceDelayTest.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  Log('ServiceStart');
  Started := True;
end;

// =============================================================================

procedure TSimpleServiceDelayTest.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  Log('ServiceStop');
  Stopped := True;
end;

// =============================================================================

end.

//------------ ServiceUnit.dfm --------------------------

object SimpleServiceDelayTest: TSimpleServiceDelayTest
  OldCreateOrder = False
  OnCreate = ServiceCreate
  OnDestroy = ServiceDestroy
  DisplayName = 'Simple Delphi Service (Startup-Delay Test)'
  OnExecute = ServiceExecute
  OnShutdown = ServiceShutdown
  OnStart = ServiceStart
  OnStop = ServiceStop
  Height = 150
  Width = 215
end

接下来，一个简短的 GUI 服务界面应用程序，用于(卸载)安装、启动/停止

//------------- SimpleServiceController.dpr ------------

program SimpleServiceController;

uses
  Vcl.Forms,
  ControllerMainUnit in 'ControllerMainUnit.pas' {MainWindow};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TMainWindow, MainWindow);
  Application.Run;
end.

//-------------- ControlerMainUnit.pas ------------------

unit ControllerMainUnit;

interface

uses
  System.Classes, System.SysUtils, System.Variants, Vcl.ComCtrls,
  Vcl.Controls, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.Menus,
  Vcl.StdCtrls, Winapi.Messages, Winapi.Windows;

type
  TMainWindow = class(TForm)
    InstallService1: TMenuItem;
    MainMenu1: TMainMenu;
    Memo1: TMemo;
    StartService1: TMenuItem;
    StopService1: TMenuItem;
    Timer1: TTimer;
    UninstallService1: TMenuItem;
    StatusBar1: TStatusBar;
    StartWithoutDelayMenuItem: TMenuItem;
    StartWith10SecondDelay1: TMenuItem;
    StartWithXParameter1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure InstallService1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StartWithoutDelayMenuItemClick(Sender: TObject);
    procedure StartWith10SecondDelay1Click(Sender: TObject);
    procedure StopService1Click(Sender: TObject);
    procedure UninstallService1Click(Sender: TObject);
    procedure StartWithXParameter1Click(Sender: TObject);
  private
    { Private declarations }
    FileTimeLoaded: _FILETIME;
    SCMError: Cardinal;
    SCMHandle: THandle;
    StatusStr: String;
    Function CurrentFileTime: _FILETIME;
    Function LogFileName: String;
    Procedure RelaunchElevatedPrompt;
    Function ServiceExePath: String;
    Procedure StartService(Const Parameter: String);
    Procedure StopService;
  public
    { Public declarations }
  end;

var
  MainWindow: TMainWindow;

implementation

{$R *.dfm}

Uses
  System.UITypes, Winapi.ShellAPI, Winapi.WinSvc;

Const
  cServiceName = 'SimpleServiceDelayTest';

// =============================================================================

Function AppHasElevatedPrivs: Boolean;

const
  TokenElevationType = 18;
  TokenElevation = 20;
  TokenElevationTypeDefault = 1;
  TokenElevationTypeFull = 2;
  TokenElevationTypeLimited = 3;

var
  token: THandle;
  Elevation: DWord;
  dwSize: Cardinal;

begin
  Try
    if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, token) then
      try
        if GetTokenInformation(token, TTokenInformationClass(TokenElevation),
          @Elevation, SizeOf(Elevation), dwSize) then
          Result := Elevation <> 0
        else
          Result := False;
      finally
        CloseHandle(token);
      end
    else
      Result := False;
  Except
    Result := False;
  End;
End;

// =============================================================================

Procedure Launch(Exe, Params: String);
Var
  Dir: String;
Begin
  Dir := ExtractFileDir(Exe);
  ShellExecute(0, 'open', PChar(Exe), PChar(Params), PChar(Dir), SW_SHOWNORMAL);
End;

// =============================================================================

Function NowStr: String;
Begin
  Result := FormatDateTime('yyyy/mm/dd hh:mm:ss', Now);
End;

// =============================================================================

Procedure LaunchElevated(Const Exe, Params: String);
Var
  Dir: String;
Begin
  Dir := ExtractFileDir(Exe);
  ShellExecute(0, 'runas', PChar(Exe), PChar(Params), PChar(Dir),
    SW_SHOWNORMAL);
End;

// =============================================================================

Function TMainWindow.CurrentFileTime;
Var
  FAD: TWin32FileAttributeData;
begin
  GetFileAttributesEx(PChar(LogFileName), GetFileExInfoStandard, @FAD);
  Result := FAD.ftLastWriteTime;
end;

// =============================================================================

procedure TMainWindow.FormCreate(Sender: TObject);
begin
  Application.Title := 'SimpleServiceController';
  if AppHasElevatedPrivs then
  begin
    SetLastError(0);
    SCMHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
    SCMError := GetLastError;
  end
  else
  begin
    SCMHandle := 0;
    SCMError := 0;
  end;
end;

// =============================================================================

procedure TMainWindow.InstallService1Click(Sender: TObject);
begin
  If AppHasElevatedPrivs Then
    Launch(ServiceExePath, '/install')
  Else
    LaunchElevated(ServiceExePath, '/install');
End;

// =============================================================================

Function TMainWindow.LogFileName: String;
Begin
  Result := ExtractFileDir(Application.ExeName) + '\SimpleHeartbeatService.txt';
End;

// =============================================================================

Procedure TMainWindow.RelaunchElevatedPrompt;
Var
  Prompt: String;
  X, Y: Integer;
Begin
  Prompt := 'Elevated privileges required to start/stop service.'#13#10 +
    'Re-launch ' + Application.Title + ' with elevated privileges?';
  X := Left + 32;
  Y := Top + 32;
  If MessageDlgPos(Prompt, mtConfirmation, [mbYes, mbNo], 0, X, Y) = mrYes then
  Begin
    LaunchElevated(Application.ExeName, '');
    Close;
  End;
End;

// =============================================================================

Function TMainWindow.ServiceExePath;
begin
  Result := ExtractFileDir(Application.ExeName) + '\SimpleHeartbeatService.exe';
end;

// =============================================================================

Procedure TMainWindow.StartService(Const Parameter: string);
Var
  Result:Boolean;
  Svc: THandle;
  NumArgs: DWord;
  // ********** IS THIS THE CORRECT WAY TO SETUP lpServiceArgVectors ? *********
  // learn.microsoft.com/en-us/windows/desktop/api/winsvc/nf-winsvc-startservicea
  // ***************************************************************************
  ArgVectors: Array [0 .. 1] of PChar;
  pArgVectors: LPCWSTR; // To match VAR parameter type in StartService

Begin
  Try
    If SCMHandle = 0 Then
      RelaunchElevatedPrompt
    Else
    Begin
      Svc := OpenService(SCMHandle, PChar(cServiceName), SERVICE_START);
      if Svc = 0 then
        RaiseLastOSError;
      try
        // ******************* THIS IS WHERE I AM STYMIED **********************
        // StartService reports no errors either way it gets called below,
        // but no parameter are detected in the service when
        // ArgVectors = 'SimpleServiceDelayTest','10' and NumArgs = 2
        // *********************************************************************
        If Parameter <> '' Then
        Begin
          NumArgs := 2;
          ArgVectors[0] := PChar(cServiceName);
          ArgVectors[1] := PChar(Parameter); // Try 10 second delay
          pArgVectors := @ArgVectors;
        End
        Else
        Begin
          NumArgs := 0;
          ArgVectors[0] := '';
          ArgVectors[1] := '';
          pArgVectors := Nil;
        End;
        // NO ERROR, EITHER WAY; BUT PARAMSTR(1) ALWAYS BLANK IN SERVICE
        If Parameter = 'X'
          Then
            // http://codeverge.com/embarcadero.delphi.nativeapi/calling-startservice-with-multip/1067853
            Result := Winapi.WinSvc.StartService(Svc, NumArgs, ArgVectors[0])
          Else
            Result := Winapi.WinSvc.StartService(Svc, NumArgs, pArgVectors);
        If Result then
          ShowMessage('StartService('''+Parameter+''') returned TRUE')
        else
          RaiseLastOSError;
      finally
        CloseServiceHandle(Svc);
      end;
    End;
  except
    On E: Exception do
      Raise Exception.Create('StartService: ' + E.Message);
  end;
end;

// =============================================================================

procedure TMainWindow.StartWith10SecondDelay1Click(Sender: TObject);
begin
  StartService('10');
end;

// =============================================================================

procedure TMainWindow.StartWithoutDelayMenuItemClick(Sender: TObject);
begin
  StartService('');
end;

procedure TMainWindow.StartWithXParameter1Click(Sender: TObject);
begin
  StartService('X');
end;

// =============================================================================

Procedure TMainWindow.StopService;
Const
  OneSec = 1 / 86400;
Var
  Svc: THandle;
  Status: SERVICE_STATUS;
  TZero: TDateTime;
begin
  Try
    If SCMHandle = 0 Then
      RelaunchElevatedPrompt
    Else
    Begin
      Svc := OpenService(SCMHandle, PChar(cServiceName), SERVICE_STOP or
        SERVICE_QUERY_STATUS);
      if Svc = 0 then
        RaiseLastOSError
      else
        Try
          if Winapi.WinSvc.ControlService(Svc, SERVICE_CONTROL_STOP, Status)
          then
          Begin
            TZero := Now;
            while QueryServiceStatus(Svc, Status) and
              (Status.dwCurrentState <> SERVICE_STOPPED) and
              (Now - TZero < 5 * OneSec) do
            Begin
              Application.ProcessMessages;
              Sleep(10);
            End;
          End
          Else
            Raise Exception.Create('WinSvc.ControlService returned FALSE');
        finally
          CloseServiceHandle(Svc);
        end;
    End;
  except
    On E: Exception do
      Raise Exception.Create('StartService: ' + E.Message);
  end;
end;

// =============================================================================

procedure TMainWindow.StopService1Click(Sender: TObject);
begin
  StopService;
end;

// =============================================================================

procedure TMainWindow.Timer1Timer(Sender: TObject);
begin
  Try
    If Int64(CurrentFileTime) <> Int64(FileTimeLoaded) Then
    Begin
      Memo1.Lines.LoadFromFile(LogFileName);
      FileTimeLoaded := CurrentFileTime;
      StatusStr := ' File loaded @ ' + NowStr;
    End;
  Except
    StatusStr := ' Unable to load file @ ' + NowStr;
  End;
  StatusBar1.Panels[0].Text := FormatDateTime('hh:mm:ss ', Now) + StatusStr;
end;

// =============================================================================

procedure TMainWindow.UninstallService1Click(Sender: TObject);
begin
  If AppHasElevatedPrivs Then
    Launch(ServiceExePath, '/uninstall')
  Else
    LaunchElevated(ServiceExePath, '/uninstall');
end;

// =============================================================================

end.

//--------------------------------ControllerMainUnit.dfm ----------------

object MainWindow: TMainWindow
  Left = 0
  Top = 0
  Caption = 'Simple Service Controller'
  ClientHeight = 264
  ClientWidth = 530
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 530
    Height = 245
    Align = alClient
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    Lines.Strings = (
      'Memo1')
    ParentFont = False
    ScrollBars = ssBoth
    TabOrder = 0
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 245
    Width = 530
    Height = 19
    Panels = <
      item
        Width = 50
      end>
  end
  object MainMenu1: TMainMenu
    Left = 136
    Top = 40
    object InstallService1: TMenuItem
      Caption = 'Install Service'
      OnClick = InstallService1Click
    end
    object UninstallService1: TMenuItem
      Caption = 'Uninstall Service'
      OnClick = UninstallService1Click
    end
    object StartService1: TMenuItem
      Caption = 'Start Service'
      object StartWithoutDelayMenuItem: TMenuItem
        Caption = 'Start Without Delay'
        OnClick = StartWithoutDelayMenuItemClick
      end
      object StartWith10SecondDelay1: TMenuItem
        Caption = 'Start With 10 Second Delay'
        OnClick = StartWith10SecondDelay1Click
      end
      object StartWithXParameter1: TMenuItem
        Caption = 'Start With "X" Parameter'
        OnClick = StartWithXParameter1Click
      end
    end
    object StopService1: TMenuItem
      Caption = 'Stop Service'
      OnClick = StopService1Click
    end
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 240
    Top = 40
  end
end

Answer 1

TService.OnCreate event 是运行延迟循环的错误位置。您需要将其放入 TService.OnStart而是事件。

OnCreate 事件始终在进程启动时调用，无论进程运行的原因 -(卸载)安装还是服务启动。

仅当 SCM 启动服务时才会调用 OnStart 事件。这就是您需要处理服务启动参数的地方。

ParamStr()函数仅检索调用进程的命令行参数，这不是查找服务启动参数的正确位置，因为它们不是在命令行上传递的。可以通过 TService.Param[] 访问它们一旦 SCM 发出服务启动信号，则改为属性。

尝试更多类似这样的事情:

Procedure TSimpleServiceDelayTest.CheckStartUpDelayParam;
const
  OneSec = 1000;
var
  DelaySecs: Integer;
  TZero: DWORD;
  i, num: Integer;
begin
  Log('CheckStartUpDelayParam');

  DelaySecs := 0;
  for i := 0 to ParamCount-1 do
  begin
    Log('Param['+IntToStr(i)+']=' + Param[i]);
    if DelaySecs = 0 then
    begin
      if TryStrToInt(Param[i], num) and (num > 0) then
        DelaySecs := num;
    end;
  end;

  if DelaySecs > 0 then
  begin
    TZero := GetTickCount();
    repeat
      Sleep(250);  // NOTE: should not exceed the TService.WaitHint value...
      ReportStatus;
    until (GetTickCount() - TZero) >= (DelaySecs * OneSec);
  end;
end;

...

procedure TSimpleServiceDelayTest.ServiceCreate(Sender: TObject);
begin
  ServiceLog := TStringList.Create;
  if FileExists(LogFileName) then
    ServiceLog.LoadFromFile(LogFileName);
  Log('^^^ ServiceCreate ^^^');
  // DO NOT call CheckStartUpDelayParam() here!
end;

procedure TSimpleServiceDelayTest.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Log('ServiceStart');
  // call CheckStartUpDelayParam() here instead!
  CheckStartUpDelayParam;
  Started := True;
end;

procedure TMainWindow.StartService(Const Parameter: string);
var
  Result: Boolean;
  Svc: THandle;
  ArgVectors: Array [0 .. 1] of PChar;
  NumArgs: DWORD;
  pArgs: PPChar;
begin
  try
    if SCMHandle = 0 Then
      RelaunchElevatedPrompt
    else
    begin
      Svc := OpenService(SCMHandle, PChar(cServiceName), SERVICE_START);
      if Svc = 0 then
        RaiseLastOSError;
      try
        if Parameter <> '' then
        begin
          NumArgs := 2;
          ArgVectors[0] := PChar(cServiceName);
          ArgVectors[1] := PChar(Parameter);
          pArgs := @ArgVectors[0];
        end
        else
        begin
          NumArgs := 0;
          pArgs := nil;
        end;
        if not Winapi.WinSvc.StartService(Svc, NumArgs, pArgs^) then
          RaiseLastOSError;
      finally
        CloseServiceHandle(Svc);
      end;
      ShowMessage('StartService('''+Parameter+''') returned TRUE')
    end;
  except
    on E: Exception do
    begin
      raise Exception.Create('StartService: ' + E.Message);
    end;
  end;
end;