Полуфабрикат Windows-службы

от автора

Один из способов доморощенной классификации служб основывается на времени их жизни: некоторые из них запускаются сразу же при старте ОС, оставаясь активными постоянно (сюда, скажем, можно отнести веб-серверы и СУБД), другие же запускаются лишь при необходимости, делают свои архиважные дела и сразу завершаются; при этом, ни один из вариантов сам по себе не делает реализацию службы сложнее, однако второй требует от разработчика как минимум ещё и умения программно стартовать, а при необходимости и досрочно останавливать её работу. Именно указанный аспект управления службой, плюс добавление некоторых отсутствующих в штатной поставке Delphi возможностей, и сподвиг автора на данный опус.

Чтобы статья воспринималась максимально полезной и практичной, в ней предлагается заготовка (почти готовый к употреблению шаблон) службы, обрабатывающей очередь неких задач (или заданий – кому как больше нравится); после того, как все из них обработаны, служба тут же завершается. Если представить графически, то читатель познакомится со следующей конструкцией:

Взаимодействие службы с очередью и управляющим приложением

Техническое задание

Предложенное решение будет обладать перечисленными возможностями, а также предполагать следующее:

  • Очередь рассматривается как некая абстрактная структура, то есть кем она реализована, где хранится (в файле, БД или где-то ещё) и как конкретно с ней взаимодействовать (в виде программного кода) – всё это непринципиально и слабо пересекается с темой материала, однако предполагается, что задачи в ней обладают как минимум двумя свойствами:
    • Приоритетом, задающим порядок обработки.
    • Статусом, допускающим три значения:
      1. Ожидает обработки.
      2. Успешно обработана.
      3. Ошибка (не удалось обработать).
  • Служба:
    • Сразу после старта принимается за тяжкие труды и начинает, с учётом приоритета, извлекать из очереди задачи с первым статусом (который «ожидающий»), после чего, в зависимости от результата обработки, обновляет статус у каждой из них; работа прекращается после того, как в очереди не осталось необработанных элементов.
    • Если поступает команда на остановку, то обработка текущей задачи прерывается и служба завершается.
    • Во время работы может принять особую (нестандартную) команду от управляющего приложения (УП), суть которой описана чуть ниже.
    • Дабы не наделять службу чрезмерным набором прав, из-за которых может пострадать безопасность всей ОС, вместо обычно применяемого аккаунта LocalSystem станет использоваться специальный пользователь, создаваемый на лету.
    • При установке происходит автоматическое назначение минимально необходимых прав как пользователю самой службы (от имени которого она должна запускаться – о нём шла речь в предыдущем пункте), так и пользователю управляющего приложения.
  • Управляющее приложение:
    • Подаёт команды на запуск и остановку службы, т. е. примерно то, что вручную делается через Диспетчер служб:
      Кнопки управления службой в Диспетчере
    • Также, когда служба уже активна, может подать ей команду заново обработать «ошибочные» задачи (те, что с третьим статусом) – необходимость в этом обычно возникает после устранения внешних проблем, помешавших штатно справиться с такими задачами в прошлом.

Служба

В данном случае, веских причин изобретать велосипед для реализации службы не имеется, поэтому основа дальнейшего кода – это стандартный для IDE подход к созданию, основанный на классе TService. Также необходимо отметить, что автор использует не самую новую версию Delphi (10.1 Berlin), в связи с чем в иных выпусках могут иметься свои особенности (в более свежих, к примеру, часть предложенного функционала может быть уже реализована, однако подобное маловероятно, учитывая стойкое нежелание разработчиков Delphi развивать TService).

Описание кода службы логично вести в соответствии с циклом её жизни в системе – то есть начать с момента установки (регистрации).

Установка

Собственно самостоятельно реализовывать регистрацию и не требуется, т. к. запуск исполняемого файла службы с ключом /install сделает всё необходимое – программист от данной рутины избавлен. Намного интересней выглядит момент сразу после установки (чему соответствует событие AfterInstall), где и удобно приступить к воплощению части означенного в ТЗ; однако, хотелось бы начать с малого и показать на простом примере как происходит изменение параметра установленной службы – будет сделано то, чего уже так давно не добавляют в Delphi – реализована возможность указать описание, отображаемое, например, в Диспетчере:

Описание службы в Диспетчере

Основа обработчика указанного события, постепенно расширяемая далее, выглядит так:

interface  uses   System.SysUtils, Vcl.SvcMgr;  ...  implementation  uses   Winapi.WinSvc;  resourcestring   ServiceDescription = 'Шаблон (заготовка) службы, обрабатывающей очередь неких задач.';  procedure TQueueService.ServiceAfterInstall(Sender: TService); var   ManagerHandle, ServiceHandle: SC_HANDLE;   Description: SERVICE_DESCRIPTION; begin   ManagerHandle := OpenSCManager(nil, nil, 0);    if ManagerHandle = 0 then     RaiseLastOSError;    try     ServiceHandle := OpenService( ManagerHandle, PChar(Name), SERVICE_CHANGE_CONFIG );      if ServiceHandle = 0 then       RaiseLastOSError;      try       Description.lpDescription := PChar(ServiceDescription);       Win32Check( ChangeServiceConfig2(ServiceHandle, SERVICE_CONFIG_DESCRIPTION, @Description) );     finally       CloseServiceHandle(ServiceHandle);     end;   finally     CloseServiceHandle(ManagerHandle);   end; end;

Здесь, прежде всего, выполняется получение дескриптора Менеджера служб (Service Control Manager), после чего у него запрашивается дескриптор уже нашей (только что установленной) службы по её имени; доступ к обоим объектам выбран минимально необходимый – SC_MANAGER_CONNECT и SERVICE_CHANGE_CONFIG, причём SC_MANAGER_CONNECT не требуется указывать, т. к. он подразумевается неявно (именно поэтому последний параметр функции OpenSCManager равен нулю).

Пользователь

Далее, чтобы непосредственно перейти к реализации описанных в начале требований, определимся с пользователем, от имени которого служба станет выполняться: до Windows 7 и Windows Server 2008 R2, если требовалось максимально ограничить службу в правах, дав ей исключительно те, что действительно нужны, было необходимо самостоятельно создавать обычного пользователя ОС – а теперь же появился виртуальный пользователь (virtual account), все заботы по управлению которым берёт на себя Windows. Применительно к службе (если делать это вручную через Диспетчер), для создания такого пользователя нужно лишь при указании его имени добавить префикс NT Service\, а пароль оставить пустым:

Создание виртуального пользователя через свойства службы в Диспетчере

Казалось бы, чего проще – действуем аналогично в Инспекторе объектов Delphi и получаем тот же результат:

Создание виртуального пользователя через Инспектор объектов в Delphi

Но не тут-то было! В случае виртуального пользователя, WinAPI-функция CreateService, применяемая в модуле Vcl.SvcMgr для установки службы, в последнем параметре, содержащем пароль, должна получить значение nil, а не пустую строку,

как имеет место быть сейчас.

Svc := CreateService(SvcMgr, PChar(Name), PChar(DisplayName),   SERVICE_ALL_ACCESS, GetNTServiceType, GetNTStartType, GetNTErrorSeverity,   PChar(Path), PChar(LoadGroup), PTag, PChar(GetNTDependencies),   PSSN, PChar(Password));

Собственно подобное даже нельзя назвать ошибкой – скорее всего, разработчики Delphi просто-напросто не стали улучшать TService и добавлять распознавание префикса NT Service\ в имени, ведь до Windows 7 такой особенности элементарно не существовало. Поэтому, дабы не править стандартный модуль, ограничимся заданием пользователя уже после установки службы (т. е. предполагается, что свойства ServiceStartName и Password оставлены пустыми), для чего достаточно вызова лишь одной функции (часть ранее приводимого кода, ответственного за получение дескрипторов, опущена):

