Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Написание сервисов Windows NT на WinAPI

01.01.2007

Источник: delphi.xonix.ru

Причиной написания этой статьи, как не странно, стала необходимость написания своего сервиса. Но в Borland'е решили немного "порадовать" нас, пользователей Delphi 6 Personal, не добавив возможности создания сервисов (в остальных версиях Delphi 5 и 6 эта возможность имеется в виде класса TService). Решив, что еще не все потеряно, взял на проверку компоненты из одноименного раздела этого сайта. Первый оказался с многочисленными багами, а до пробы второго я не дошел, взглянув на исходник - модуль Forms в Uses это не только окошки, но и более 300 килобайт "веса" программы. Бессмысленного увеличения размера не хотелось и пришлось творить свое.

Так как сервис из воздуха не сотворишь, то мой исходник и эта статья очень сильно опираются на MSDN.

Итак, приступим к написанию своего сервиса...

Обычный Win32-сервис это обычная программа. Программу рекомендуется сделать консольной (DELPHI MENU | Project | Options.. | Linker [X]Generate Console Application) и крайне рекомендуется сделать ее без форм !!! и удалить модуль Forms из Uses. Рекомендуется потому, что, во-первых, это окошко показывать не стоит потому, что оно позволит любому юзеру, прибив ваше окошко прибить и сервис и, во-вторых, конечно же, размер файла (19Kb против 350 ). Поэтому удаляем форму (DELPHI MENU | Project | Remove from project... ). Удалив все формы, перейдем на главный модуль проекта, в котором удаляем текст между begin и end и Forms из Uses и добавляем Windows и WinSvc. В результате должно получиться что-то вроде этого

program Project1;
 
uses
 
Windows,WinSvc;
 
{$R *.res}
 
begin
 
end.

На этом подготовительный этап закончен - начинаем писАть сервис.

Главная часть программы      

Как уже отмечалось - сервис это обычная программа. Программа в Pascal'е находится между begin и end. После запуска нашего сервиса (здесь и далее под запуском сервиса понимается именно запуск его из Менеджера сервисов, а не просто запуск exe'шника сервиса) менеджер сервисов ждет пока наш сервис вызовет функцию StartServiceCtrlDispatcher.Ждать он будет недолго - если в нашем exe'шнике несколько сервисов то секунд 30, если один - около секунды, поэтому помещаем вызов StartServiceCtrlDispatcher поближе к begin.

StartServiceCtrlDispatcher качестве аргумента требует _SERVICE_TABLE_ENTRYA, поэтому добавляем в var DispatchTable : array [0..кол-во сервисов] of _SERVICE_TABLE_ENTRYA; и заполняем этот массив (естественно перед вызовом StartServiceCtrlDispatcher).

Т.к. в нашем ехешнике будет 1 сервис, то заполняем его так :

 DispatchTable[0].lpServiceName:=ServiceName;
 
DispatchTable[0].lpServiceProc:=@ServiceProc;
 
 
DispatchTable[1].lpServiceName:=nil;
 
DispatchTable[1].lpServiceProc:=nil;

Советую завести константы ServiceName - имя сервиса и ServiceDisplayName - отображаемое имя.

ServiceProc - основная функция сервиса(о ней ниже), а в функцию мы передаем ее адрес.

В DispatchTable[кол-во сервисов] все равно nil - это показывает функции, что предыдущее поле было последним. У меня получилось так :

begin
 
DispatchTable[0].lpServiceName:=ServiceName;
 
DispatchTable[0].lpServiceProc:=@ServiceProc;
 
 
DispatchTable[1].lpServiceName:=nil;
 
DispatchTable[1].lpServiceProc:=nil;
 
 
if not StartServiceCtrlDispatcher(DispatchTable[0])
 
then LogError('StartServiceCtrlDispatcher Error');
end.

StartServiceCtrlDispatcher выполнится только после того, как все сервисы будут остановлены.

Функция LogError протоколирует ошибки - напишите ее сами.

Функция ServiceMain      

ServiceMain - основная функция сервиса. Если в ехешнике несколько сервисов, но для каждого сервиса пишется своя ServiceMain функция. Имя функции может быть любым! и передается в DispatchTable.lpServiceProc:=@ServiceMain (см.предыдущущий абзац). У меня она называется ServiceProc и описывается так:

procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;

argc кол-во аргументов и их массив argv передаются менеджером сервисов из настроек сервиса. НЕ ЗАБЫВАЙТЕ STDCALL!!! Такая забывчивость - частая причина ошибки в программе.

