德爾福相同服務的多個實例

Question

我有一箇舊的Windows服務在德爾福，現在必須在同一臺服務器上安裝多次，我試圖改變代碼，所以我能夠改變服務名稱因爲我正在安裝該服務，但我無法使其工作。

我找到了一些關於它的信息here和一些here，並且在研究了這些帖子並進行了必要的修改之後，我能夠安裝具有不同名稱的兩個服務，但是服務並未啓動。

我發佈負責控制下面的服務的類（繼承TService），我知道是相當多的代碼，但我真的很感激任何幫助。

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; 

我使用Delphi XE和服務需要運行在Windows服務。

在此先感謝

Answer 1

這很簡單。您只需爲每個服務設置不同的名稱。

你現在有：

名稱：= ParamStr這（2）;

DisplayName：= ParamStr（3）;

，只是有將其更改爲：

名稱：= baseServiceName + ' - ' + GetLastDirName;

DisplayName：= baseServiceDisplayName +'（'+ GetLastDirName +'）';

其中baseServiceName是一個常量與服務的名稱; baseServiceDisplayName是與顯示名稱和GetLastDirName一個常數，從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刪除最後一個斜槓; StrLastPos搜索斜槓的最後一個位置

Answer 2

由於服務並不知道它在安裝時收到了什麼名稱，因此可以將該名稱作爲參數提供給它的ImagePath註冊表值。

這裏有多個實例基本服務框架：

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. 

服務安裝：

<path1>\MyService.Exe /install /name "test1" /display "test instance1" 
<path2>\MyService.Exe /install /name "test2" /display "test instance2" 

服務去除：

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