procedure TQueueService.ServiceAfterInstall(Sender: TService); const   VirtualAccountPrefix = 'NT Service\'; var   ManagerHandle, ServiceHandle: SC_HANDLE;   Description: SERVICE_DESCRIPTION;   VirtualAccount: string; begin   ...    Description.lpDescription := PChar(ServiceDescription);   Win32Check( ChangeServiceConfig2(ServiceHandle, SERVICE_CONFIG_DESCRIPTION, @Description) );    VirtualAccount := VirtualAccountPrefix + Name;   Win32Check     (     ChangeServiceConfig       (       ServiceHandle,       SERVICE_NO_CHANGE, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE,       nil, nil, nil, nil,       PChar(VirtualAccount), nil,       nil       )     );    ... end;

Надо сказать, что имя виртуального пользователя, указываемое после префикса, совсем не обязательно должно совпадать с именем службы – главное обеспечить его уникальность.

Права

На следующем этапе необходимо позаботиться о правах двух пользователей:

  • Первым из них идёт вышеупомянутый виртуальный, проблема с которым такова: если попробовать запустить службу в текущем виде, то система сообщит об отказе в доступе, ибо только что созданный аккаунт не имеет прав на запуск исполняемого файла службы (их у него вообще кот наплакал – за это и выбран). Другими словами, требуется добавить вот такую запись:
    Права на исполняемый файл службы
  • Вторым пользователем является тот, от имени которого запускается управляющее приложение, – дело в том, что любая команда (запуск, приостановка и т. п.) проверяется на наличие соответствующих прав у её инициатора, пока их, увы, не имеющего. Хотя в общем случае про УП служба может ничего не знать (оно, скажем, создаётся другим программистом на ином ЯП), но ситуация в статье иная и позволяет возложить на службу и данное бремя, а чтобы она знала какому пользователю выдать такие права, добавим новый ключ запуска /ControlUser, где после двоеточия необходимо указать имя; если привести конкретный пример, то теперь установку службы следует производить с такими ключами – /install /ControlUser:SomeUser1.

Доработки события под описанное выглядят следующим образом:

interface  uses   System.SysUtils, Winapi.Windows, Vcl.SvcMgr;  ...  implementation  uses   Winapi.WinSvc, Winapi.AccCtrl, Winapi.AclAPI;  procedure TQueueService.ServiceAfterInstall(Sender: TService);    procedure GrantAccess(const UserName, ObjectName: string; const ObjectType: SE_OBJECT_TYPE; const Rights: ACCESS_MASK);   begin     // Реализация процедуры приведена чуть ниже в статье.     ...   end;  const   VirtualAccountPrefix = 'NT Service\';   ControlUserSwitch = 'ControlUser'; var   ManagerHandle, ServiceHandle: SC_HANDLE;   Description: SERVICE_DESCRIPTION;   VirtualAccount, ControlUserName: string; begin   ...    Description.lpDescription := PChar(ServiceDescription);   Win32Check( ChangeServiceConfig2(ServiceHandle, SERVICE_CONFIG_DESCRIPTION, @Description) );    VirtualAccount := VirtualAccountPrefix + Name;   Win32Check     (     ChangeServiceConfig       (       ServiceHandle,       SERVICE_NO_CHANGE, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE,       nil, nil, nil, nil,       PChar(VirtualAccount), nil,       nil       )     );   GrantAccess( VirtualAccount, ParamStr(0), SE_FILE_OBJECT, GENERIC_READ or GENERIC_EXECUTE );    if FindCmdLineSwitch(ControlUserSwitch, ControlUserName) then     GrantAccess(ControlUserName, Name, SE_SERVICE, SERVICE_START or SERVICE_STOP or SERVICE_USER_DEFINED_CONTROL);    ... end;

Константа SERVICE_USER_DEFINED_CONTROL у пользователя УП отвечает за право на передачу нестандартной команды, указанной в требованиях. Реализация же GrantAccess основана на C++-примере из документации Microsoft:

