Install multiple instances of the same Delphi application service

In this article you will find an example on How to install multiple instances of the same Delphi application service under Windows. This topic was raised a few years ago in StackOverflow and I have decided to give more details about how to use multiple instances of the same service.

The service needs to be unique in name and the best way to sort this out is using a parameter to describe the service in a unique way. The service itself will use this parameter to compose its name even though it is using the same  executable. In this example I will identify the services when installing the service using the command line with the following instruction: "myService /install Param1". Param1 will be used to compose the internal service name as myServiceParam1. If we want to use another instance, just install a second service with a different param name as: myService /install Param2.

To achieve this is pretty simple, just create the service using your Delphi XE and then create the methods ServiceBeforeUninstall and ServiceCreate:

unit uService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, WinSvc;

type
  TServiceExample = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceBeforeUninstall(Sender: TService);
  private
    FDescription: String;
    FPreviousName: String;
    FPreviusDisplayName: string;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  ServiceExample: TServiceExample;

implementation

uses
  ComObj;

{$R *.DFM}

procedure ServiceController(CtrlCode: DWORD); stdcall;
begin
  ServiceExample.Controller(CtrlCode);
end;

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

procedure TServiceExample.ServiceBeforeUninstall(Sender: TService);
begin
  Name := FPreviousName + FDescription;
  DisplayName := FPreviusDisplayName + FDescription;
end;

procedure TServiceExample.ServiceCreate(Sender: TObject);
begin
  FDescription := System.ParamStr(2);
  FPreviousName := Name;
  FPreviusDisplayName := DisplayName;
  Name := Name + FDescription;
  DisplayName := DisplayName + FDescription;
end;

end.

Notice the System.ParamStr(2) that will use the second parameter which was input from the command line. The first parameter is the /install command needed to install the service.

After the execution of the following commands:

myService /install Param1
myService /install Param2

You will see two installed services using the same executable:

To uninstall them, use the opposite command:


myService /uninstall Param1

myService /uninstall Param2

But this is not ending here. Now the services are installed, but neither the service name is set nor the description. To achieve this, we need to use the ChangeServiceConfig functions from WinSvc - Service Control Manager unit.

Have a look at the complete source code:

unit uService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, WinSvc;

type
  TServiceExample = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceBeforeUninstall(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
  private
    FDescription: String;
    FPreviousName: String;
    FPreviusDisplayName: string;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

type
  SERVICE_DESCRIPTION = packed record
    lpDescription: PChar;
  end;

  PSERVICE_DESCRIPTION = ^SERVICE_DESCRIPTION;

var
  ServiceExample: TServiceExample;

const
  SERVICE_CONFIG_DESCRIPTION = 1;

function ChangeServiceConfig2(hService: SC_HANDLE; dwInfoLevel: DWORD; lpInfo: Pointer): BOOL; stdcall; external 'advapi32.dll' name 'ChangeServiceConfig2W';

implementation

uses
  ComObj;
{$R *.DFM}

procedure ServiceController(CtrlCode: DWORD); stdcall;
begin
  ServiceExample.Controller(CtrlCode);
end;

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

procedure TServiceExample.ServiceAfterInstall(Sender: TService);
var
  SvcMgr, Svc: SC_HANDLE;
  desc: SERVICE_DESCRIPTION;
begin
  SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgr = 0 then
    Exit;
  try
    Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS);
    if Svc = 0 then
      RaiseLastOSError;
    try
      desc.lpDescription := PWideChar(ParamStr(0) + ' ' + FDescription);
      ChangeServiceConfig( Svc, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE,SERVICE_NO_CHANGE, desc.lpDescription, nil, nil, nil, nil, nil, nil);
      desc.lpDescription := PWideChar('Service Example with Params = ' + FDescription);
      ChangeServiceConfig2(Svc, SERVICE_CONFIG_DESCRIPTION, @desc.lpDescription);
    finally
      CloseServiceHandle(Svc);
    end;
  finally
    CloseServiceHandle(SvcMgr);
  end;
end;

procedure TServiceExample.ServiceBeforeUninstall(Sender: TService);
begin
  Name := FPreviousName + FDescription;
  DisplayName := FPreviusDisplayName + FDescription;
end;

procedure TServiceExample.ServiceCreate(Sender: TObject);
begin
  FDescription := System.ParamStr(2);
  FPreviousName := Name;
  FPreviusDisplayName := DisplayName;
  Name := Name + FDescription;
  DisplayName := DisplayName + FDescription;
end;

end.

This solution is using the example provided by koochangmin on his Delphi blog. If you have a closer look at the ServiceAfterInstall method, you will find the composition of the name and description which will be used to populate the values in the service:

That is the way the service needs to be created in order to let the application use the parameters in runtime.

If you have any problem uninstalling the services, just use the SC command to delete the service:

sc delete ServiceExampleParam1

Related links:

• Windows Service Managing Unit.
• ChangeServiceConfig2 function.
• Another Windows Service: A supplementary note.
• How to delete a service.