Question

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

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

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

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

我整理了一个简短的独立示例。此示例的症结在于TMainWindow.StartService（在其中组装并传递lpServiceArgVectors）与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 ? *********
  // docs.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`事件是运行延迟循环的错误位置。您需要将其放在`TService.OnStart`事件中。

OnCreate事件始终在进程启动时调用，无论运行该进程的原因-（取消）安装或启动服务。

仅在SCM正在启动服务时才调用OnStart事件。那是您需要处理服务启动参数的地方。

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

请尝试以下类似操作：

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;

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

1 个答案:

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

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

1 个答案:

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

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