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

Книга знаний

Автор статьи:
Последняя редакция №1 от 18.08.07
URL: http://kb.mista.ru/article.php?id=580

Поместить в файл с расширением dpr, например, srv1.dpr.
Установка службы - srv1.exe /Install
Удаление службы - srv1.exe /Delete
Имя службы - "Sample_Srv"

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(1000);
   beep();
  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.