Причиной написания этой статьи, как не странно, стала необходимость написания
своего сервиса. Но в 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;
|