procedure GrantAccess(const UserName, ObjectName: string; const ObjectType: SE_OBJECT_TYPE; const Rights: ACCESS_MASK); var   SecurityDescriptor: PSECURITY_DESCRIPTOR;   OldDACL, NewDACL: PACL;   UserAccess: EXPLICIT_ACCESS; begin   CheckOSError     (     GetNamedSecurityInfo       (       PChar(ObjectName),       ObjectType,       DACL_SECURITY_INFORMATION,       nil,       nil,       @OldDACL,       nil,       SecurityDescriptor       )     );   try     BuildExplicitAccessWithName( @UserAccess, PChar(UserName), Rights, SET_ACCESS, NO_INHERITANCE );     CheckOSError( SetEntriesInAcl(1, @UserAccess, OldDACL, NewDACL) );     try       CheckOSError         (         SetNamedSecurityInfo           (           PChar(ObjectName),           ObjectType,           DACL_SECURITY_INFORMATION,           nil,           nil,           NewDACL,           nil           )         );     finally       LocalFree( HLOCAL(NewDACL) );     end;   finally     LocalFree( HLOCAL(SecurityDescriptor) );   end; end;

Завершая изыскания с AfterInstall, необходимо отметить, что любое исключение в этом событии приведёт к удалению только что установленной службы (с записью текста исключения в журнал Windows), а в приведённом коде его может сгенерировать, к примеру, функция Win32Check.

В заключение подраздела также хочется остановиться на моменте, связанном с правами, назначенными выше пользователю УП: если, предположим в целях отладки, их необходимо поменять, то совершенно не обязательно для этого удалять и заново устанавливать службу – достаточно воспользоваться всем известной утилитой Process Explorer: когда служба запущена, следует открыть её свойства и перейти на вкладку Services, после чего пройтись по показанным шагам:

Права на службу

Обработка очереди

Как известно, Delphi предлагает два подхода к реализации службы (подробнее о них можно узнать в материале на другом ресурсе в разделе «3. События службы»):

  1. На основе событий OnStart и OnStop, что подразумевает самостоятельное создание потоков, содержащих нужный функционал.
  2. На основе события OnExecute, обработчик которого выполняется в заранее заботливо созданном TService потоке, причём служба сразу же остановится после выхода из события; именно данный вариант хорошо подходит под поставленную в статье цель – как только в очереди обработаны все задачи, делать больше нечего и необходимо завершиться.

Основа события

В первом приближении код OnExecute прост и незатейлив – идёт извлечение задач до тех пор, пока они имеются в очереди:

procedure TQueueService.ServiceExecute(Sender: TService); type   TTask = ...; // Конкретный тип зависит от деталей Вашей реализации.   TTaskList = array of TTask; // Массив использован лишь для иллюстрации, допустимы любые другие структуры данных (TList<TTask>, например).    function ExtractTaskPortion(out Tasks: TTaskList): Boolean;   begin     // Функция вернёт True в случае, если в очереди ещё есть задачи для обработки (при этом     // содержаться они будут в параметре Tasks).     ...      Result := Length(Tasks) > 0;   end;    procedure ProcessTask(const Task: TTask);   begin     // После обработки задачи, процедура должна обновить её статус (на 2-й или 3-й).     ...   end;  var   Task: TTask;   Tasks: TTaskList; begin   while ExtractTaskPortion(Tasks) do     for Task in Tasks do       ProcessTask(Task); end;

Стоит пояснить, что задачи берутся не по одиночке, а именно порциями исходя из соображения, что в реальном мире обычно затраты на получение сразу нескольких элементов из хранилища значительно ниже, чем их выборка по одному (именно так, скажем, обстоит дело с базами данных).

Прерывание обработки

Несложно заметить, что в текущем виде не предусмотрено никакого механизма по прекращению цикла извлечения задач, а ведь причин такого прерывания, согласно ТЗ, может быть две:

  1. Команда на остановку службы, после которой никакого ожидания обработки текущей задачи быть не должно – она прерывается как можно быстрее, после чего все оставшиеся в порции задачи тоже отбрасываются и служба завершается.
  2. Команда на повторную обработку задач с третьим статусом, для чего необходимо прервать работу по текущей (как и в случае команды на остановку), обновить статус всех означенных задач на первый, запросить новую порцию и далее действовать как обычно; надобность прерывать обработку текущей порции связана с тем, что среди задач с только что установленным первым статусом могут иметься обладающие бо́льшим приоритетом.

