Пример службы на 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. |