Question

I’m looking for Delphi sample code to develope a Win32 Windows service which can be installed many times (with different Name).
The idea is to have 1 exe and 1 registry key with 1 subkey for every service to be installed.
I use the exe to install/run many service, every service take his parameter from his registry subkey.

Does anyone have a sample code?

Answer 1

We’ve done this by creating a TService descendant and adding an ‘InstanceName’ property. This gets passed on the command line as something like … instance=”MyInstanceName” and gets checked for and set (if it exists) before SvcMgr.Application.Run.

eg
Project1.dpr:

program Project1;

uses
  SvcMgr,
  SysUtils,
  Unit1 in 'Unit1.pas' {Service1: TService};

{$R *.RES}

const
  INSTANCE_SWITCH = '-instance=';

function GetInstanceName: string;
var
  index: integer;
begin
  result := '';
  for index := 1 to ParamCount do
  begin
    if SameText(INSTANCE_SWITCH, Copy(ParamStr(index), 1, Length(INSTANCE_SWITCH))) then
    begin
      result := Copy(ParamStr(index), Length(INSTANCE_SWITCH) + 1, MaxInt);
      break;
    end;
  end;
  if (result <> '') and (result[1] = '"') then
    result := AnsiDequotedStr(result, '"');
end;

var
  inst: string;

begin
  Application.Initialize;
  Application.CreateForm(TService1, Service1);
  // Get the instance name
  inst := GetInstanceName;
  if (inst <> '') then
  begin
    Service1.InstanceName := inst;
  end;
  Application.Run;
end.

Unit1 (a TService descendant)

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, SvcMgr, WinSvc;

type
  TService1 = class(TService)
    procedure ServiceAfterInstall(Sender: TService);
  private
    FInstanceName: string;
    procedure SetInstanceName(const Value: string);
    procedure ChangeServiceConfiguration;
  public
    function GetServiceController: TServiceController; override;
    property InstanceName: string read FInstanceName write SetInstanceName;
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

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

procedure TService1.ChangeServiceConfiguration;
var
  mngr: Cardinal;
  svc: Cardinal;
  newpath: string;
begin
  // Open the service manager
  mngr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if (mngr = 0) then
    RaiseLastOSError;
  try
    // Open the service
    svc := OpenService(mngr, PChar(Self.Name), SERVICE_CHANGE_CONFIG);
    if (svc = 0) then
      RaiseLastOSError;
    try
      // Change the service params
      newpath := ParamStr(0) + ' ' + Format('-instance="%s"', [FInstanceName]); // + any other cmd line params you fancy
      ChangeServiceConfig(svc, SERVICE_NO_CHANGE, //  dwServiceType
                               SERVICE_NO_CHANGE, //  dwStartType
                               SERVICE_NO_CHANGE, //  dwErrorControl
                               PChar(newpath),    //  <-- The only one we need to set/change
                               nil,               //  lpLoadOrderGroup
                               nil,               //  lpdwTagId
                               nil,               //  lpDependencies
                               nil,               //  lpServiceStartName
                               nil,               //  lpPassword
                               nil);              //  lpDisplayName
    finally
      CloseServiceHandle(svc);
    end;
  finally
    CloseServiceHandle(mngr);
  end;
end;

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

procedure TService1.ServiceAfterInstall(Sender: TService);
begin
  if (FInstanceName <> '') then
  begin
    ChangeServiceConfiguration;
  end;
end;

procedure TService1.SetInstanceName(const Value: string);
begin
  if (FInstanceName <> Value) then
  begin
    FInstanceName := Value;
    if (FInstanceName <> '') then
    begin
      Self.Name := 'Service1_' + FInstanceName;
      Self.DisplayName := Format('Service1 (%s)', [FInstanceName]);
    end;
  end;
end;

end.

Usage:
Project1.exe /install
Project1.exe /install -instance=”MyInstanceName”
Project1.exe /uninstall [-instance=”MyInstanceName]
It doesn’t actually do anything – it’s up to you to write the start/stop server bits etc.

The ChangeServiceConfiguration call is used to update the real command line that the service manager calls when it starts up. You could just edit the registry instead but at least this is the ‘proper’ API way.

This allows any number of instances of the service to be run at the same time and they will appear in the service manager as ‘MyService’, ‘MyService (Inst1)’, ‘MyService (AnotherInstance)’ etc etc.