Создание и управление несколькими Windows сервисами в Delphi для Win32: инструкция

Delphi , Синтаксис , Ошибки и Исключения

Создание и управление несколькими Windows сервисами в Delphi для Win32

Вопрос, поднятый в этом запросе, заключается в разработке Win32 Windows сервиса на Delphi, который можно установить несколько раз с разными именами. Идея состоит в том, чтобы иметь один исполняемый файл и один ключ реестра с подключами для каждого сервиса. Каждый сервис должен получать свои параметры из соответствующего подключа реестра.

Для решения этой задачи можно использовать класс TService, предоставляемый пакетом SvcMgr, однако стандартная реализация этого класса не позволяет установить несколько сервисов с одинаковым исполняемым файлом, но с разными именами. Это связано с тем, что функция DispatchServiceMain ожидает, что имя сервиса, переданное SCM, будет соответствовать имени сервиса, определенному в коде.

Чтобы обойти это ограничение, можно создать наследника TService и добавить в него свойство InstanceName, которое будет передаваться на командной строке при установке сервиса. Это свойство будет использоваться для изменения имени сервиса и его параметров командной строки в SCM.

Ниже представлен пример кода, который демонстрирует, как можно реализовать создание и управление несколькими сервисами:

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);
  // Получаем имя инстанса
  inst := GetInstanceName;
  if (inst <> '') then
  begin
    Service1.InstanceName := inst;
  end;
  Application.Run;
end.

В подразделе Unit1 (TService1 - наследник TService):

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}
...
// Остальная часть реализации класса TService1
...

В методе SetInstanceName происходит изменение имени сервиса и его параметров командной строки, если передано новое значение для InstanceName.

Функция ChangeServiceConfiguration используется для обновления параметров сервиса в SCM, включая параметры командной строки.

Данный подход позволяет запускать несколько инстансов сервиса одновременно, и они будут отображаться в менеджере сервисов с соответствующими именами.

Пример использования:

Project1.exe /install
Project1.exe /install -instance="MyInstanceName"
Project1.exe /uninstall [-instance="MyInstanceName"]

Этот метод является более надежным и предпочтительным по сравнению с хаком FixServiceNames, так как использует правильный API для управления сервисами.

Создано по материалам из источника по ссылке.

Создание и управление несколькими Windows сервисами в Delphi для Win32 с использованием одного исполняемого файла и ключа реестра, где каждый сервис получает свои параметры из реестра.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Ошибки и Исключения ::