Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Написание сервисов Windows NT на WinAPI

Автор: http://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;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.