Search code examples
delphiservicedelphi-xe

Multiple instances of the same service in Delphi


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


Solution

  • 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