Пример службы на Delphi (WinAPI)

Книга знаний

Чтобы создать службу на Delphi, достаточно нажать F1, набрать TService и прочитать раздел using tservice. Но можно написать службу и на более низком уровне WinAPI, чему и посвящена статья.

Автор статьи: romix | Редакторы:
Последняя редакция №5 от 08.11.07 | История
URL: http://kb.mista.ru/article.php?id=580

Ключевые слова: Служба, Service, Delphi, WinAPI

Поместить в файл с расширением dpr, например, srv1.dpr.
Установка службы - srv1.exe /Install
Удаление службы - srv1.exe /Delete
Имя службы - "Sample_Srv"
Выполняемое действие - периодический звуковой сигнал beep()
Источник - кажется, эта статья
http://ishodniki.ru/art/artshow.php?cat=1&id=90&show=delphi
"Написание сервисов Windows NT на WinAPI"

Служба будет периодически выдавать окно Предупреждения.
Чтобы показывалось это окно сообщения, установите
Мой компьютер-Правый клик-Управление-Службы и приложения-Службы (англ. Services)
В списке выберите свою службу (в данном случае Sample_Srv).
Свойства - закладка Вход в систему - установить флажок
"Разрешить взаимодействие с рабочим столом" (англ. "Interact with desktop").

program Project1;


uses
 Windows, WinSvc, SysUtils;

const c_ServiceName = 'Sample_Srv';

var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
var sst : SERVICE_STATUS;
var sstHandle : SERVICE_STATUS_HANDLE;

///////////////////////////////////////////////////////////////////////
procedure SetServiceStatus1;
begin
  if not SetServiceStatus(sstHandle,sst) then
  RaiseLastOSError;
end;
///////////////////////////////////////////////////////////////////////
procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
begin
 case Opcode of

  SERVICE_CONTROL_STOP:
   begin
    sst.dwWin32ExitCode:=0;
    sst.dwCurrentState := SERVICE_STOPPED;
    sst.dwCheckPoint   :=0;
    sst.dwWaitHint     :=0;
    SetServiceStatus1;
    exit;
   end;

  SERVICE_CONTROL_INTERROGATE : ;
 end;

 SetServiceStatus1;
end;

///////////////////////////////////////////////////////////////////////
procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;
begin
  sst.dwServiceType      := SERVICE_WIN32;
  sst.dwCurrentState     := SERVICE_START_PENDING;
  sst.dwControlsAccepted := SERVICE_ACCEPT_STOP;
//    or SERVICE_ACCEPT_PAUSE_CONTINUE;
  sst.dwWin32ExitCode           := 0;
  sst.dwServiceSpecificExitCode := 0;
  sst.dwCheckPoint              := 0;
  sst.dwWaitHint                := 0;

  sstHandle :=
           RegisterServiceCtrlHandler(c_ServiceName,@ServiceCtrlHandler);

  if sstHandle = 0 then RaiseLastOSError;

   sst.dwCurrentState :=SERVICE_RUNNING;
   sst.dwCheckPoint   :=0;
   sst.dwWaitHint     :=0;

   SetServiceStatus1;

  //ОСНОВНОЙ КОД ПРОГРАММЫ 
  repeat
   sleep(3000);
   beep();
   MessageBox(0, 'Проверка службы', 'sample_srv', 0);
   //Чтобы показывалось окно сообщения, установите 
   //Мой компьютер-Правый клик-Управление-Службы и приложения-Службы (англ. Services) 
   //В списке выберите свою службу. 
   //Свойства - закладка Вход в систему - установить флажок 
   //"Разрешить взаимодействие с рабочим столом" (англ. "Interact with desktop"). 
  until sst.dwCurrentState = SERVICE_STOPPED;
end;

///////////////////////////////////////////////////////////////////////

var schService, schSCManager: SC_HANDLE;
var binExe: pchar;
begin


 if ParamStr(1)='/Install' then begin
   binExe:=pchar(ParamStr(0));

 ///////////////////////////// Установка службы

    schSCManager := OpenSCManager(
    nil,                    // local machine
    nil,                    // ServicesActive database
    SC_MANAGER_ALL_ACCESS);  // full access rights

    if schSCManager=0 then RaiseLastOSError;

    schService := CreateService(
        schSCManager,              // SCManager database
        c_ServiceName,               // name of service
        c_ServiceName,           // service name to display
        SERVICE_ALL_ACCESS,        // desired access
        SERVICE_WIN32_OWN_PROCESS, // service type
        SERVICE_DEMAND_START,      // start type
        SERVICE_ERROR_NORMAL,      // error control type
        binExe,        // service's binary
        nil,                      // no load ordering group
        nil,                      // no tag identifier
        nil,                      // no dependencies
        nil,                      // LocalSystem account
        nil);                     // no password

     if schService=0 then
       RaiseLastOSError;

     if not CloseServiceHandle(schService) then
       RaiseLastOSError;

       exit;

 ///////////////////////////// Удаление службы

   end else if ParamStr(1)='/Delete' then begin

    schSCManager := OpenSCManager(
    nil,                    // local machine
    nil,                    // ServicesActive database
    SC_MANAGER_ALL_ACCESS);  // full access rights

    if schSCManager=0 then RaiseLastOSError;

     schService := OpenService(
        schSCManager,       // SCManager database
        c_ServiceName,       // name of service
        SERVICE_ALL_ACCESS);            // only need DELETE access

    if schService = 0 then
      RaiseLastOSError;

    if not DeleteService(schService) then
      RaiseLastOSError;

    if not CloseServiceHandle(schService) then
      RaiseLastOSError;
    exit;

end;
 ///////////////////////////// Запуск службы
 DispatchTable[0].lpServiceName:=c_ServiceName;
 DispatchTable[0].lpServiceProc:=@ServiceProc;

 DispatchTable[1].lpServiceName:=nil;
 DispatchTable[1].lpServiceProc:=nil;

 if not StartServiceCtrlDispatcher(DispatchTable[0]) then
   RaiseLastOSError;

end.