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:

	// Copyright (c) 2016, Jordi Corbilla
	// All rights reserved.
	//
	// Redistribution and use in source and binary forms, with or without
	// modification, are permitted provided that the following conditions are met:
	//
	// - Redistributions of source code must retain the above copyright notice,
	// this list of conditions and the following disclaimer.
	// - Redistributions in binary form must reproduce the above copyright notice,
	// this list of conditions and the following disclaimer in the documentation
	// and/or other materials provided with the distribution.
	// - Neither the name of this library nor the names of its contributors may be
	// used to endorse or promote products derived from this software without
	// specific prior written permission.
	//
	// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
	// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
	// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
	// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
	// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
	// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
	// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
	// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	// POSSIBILITY OF SUCH DAMAGE.
	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.

view raw uservice.pas hosted with ❤ by GitHub

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:

	// Copyright (c) 2016, Jordi Corbilla
	// All rights reserved.
	//
	// Redistribution and use in source and binary forms, with or without
	// modification, are permitted provided that the following conditions are met:
	//
	// - Redistributions of source code must retain the above copyright notice,
	// this list of conditions and the following disclaimer.
	// - Redistributions in binary form must reproduce the above copyright notice,
	// this list of conditions and the following disclaimer in the documentation
	// and/or other materials provided with the distribution.
	// - Neither the name of this library nor the names of its contributors may be
	// used to endorse or promote products derived from this software without
	// specific prior written permission.
	//
	// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
	// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
	// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
	// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
	// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
	// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
	// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
	// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	// POSSIBILITY OF SUCH DAMAGE.
	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.

view raw uServiceController.pas hosted with ❤ by GitHub

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.