Delphi中同一程序拥有的多个NT服务

我正在寻找Delphi示例代码来开发可以多次安装（使用不同名称）的Win32 Windows服务。 其思想是为每个要安装的服务提供1个exe和1个注册表项以及1个子项。 我使用exe安装/运行许多服务，每个服务都从其注册表子项获取其参数

---

有人有示例代码吗？

在Delphi中如何实现服务存在一个问题，即使用不同的名称多次安装服务并不容易（请参阅Quality Central report）。您可能需要绕过TService/TService应用程序实现。 要使用不同的名称创建服务，您不能简单地使用/INSTALL命令行参数，但必须使用SCM API或其实现之一（即SC.EXE命令行实用程序）或安装工具。

---

要告诉服务要读取哪个键，您可以在其命令行上将参数传递给服务（它们也有），在创建服务时会设置参数。

在Delphi中如何实现服务存在一个问题，使用不同的名称多次安装服务并不容易（请参阅Quality Central report）。您可能需要绕过TService/TService应用程序实现。 要使用不同的名称创建服务，您不能简单地使用/INSTALL命令行参数，但必须使用SCM API或其实现之一（即SC.EXE命令行实用程序）或安装工具。

---

要告诉服务要读取哪个密钥，您可以在其命令行上将参数传递给服务（它们也有），将在创建服务时设置参数。

上下文：通过运行exename.exe/install as MyService安装的服务。服务作为MyService2第二次安装

Delphi不允许在一个可执行文件中使用不同的名称安装两次服务。见上文提及的QC 79781。不同的名称会导致服务在“启动”阶段“挂起”（至少根据SCM）。这是因为DispatchServiceMain根据SCM（启动服务时传入）检查TService实例名称和名称是否相等。当它们不同时，DispatchServiceMain不执行TService.Main，这意味着不执行TService的启动代码

要避免这种情况，请在应用程序之前调用FixServiceNames过程。运行调用

限制：备用名称必须以原始名称开头。IE如果原始名称是MyService，则可以安装MyService1、MyServiceAlternate、MyServiceBoneyHead等

FixServiceNames所做的是查找所有已安装的服务，检查ImagePath以查看该服务是否由该可执行文件实现，并在列表中收集这些服务。对已安装ServiceName上的列表进行排序。然后检查SvcMgr.Application.Components中的所有TService子代。当安装了以Component.Name（服务的原始名称）开头的ServiceName时，请将其替换为我们从SCM获得的名称

procedure FixServiceNames;
const
  RKEY_SERVICES = 'SYSTEM\CurrentControlSet\Services';
  RKEY_IMAGE_PATH = 'ImagePath';
  RKEY_START = 'Start';
var
  ExePathName: string;
  ServiceNames: TStringList;
  Reg: TRegistry;
  i: Integer;
  ServiceKey: string;
  ImagePath: string;
  StartType: Integer;
  Component: TComponent;
  SLIndex: Integer;
begin
  ExePathName := ParamStr(0);

  ServiceNames := TStringList.Create;
  try
    Reg := TRegistry.Create(KEY_READ);
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;

      // Openen registry key with all the installed services.
      if Reg.OpenKeyReadOnly(RKEY_SERVICES) then
      begin
        // Read them all installed services.
        Reg.GetKeyNames(ServiceNames);

        // Remove Services whose ImagePath does not match this executable.
        for i := ServiceNames.Count - 1 downto 0 do
        begin
          ServiceKey := '\' + RKEY_SERVICES + '\' + ServiceNames[i];
          if Reg.OpenKeyReadOnly(ServiceKey) then
          begin
            ImagePath := Reg.ReadString(RKEY_IMAGE_PATH);
            if SamePath(ImagePath, ExePathName) then
            begin
              // Only read 'Start' after 'ImagePath', the other way round often fails, because all 
              // services are read here and not all of them have a "start" key or it has a different datatype.
              StartType := Reg.ReadInteger(RKEY_START);
              if StartType <> SERVICE_DISABLED then
                Continue;
            end;

            ServiceNames.Delete(i);
          end;
        end;
      end;
    finally
      FreeAndNil(Reg);
    end;

    // ServiceNames now only contains enabled services using this executable.
    ServiceNames.Sort;  // Registry may give them sorted, but now we are sure.

    if ServiceNames.Count > 0 then
      for i := 0 to SvcMgr.Application.ComponentCount - 1 do
      begin
        Component := SvcMgr.Application.Components[i];
        if not ( Component is TService ) then
          Continue;

        // Find returns whether the string is found and reports through Index where it is (found) or 
        // where it should be (not found).
        if ServiceNames.Find(Component.Name, SLIndex) then
          // Component.Name found, nothing to do
        else
          // Component.Name not found, check whether ServiceName at SLIndex starts with Component.Name.
          // If it does, replace Component.Name.
          if SameText(Component.Name, Copy(ServiceNames[SLIndex], 1, Length(Component.Name))) then
          begin
            Component.Name := ServiceNames[SLIndex];
          end
          else
            ; // Service no longer in executable?
      end;
  finally
    FreeAndNil(ServiceNames);
  end;
end;

