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