Delphi, WinSvc.StartService arguments not successfully passed Service app

Question

I'm writing a few Service apps in Delphi 10.2 pro, and I want to add a launch-time-controllable parameter to force the service apps into a start-up wait-loop long enough to allow me to click into the "Run\Attach to Process" window (before the app commences the initialization code).

To accomplish this, I want to put a Sleep loop into the TService.OnCreate handler which only gets activated if Winapi.WinSvc.StartService passes an argument which specifies the desired delay length in seconds.

The problem I am having: The values being placed into lpServiceArgVectors (StartService 3rd argument) aren't available in the ParamStr(1) function from within the service. I've read that there is an issue with the VAR parameter passing of this argument, but I think I've got that accounted for in my test app (StartService always returns TRUE).

I just can't get the parameters to be seen in the service, and I need some help to get around this wall.

I've put together a short(ish) self-contained example. The crux of this example is the interaction between TMainWindow.StartService (where the lpServiceArgVectors get assembled and passed) and the ServiceCreate -> CheckStartUpDelayParam procedures in TSimpleServiceDelayTest. The service logs to a text file which displays some diagnostic logging; the log is in descending order so that the newest data is inserted at the top.

There are 3 different menu items to call StartService (to vary the calling args) Note that the logged value of ParamStr(1) is always regardless of which Start Service menu option is selected:

//-------------- 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

Next, a short GUI Service Interface app to (Un)Install, Start/Stop

//------------- 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

Remy Lebeau · Accepted Answer

The `TService.OnCreate` event is the wrong place to run a delay loop. You need to put it in the `TService.OnStart` event instead.

The OnCreate event is always called at process startup, regardless of why the process is being run - (un)installation or service start.

The OnStart event is called only when the service is being started by the SCM. That is where you need to process your service start parameters.

The ParamStr() function retrieves the calling process's command-line parameters only, and that is not the correct place to look for service start parameters as they are not passed on the command line. They will be accessible from the TService.Param[] property instead, once the SCM has signaled the service to start.

Try something more like this instead:

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 arguments not successfully passed Service app

Answers (1)

The `TService.OnCreate` event is the wrong place to run a delay loop. You need to put it in the `TService.OnStart` event instead.

Related Questions

Delphi, WinSvc.StartService arguments not successfully passed Service app

Answers (1)

The TService.OnCreate event is the wrong place to run a delay loop. You need to put it in the TService.OnStart event instead.

Related Questions

The `TService.OnCreate` event is the wrong place to run a delay loop. You need to put it in the `TService.OnStart` event instead.