procedure-fixservicename；
常数
RKEY_服务='SYSTEM\CurrentControlSet\SERVICES'；
RKEY_图像_路径='ImagePath'；
RKEY_START=‘START’；
变量
ExePathName:字符串；
服务名称：TStringList；
注册：树木学；
i：整数；
ServiceKey：字符串；
ImagePath：字符串；
StartType：整数；
组件：TComponent；
SLIndex：整数；
开始
ExePathName:=ParamStr（0）；
ServiceNames:=TStringList.Create；
尝试
Reg:=TRegistry.Create（KEY\u READ）；
尝试
Reg.RootKey:=HKEY\U LOCAL\U机器；
//具有所有已安装服务的Openen注册表项。
如果注册OpenKeyReadOnly（RKEY_服务），则
开始
//阅读所有已安装的服务。
注册GetKeyNames（服务名称）；
//删除其ImagePath与此可执行文件不匹配的服务。
对于i:=ServiceNames.Count-1到0
开始
ServiceKey:='\'+RKEY\'+U服务+'\'+ServiceNames[i]；
如果注册OpenKeyReadOnly（ServiceKey），则
开始
ImagePath:=Reg.ReadString（RKEY\u图像\u路径）；
如果是SamePath（ImagePath，ExePathName），那么
开始
//仅在“ImagePath”之后读取“Start”，否则通常会失败，因为所有
//此处读取服务，但并非所有服务都具有“开始”键或具有不同的数据类型。
StartType:=Reg.ReadInteger（RKEY\u开始）；
如果StartType服务被禁用，则
持续
终止
服务名称。删除（i）；
终止
终止
终止
最后
自由零（Reg）；
终止
//ServiceNames现在只包含使用此可执行文件的已启用服务。
ServiceNames.Sort；//注册表可能会给他们排序，但现在我们可以肯定。
如果ServiceNames.Count>0，则
对于SvcMgr.Application.ComponentCount-1 do，i:=0
开始
组件：=SvcMgr.Application.Components[i]；
如果不是（组件是TService），则
持续
//Find返回是否找到字符串，并通过索引报告其所在位置（找到）或
//应该在哪里（找不到）。
如果是ServiceNames.Find（Component.Name，SLIndex），则
//找到组件名称，无需执行任何操作
其他的
//找不到Component.Name，请检查SLIndex中的ServiceName是否以Component.Name开头。
//如果是，请替换Component.Name。
如果SameText（Component.Name，Copy（ServiceNames[SLIndex]，1，Length（Component.Name）），则
开始
Component.Name:=ServiceNames[SLIndex]；
终止
其他的
; // 服务不再处于可执行状态？
终止
最后
FreeAndNil（服务名称）；
终止
终止

---

注：因此，pretty printer在“ServiceKey:='\'+RKEY\U SERVICES+'\'+ServiceNames[i]；”行中感到困惑，Delphi（2009）对此没有任何问题。

上下文：r安装的服务

program Project1;

uses
  SvcMgr,
  SysUtils,
  Unit1 in 'Unit1.pas' {Service1: TService};

{$R *.RES}

const
  INSTANCE_SWITCH = '-instance=';

function GetInstanceName: string;
var
  index: integer;
begin
  result := '';
  for index := 1 to ParamCount do
  begin
    if SameText(INSTANCE_SWITCH, Copy(ParamStr(index), 1, Length(INSTANCE_SWITCH))) then
    begin
      result := Copy(ParamStr(index), Length(INSTANCE_SWITCH) + 1, MaxInt);
      break;
    end;
  end;
  if (result <> '') and (result[1] = '"') then
    result := AnsiDequotedStr(result, '"');
end;

var
  inst: string;

begin
  Application.Initialize;
  Application.CreateForm(TService1, Service1);
  // Get the instance name
  inst := GetInstanceName;
  if (inst <> '') then
  begin
    Service1.InstanceName := inst;
  end;
  Application.Run;
end.

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, SvcMgr, WinSvc;

type
  TService1 = class(TService)
    procedure ServiceAfterInstall(Sender: TService);
  private
    FInstanceName: string;
    procedure SetInstanceName(const Value: string);
    procedure ChangeServiceConfiguration;
  public
    function GetServiceController: TServiceController; override;
    property InstanceName: string read FInstanceName write SetInstanceName;
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

procedure TService1.ChangeServiceConfiguration;
var
  mngr: Cardinal;
  svc: Cardinal;
  newpath: string;
begin
  // Open the service manager
  mngr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if (mngr = 0) then
    RaiseLastOSError;
  try
    // Open the service
    svc := OpenService(mngr, PChar(Self.Name), SERVICE_CHANGE_CONFIG);
    if (svc = 0) then
      RaiseLastOSError;
    try
      // Change the service params
      newpath := ParamStr(0) + ' ' + Format('-instance="%s"', [FInstanceName]); // + any other cmd line params you fancy
      ChangeServiceConfig(svc, SERVICE_NO_CHANGE, //  dwServiceType
                               SERVICE_NO_CHANGE, //  dwStartType
                               SERVICE_NO_CHANGE, //  dwErrorControl
                               PChar(newpath),    //  <-- The only one we need to set/change
                               nil,               //  lpLoadOrderGroup
                               nil,               //  lpdwTagId
                               nil,               //  lpDependencies
                               nil,               //  lpServiceStartName
                               nil,               //  lpPassword
                               nil);              //  lpDisplayName
    finally
      CloseServiceHandle(svc);
    end;
  finally
    CloseServiceHandle(mngr);
  end;
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceAfterInstall(Sender: TService);
begin
  if (FInstanceName <> '') then
  begin
    ChangeServiceConfiguration;
  end;
end;

procedure TService1.SetInstanceName(const Value: string);
begin
  if (FInstanceName <> Value) then
  begin
    FInstanceName := Value;
    if (FInstanceName <> '') then
    begin
      Self.Name := 'Service1_' + FInstanceName;
      Self.DisplayName := Format('Service1 (%s)', [FInstanceName]);
    end;
  end;
end;

end.