Multiple instances of the same service in Delphi - delphi

Question

I have have an old windows service made in delphi that now has to be installed multiple times in the same server, I am trying to change the code so I am able to change the service name as I am instaling the service but I cannot make it work.
I find some information here and some here about it, and after study the posts and make the necessary modifications I am able to install two services with different names, however the services does not start.
I post the class responsible to control the service below (inherited TService), I know is quite a bit of code but I would really appreciate any help.
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
tvdAvalancheDataCenterService.Controller(CtrlCode);
end;
function TtvdAvalancheDataCenterService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TtvdAvalancheDataCenterService.ServiceLoadInfo(Sender : TObject);
begin
Name := ParamStr(2);
DisplayName := ParamStr(3);
end;
procedure TtvdAvalancheDataCenterService.ServiceBeforeInstall(Sender: TService);
begin
ServiceLoadInfo(Self);
end;
procedure TtvdAvalancheDataCenterService.ServiceCreate(Sender: TObject);
begin
ServiceLoadInfo(Self);
end;
procedure TtvdAvalancheDataCenterService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
FtvdTrayIcon := TtvdEnvoyTrayIcon.Create(Self);
SetServiceDescription;
FtvdDataCenter.tvdActive := true;
end;
procedure TtvdAvalancheDataCenterService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
FreeAndNil(FtvdTrayIcon);
FtvdDataCenter.tvdActive := False;
end;
procedure TtvdAvalancheDataCenterService.ServiceAfterInstall(Sender: TService);
begin
SetServiceDescription;
end;
procedure TtvdAvalancheDataCenterService.SetServiceDescription;
var
aReg: TRegistry;
begin
if FDescriptionUpdated then
Exit;
aReg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
aReg.RootKey := HKEY_LOCAL_MACHINE;
if aReg.OpenKey(cnRegKey+ Name, true) then
begin
aReg.WriteString('Description', cnServiceDescription);
aReg.CloseKey;
end;
FDescriptionUpdated:= True;
finally
aReg.Free;
end;
end;
I am using Delphi XE and the service need to run in windows services.
Thanks in advance

Answer 1

Since the service does not know what name it has received on installation, you can supply that name as a parameter into it's ImagePath registry value.
here's a basic service skeleton for multiple instances:
unit u_svc_main;
interface
uses
Winapi.Windows,
System.Win.Registry,
System.SysUtils,
System.Classes,
Vcl.Dialogs,
Vcl.SvcMgr;
type
TSvc_test = class(TService)
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceBeforeInstall(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceBeforeUninstall(Sender: TService);
private
{ Private declarations }
procedure GetServiceName;
procedure GetServiceDisplayName;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Svc_test: TSvc_test;
implementation
{$R *.dfm}
procedure TSvc_test.GetServiceDisplayName;
var
ServiceDisplayName : String;
begin
if not FindCmdLineSwitch('display', ServiceDisplayName) then
raise Exception.Create('Please specify the service displayname with /display switch');
DisplayName := ServiceDisplayName;
end;
procedure TSvc_test.GetServiceName;
var
ServiceName : String;
begin
if not FindCmdLineSwitch('name', ServiceName) then
raise Exception.Create('Please specify the service name with /name switch');
Name := ServiceName;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Svc_test.Controller(CtrlCode);
end;
function TSvc_test.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TSvc_test.ServiceAfterInstall(Sender: TService);
var
Reg : TRegistry;
ImagePath : String;
begin
Reg := TRegistry.Create(KEY_READ OR KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('SYSTEM\CurrentControlSet\Services\'+Name, False) then
begin
// set service description
Reg.WriteString('Description', 'Multi instance test for service '+Name);
// add name parameter to ImagePath value
ImagePath := ParamStr(0) + ' /name '+Name;
Reg.WriteString('ImagePath', ImagePath);
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TSvc_test.ServiceBeforeInstall(Sender: TService);
begin
GetServiceName;
GetServiceDisplayName;
end;
procedure TSvc_test.ServiceBeforeUninstall(Sender: TService);
begin
GetServiceName;
end;
procedure TSvc_test.ServiceCreate(Sender: TObject);
begin
if not Application.Installing then
GetServiceName;
end;
end.
Service installation:
<path1>\MyService.Exe /install /name "test1" /display "test instance1"
<path2>\MyService.Exe /install /name "test2" /display "test instance2"
Service removal:
<path1>\MyService.Exe /uninstall /name "test1"
<path2>\MyService.Exe /uninstall /name "test2"

Answer 2

It's fairly simple. You just have to set the name different for each service.
You now have:
Name := ParamStr(2);
DisplayName := ParamStr(3);
and just have to change it to:
Name := baseServiceName + '-' + GetLastDirName;
DisplayName := baseServiceDisplayName + ' (' + GetLastDirName + ')';
where baseServiceName is a constant with the name of the service; baseServiceDisplayName is a constant with the display name and GetLastDirName is a function that returns the name of a directory (last directory) from ExtractFilePath(ParamStr(0))
```
function GetLastDirName: string;
var
aux: string;
p: Integer;
begin
aux := strDelSlash(ExtractFilePath(ParamStr(0)));
p := StrLastPos('\', aux);
if p > 0 then
result := Copy(aux, p + 1, Length(aux))
else
result := aux;
end;
```
strDelSlash deletes the last slash; StrLastPos searches for the last position of the slash

Answer 3

The solution suggested by #whosrdaddy works for me.
However the eventviewer displays logged messages (MyService.LogMessage(...)) as undefined or uninstalled.
These messages displays fine if the name and the displayname are same as were at designtime.
There are few predefined message types, linked in exetubale, as resources.
With Eventwiver the user can attach any user defined action, when any of predefined events occur.