В ServiceMain требуется выполнить подготовку к запуску сервиса и зарегистрировать обработчик сообщений от менеджера сервисов (Handler). Опять после запуска ServiceMain и до запуска RegisterServiceCtrlHandler должно пройти минимум времени. Если сервису надо делать что-нибудь очень долго и обязательно до вызова RegisterServiceCtrlHandler, то надо посылать сообщение SERVICE_START_PENDING функией SetServiceStatus.

Итак, в RegisterServiceCtrlHandler передаем название нашего сервиса и адрес функции Handler'а (см.далее). Далее выполняем подготовку к запуску и настройку сервиса. Остановимся на настройке поподробнее.

Эта самая настройка var ServiceStatus : SERVICE_STATUS;

(ServiceStatusHandle : SERVICE_STATUS_HANDLE и ServiceStatus надо сделать глобальными переменными и поместить их выше всех функций).

dwServiceType - тип сервиса

SERVICE_WIN32_OWN_PROCESS

Одиночный сервис

SERVICE_WIN32_SHARE_PROCESS

Несколько сервисов в одном процессе

SERVICE_INTERACTIVE_PROCESS

интерактивный сервис (может взаимодействовать с пользователем).

 

Остальные константы - о драйверах. Если надо - смотрите их в MSDN.

dwControlsAccepted - принимаемые сообщения (какие сообщения мы будем обрабатывать)               SERVICE_ACCEPT_PAUSE_CONTINUE        приостановка/перезапуск       SERVICE_ACCEPT_STOP        остановка сервиса       SERVICE_ACCEPT_SHUTDOWN        перезагрузка компьютера       SERVICE_ACCEPT_PARAMCHANGE        изменение параметров сервиса без перезапуска (Win2000 и выше)      

Остальные сообщения смотрите опять же в MSDN (куда уж без него ;-)

dwWin32ExitCode и dwServiceSpecificExitCode - коды ошибок сервиса. Если все идет нормально, то они должны быть равны нулю, иначе коду ошибки.

dwCheckPoint - если сервис выполняет какое-нибудь долгое действие при остановке, запуске и т.д. то dwCheckPoint является индикатором прогресса (увеличивайте его, чтобы дать понять, что сервис не завис), иначе он должен быть равен нулю.

dwWaitHint - время, через которое сервис должен послать свой новый статус менеджеру сервисов при выполнении действия (запуска, остановки и т.д.). Если dwCurrentState и dwCheckPoint через это кол-во миллисекунд не изменится, то менеджер сервисов решит, что произошла ошибка.

dwCurrentState - см. где-то здесь Ставим его в SERVICE_RUNNING, если сервис запущен

После заполнения этой структуры посылаем наш новый статус функцией SetServiceStatus и мы работаем :).

После этого пишем код самого сервиса. Я вернусь к этому попозже.

Вот так выглядит моя ServiceMain :

procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;
var
 
Status : DWORD;
 
SpecificError : DWORD;
begin
 
ServiceStatus.dwServiceType      := SERVICE_WIN32;
 
ServiceStatus.dwCurrentState     := SERVICE_START_PENDING;
 
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
   
or SERVICE_ACCEPT_PAUSE_CONTINUE;
 
ServiceStatus.dwWin32ExitCode           := 0;
 
ServiceStatus.dwServiceSpecificExitCode := 0;
 
ServiceStatus.dwCheckPoint              := 0;
 
ServiceStatus.dwWaitHint                := 0;
 
 
ServiceStatusHandle :=
           
RegisterServiceCtrlHandler(ServiceName,@ServiceCtrlHandler);
 
if ServiceStatusHandle = 0 then WriteLn('RegisterServiceCtrlHandler Error');
 
 
Status :=ServiceInitialization(argc,argv,SpecificError);
 
if Status <> NO_ERROR
   
then begin
   
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
   
ServiceStatus.dwCheckPoint   := 0;
   
ServiceStatus.dwWaitHint     := 0;
   
ServiceStatus.dwWin32ExitCode:=Status;
   
ServiceStatus.dwServiceSpecificExitCode:=SpecificError;
 
   
SetServiceStatus (ServiceStatusHandle, ServiceStatus);
       
LogError('ServiceInitialization');
   
exit;
   
end;
 
   
ServiceStatus.dwCurrentState :=SERVICE_RUNNING;
   
ServiceStatus.dwCheckPoint   :=0;
   
ServiceStatus.dwWaitHint     :=0;
 
   
if not SetServiceStatus (ServiceStatusHandle,ServiceStatus)
   
then begin
     
Status:=GetLastError;
         
LogError('SetServiceStatus');
     
exit;
   
end;
 
// WORK HERE
 
