Clever Geek Handbook

Multiple instances of the same service in Delphi

I have an old windows service made in delphi that now needs to be installed multiple times on the same server. I am trying to change the code so I can change the name of the service as I am installing the service, but I cannot get it to work.

I find some information here and here about this, and then study the posts and make the necessary changes. I can install two services with different names, however the services won't start.

I'm posting the class responsible for managing the service below (inherited by TService), I know this 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 needs to run in Windows Services.

Thank you in advance

+3


source to share


3 answers


It's pretty simple. You just need to provide a name for each service.

Now you have:

Name: = ParamStr (2);

DisplayName: = ParamStr (3);

and just need 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 directory name (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 removes the last slash; StrLastPos searches for the last slash position

+3


source


Since the service does not know what name it received during installation, you can specify this name as a parameter in the 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"

Removing a service:

<path1>\MyService.Exe /uninstall /name "test1" 
<path2>\MyService.Exe /uninstall /name "test2"
+8


source


The solution as suggested by @whosrdaddy works for me.

However, eventviewer displays logged messages (MyService.LogMessage (...)) as undefined or is removed.

These messages display normally if the name and display name are the same as they were at design time. There are several predefined message types associated in exetubale as resources.

With Eventwiver, the user can attach any custom action when some predefined event occurs.

0


source






More articles:


All Articles