В качестве решения данной проблемы предлагается воспользоваться исключениями – они в этом случае выступят в полном соответствии со своим названием, то есть будут сигнализировать не об ошибке, а именно об исключительной, прерывающей нормальное течение алгоритма ситуации (в нашем случае таковой являются команды от Менеджера служб и УП). Для этого сначала объявим новый класс исключения, содержащий поле с причиной прерывания:

...  implementation  ...  type   EInterruption = class(Exception)   public     type       TReason = (irStop, irErrorsReset);   public     Reason: TReason;     constructor Create(const Reason: TReason);   end;  constructor EInterruption.Create(const Reason: TReason); begin   inherited Create(string.Empty);   Self.Reason := Reason; end;  ...

Это исключение станет генерироваться в новой локальной процедуре CheckInterruption (как – об этом чуть позже), а реакция на него имеет следующий вид:

procedure TQueueService.ServiceExecute(Sender: TService); type   TTask = ...;   TTaskList = array of TTask;    function ExtractTaskPortion(out Tasks: TTaskList): Boolean;   begin     ...   end;    procedure CheckInterruption;   begin     // Отвечает за возбуждение исключения EInterruption.     ...   end;    procedure ProcessTask(const Task: TTask);   begin     ...   end;    procedure ResetQueueErrors;   begin     // Меняет 3-й статус на первый у всех задач в очереди.     ...   end;  var   Task: TTask;   Tasks: TTaskList; begin   while ExtractTaskPortion(Tasks) do     try       for Task in Tasks do         ProcessTask(Task);     except       on E: EInterruption do         case E.Reason of           irStop: Break;           irErrorsReset: ResetQueueErrors;           else raise;         end;     end; end;

От разработчика требуется лишь вставлять вызов CheckInterruption периодически, через небольшие этапы обработки задачи в ProcessTask, навроде такого:

procedure ProcessTask(const Task: TTask); begin   // Некие действия (например инициализация обработки).   CheckInterruption;   ...    // Ещё какой-то этап.   CheckInterruption;   ...    // Некий этап-цикл.   for ... to ... do   begin     CheckInterruption;     ...   end;    // Обновление статуса задачи.   CheckInterruption;   ... end;

Взаимодействие с Менеджером служб

В рассматриваемом событии осталось реализовать ещё три вещи, две из которых удобно объединить в одной CheckInterruption – во-первых, требуется наконец уже реальная генерация исключения, а во-вторых, служба обязана периодически извещать Менеджер о своём статусе, а также получать пришедшие от него же сообщения и реагировать на них. Если сообщение об остановке службы TService в основном обрабатывает сам, то вот специальная команда от УП требует дополнительного кодирования, заключающегося, прежде всего, в переопределении виртуального метода DoCustomControl – в нашем случае там достаточно всего лишь сохранять переданный службе целочисленный код команды в заведённом для этой цели поле FCustomCode:

interface  ...  type   TQueueService = class(TService)     procedure ServiceAfterInstall(Sender: TService);     procedure ServiceExecute(Sender: TService);   private     FCustomCode: DWORD;   protected     function DoCustomControl(CtrlCode: DWord): Boolean; override;   ...   end;  ...  implementation  ...  function TQueueService.DoCustomControl(CtrlCode: DWord): Boolean; begin   Result := inherited;   FCustomCode := CtrlCode; end;

Теперь можно полностью реализовать процедуру:

procedure CheckInterruption; begin   ReportStatus;   FCustomCode := 0;   ServiceThread.ProcessRequests(False); // Внутри вызывается DoCustomControl.    if Terminated then     raise EInterruption.Create(irStop);    case FCustomCode of     RESET_QUEUE_ERRORS_CONTROL_CODE: raise EInterruption.Create(irErrorsReset);   end; end;

Здесь методы ReportStatus и ProcessRequests отвечают за взаимодействие с Менеджером, а константа RESET_QUEUE_ERRORS_CONTROL_CODE (её допустимые значения см. в описании параметра dwControl) объявлена в новом модуле Services.Queue.Constants:

unit Services.Queue.Constants;  interface  const   RESET_QUEUE_ERRORS_CONTROL_CODE = 128;  implementation  end.