//ЗДЕСЬ БУДЕТ ОСНОВНОЙ КОД ПРОГРАММЫ
end;
 
Функция Handler      

Функция Handler будет вызываться менеджером сервисов при передаче сообщений сервису. Опять же название функции - любое. Адрес функции передается с помощью функции RegisterServiceCtrlHandler (см. выше). Функция имеет один параметр типа DWORD (Cardinal) - сообщение сервису. Если в одном процессе несколько сервисов - для каждого из них должна быть своя функция.

procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;

Опять не забываем про stdcall.

Итак, функция получает код сообщения, который мы и проверяем. Начинаем вспоминать, что мы писали в ServiceStatus.dwControlsAccepted. У меня это SERVICE_ACCEPT_STOP и SERVICE_ACCEPT_PAUSE_CONTINUE, значит, мне надо проверять сообщения SERVICE_CONTROL_PAUSE, SERVICE_CONTROL_CONTINUE, SERVICE_CONTROL_STOP и выполнять соответствующие действия. Остальные сообщения:

ServiceStatus.dwControlsAccepted        Обрабатываемые сообщения       SERVICE_ACCEPT_PAUSE_CONTINUE        SERVICE_CONTROL_PAUSE и SERVICE_CONTROL_CONTINUE       SERVICE_ACCEPT_STOP        SERVICE_CONTROL_STOP       SERVICE_ACCEPT_SHUTDOWN        SERVICE_CONTROL_SHUTDOWN       SERVICE_ACCEPT_PARAMCHANGE        SERVICE_CONTROL_PARAMCHANGE      

Также надо обрабатывать SERVICE_CONTROL_INTERROGATE. Что это такое - непонятно, но обрабатывать надо :) Передаем новый статус сервиса менеджеру сервисов функцией SetServiceStatus.

Пример функции Handler:

procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
var
 
Status : Cardinal;
begin
 
case Opcode of
  SERVICE_CONTROL_PAUSE    
:
   
begin
   
ServiceStatus.dwCurrentState := SERVICE_PAUSED;
   
end;
  SERVICE_CONTROL_CONTINUE
:
   
begin
   
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
   
end;
  SERVICE_CONTROL_STOP    
:
   
begin
   
ServiceStatus.dwWin32ExitCode:=0;
   
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
   
ServiceStatus.dwCheckPoint   :=0;
   
ServiceStatus.dwWaitHint     :=0;
 
   
if not SetServiceStatus (ServiceStatusHandle,ServiceStatus)
     
then begin
     
Status:=GetLastError;
         
LogError('SetServiceStatus');
     
Exit;
     
end;
     
exit;
   
end;
 
  SERVICE_CONTROL_INTERROGATE
: ;
 
end;
 
 
if not SetServiceStatus (ServiceStatusHandle, ServiceStatus)
 
then begin
   
Status := GetLastError;
   
LogError('SetServiceStatus');
   
Exit;
 
end;
end;
Реализация главной функции программы      

В функции ServiceMain (см.там, где отмечено) пишем код сервиса. Так как сервис обычно постоянно находится в памяти компьютера, то скорее всего код будет находиться в цикле. Например в таком :

repeat
 
Что-нибудь делаем пока сервис не завершится.
until ServiceStatus.dwCurrentState = SERVICE_STOPPED;
Но это пройдет если сервис не обрабатывает сообщения приостановки/перезапуска, иначе сервис никак не прореагирует. Другой вариант :
repeat
 
if ServiceStatus.dwCurrentState <> SERVICE_PAUSED
 
then чего-то делаем
until ServiceStatus.dwCurrentState = SERVICE_STOPPED;
И третий, имхо, самый правильный вариант = использование потока :
Пишем функцию
function MainServiceThread(p:Pointer):DWORD;stdcall;
begin
 
что-то делаем
end;  
и в ServiceMain создаем поток
var
 
ThID : Cardinal;
 
hThread
:=CreateThread(nil,0,@MainServiceThread,nil,0,ThID);
и ждем его завершения
WaitForSingleObject(hThread,INFINITE);
закрывая после этого его дескриптор
CloseHandle(hThread);
При этом hThread делаем глобальной переменной.
Теперь при приостановке сервиса Handler) делаем так
  SERVICE_CONTROL_PAUSE    
:
   
begin
   
ServiceStatus.dwCurrentState := SERVICE_PAUSED;
   
SuspendThread(hThread); // приостанавливаем поток
   
end;
и при возобновлении работы сервиса
  SERVICE_CONTROL_CONTINUE
:
   
begin
   
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
   
ResumeThread(hThread); // возобновляем поток
   
end;

Взято из https://forum.sources.ru