Всем привет,

Как в Delphi можно создать свою службу? Я попробовал сделать с помощью TService, но почему-то ни одно событие не работает(кроме ServiceCreate).

http://forum.vingrad.ru/index.php?showtopic=9753

Цитата(_hunter @ 4.1.2006, 17:05)

http://forum.vingrad.ru/index.php?showtopic=9753

Я бы хотел понять почему моим способом не получается сделать?

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

Нарыл статью для написание сервисв под Nt, есть еще очень полезный примерчик!
Надо?

Цитата(ne0n @ 4.1.2006, 21:18)

Нарыл статью для написание сервисв под Nt, есть еще очень полезный примерчик! Надо?

Конечно, давай!

Сделал как в примере из хелпа в Delphi(Service applications) но сервис все равно через 15 секунд отрубается. Что я неправильно делаю?

что в логах видно?

Цитата(_hunter @ 5.1.2006, 14:08)

что в логах видно?

Что за логи?

те, что в Event Viewer' е пишуться...

Цитата(_hunter @ 5.1.2006, 14:42)

те, что в Event Viewer' е пишуться...

В том то и дело что ничего не пишет.

значит ошибок нет. и выходиш ты сам

Цитата(_hunter @ 5.1.2006, 14:54)

значит ошибок нет. и выходиш ты сам

Все делаю как в примере.
А у тебя нет исходников какого-нибудь примера сервиса?

Написание сервисов Windows NT на WinAPI
Источник: 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;

Поиск... и еще раз поиск.

Читай ремарки в коде :
http://forum.vingrad.ru/index.php?findpost=471413

Добавлено @ 10:50
Poseidon почти все енто есть в нашем факе!!! И в принципе... инфы там более чем достаточно!