Полезность добавления модуля проистекает из того факта, что управляющее приложение в нашем случае тоже написано на Delphi и при отправке специальной команды эта константа в нём тоже потребуется:

Зависимости от модуля Services.Queue.Constants

Кстати, если читатель задаётся вопросом о целесообразности добавления поля FCustomCode, когда, казалось бы, можно сгенерировать исключение прямо в методе DoCustomControl,

скажем так,

function TQueueService.DoCustomControl(CtrlCode: DWord): Boolean; begin   Result := inherited;    case CtrlCode of     RESET_QUEUE_ERRORS_CONTROL_CODE: raise EInterruption.Create(irErrorsReset);   end; end;

то ответ довольно прост – в модуле Vcl.SvcMgr вызов DoCustomControl окружён конструкцией try...except, перехватывающей любые исключения без разбора (а вся обработка сводится к добавлению записей с их текстом в Windows-лог).

Окончательный вариант

В качестве последнего штриха к реализации службы, необходимо разобраться хоть и с небольшой (в плане устранения), но всё же загвоздкой, а именно: в текущем виде, если в очереди все задачи обработаны, но некоторые из них имеют третий статус (завершились ошибкой), то заново такие взять в работу не получится – служба после старта станет сразу завершаться, а, соответственно, и не сможет никогда принять команду от УП на повторную обработку ошибок. К счастью, при запуске службы можно передать ей произвольное количество текстовых параметров, хотя в данном случае достаточно одного параметра-флага – факт его наличия будет говорить о том, что ещё перед циклом по очереди требуется вызвать уже применявшуюся процедуру ResetQueueErrors:

procedure TQueueService.ServiceExecute(Sender: TService);    ...    procedure ResetQueueErrors;   begin     // Меняет 3-й статус на первый у всех задач в очереди.     ...   end;  var   I: Integer;   Task: TTask;   Tasks: TTaskList; begin   for I := 0 to ParamCount - 1 do     if Param[I] = ResetQueueErrorsParam then     begin       ResetQueueErrors;       Break;     end;    while ExtractTaskPortion(Tasks) do     try       for Task in Tasks do         ProcessTask(Task);     except       on E: EInterruption do         case E.Reason of           irStop: Break;           irErrorsReset: ResetQueueErrors;           else raise;         end;     end; end;

Важно понимать, что эти параметры не имеют ничего общего с ключами, использующимися при установке и удалении, – те применяются при самостоятельном запуске исполняемого файла службы, а свойство Param содержит то, что было передано специальной WinAPI-функции, предназначенной для старта служб (она будет упомянута в следующем разделе). Что касается константы ResetQueueErrorsParam, то она объявлена в модуле Services.Queue.Constants:

unit Services.Queue.Constants;  interface  const   RESET_QUEUE_ERRORS_CONTROL_CODE = 128;    ResetQueueErrorsParam = 'ResetErrors';  implementation  end.

Управляющее приложение

В целях сосредоточения на главном, и дабы не отвлекаться на второстепенные нюансы, УП представляет собой обычный VCL-проект из одной простейшей формы, состоящей из 4-х кнопок; вместе с тем, весь приводимый код использует только WinAPI, поэтому применять его можно где угодно – хоть в другой службе, хоть вообще поместить в DLL.

Окно управляющего приложения

Кнопки отвечают за уже знакомые действия:

  1. Запуск без изысков (как будто через Диспетчер служб).
  2. Аналогично первой кнопке, но с параметром, отвечающим за предварительный сброс у задач третьего статуса.
  3. Передача службе специальной команды (см. константу RESET_QUEUE_ERRORS_CONTROL_CODE).
  4. Остановка службы (как будто через Диспетчер служб).

Предварительные действия

В дальнейшем довольно часто будет требоваться дескриптор Менеджера служб, поэтому, чтобы не получать его каждый раз заново, сделаем это при создании формы; также сотворим полезный метод OpenService, избавляющий далее от дублирования кода и возвращающий дескриптор службы:

interface  uses   Winapi.Windows, System.SysUtils, ..., Winapi.WinSvc;  type   TForm1 = class(TForm)     ...     procedure FormCreate(Sender: TObject);     procedure FormDestroy(Sender: TObject);   private     FSCMHandle: SC_HANDLE;      function OpenService(const Access: DWORD): SC_HANDLE;   end;  ...  implementation  procedure TForm1.FormCreate(Sender: TObject); begin   FSCMHandle := OpenSCManager(nil, nil, 0);   if FSCMHandle = 0 then     RaiseLastOSError; end;  procedure TForm1.FormDestroy(Sender: TObject); begin   CloseServiceHandle(FSCMHandle); end;  function TForm1.OpenService(const Access: DWORD): SC_HANDLE; begin   Result := Winapi.WinSvc.OpenService( FSCMHandle, PChar('QueueService'), Access );   if Result = 0 then     RaiseLastOSError; end;

Основной код

Запуск службы – без параметров и с ними – отличается незначительно (и там и там применяется одна и та же WinAPI-функция), поэтому видится разумным создать у формы метод, который затем и вызывать при нажатии на первые две кнопки:

interface  ...  type   TForm1 = class(TForm)     ...   private     ...     procedure RunService(const Parameters: array of string);   end;  ...  implementation  ...  procedure TForm1.RunService(const Parameters: array of string); var   ServiceHandle: SC_HANDLE;   Arguments: array of PChar;   I: Integer; begin   ServiceHandle := OpenService(SERVICE_START);   try     if Length(Parameters) = 0 then       Win32Check( StartService(ServiceHandle, 0, PPChar(nil)^) )     else     begin       SetLength( Arguments, Length(Parameters) );        for I := Low(Parameters) to High(Parameters) do         Arguments[I] := PChar(Parameters[I]);        Win32Check( StartService(ServiceHandle, Length(Arguments), Arguments[0]) );     end;   finally     CloseServiceHandle(ServiceHandle);   end; end;

Параметр-массив Parameters позволяет указать как раз тот набор параметров запуска службы, о которых шла речь выше. Итак, имея новый метод, очень легко закодировать обработчики у первой половины кнопок:

...  implementation  uses   Services.Queue.Constants;  ...  procedure TForm1.bStartClick(Sender: TObject); begin   RunService([]); end;  procedure TForm1.bStartAndResetErrorsClick(Sender: TObject); begin   RunService([ResetQueueErrorsParam]); end;

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

interface  ...  type   TForm1 = class(TForm)     ...   private     ...     procedure SendCommandToService(const Access, ControlCode: DWORD);   end;  ...  implementation  ...  procedure TForm1.SendCommandToService(const Access, ControlCode: DWORD); var   ServiceHandle: SC_HANDLE;   ServiceStatus: TServiceStatus; begin   ServiceHandle := OpenService(Access);   try     Win32Check( ControlService(ServiceHandle, ControlCode, ServiceStatus) );   finally     CloseServiceHandle(ServiceHandle);   end; end;

Здесь в переменной ServiceStatus возвращается последнее, самое свежее состояние службы, однако оно в данном контексте неинтересно, поэтому полученное значение просто игнорируется. Таким образом, 3-я и 4-я кнопки на нажатие реагируют так:

...  implementation  ...  procedure TForm1.bResetErrorsClick(Sender: TObject); begin   SendCommandToService(SERVICE_USER_DEFINED_CONTROL, RESET_QUEUE_ERRORS_CONTROL_CODE); end;  procedure TForm1.bStopClick(Sender: TObject); begin   SendCommandToService(SERVICE_STOP, SERVICE_CONTROL_STOP); end;

Последнее, о чём хочется сказать, касается нестандартных команд (рассмотренная служба реагирует только на одну – RESET_QUEUE_ERRORS_CONTROL_CODE): если они в Вашем случае являются более сложными, требующими для выполнения дополнительную информацию, а не просто факт получения службой одного числового кода, то для передачи таких сведений придётся задействовать механизмы межпроцессного обменаразделяемую память, неименованные каналы и т. п.


Весь показанный исходный код можно скачать здесь.


ссылка на оригинал статьи https://habr.com/ru/post/661697/


Комментарии

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *