Создать службу windows в delphi

Delphi: службы

КОМПЬЮТЕРНЫЕ КУРСЫ «ПОИСК»

Пример проекта службы

Попробуем создать демонстрационный проект простейшего сервиса для ОС Windows NT. Для этого откроем диалоговое окно New Items и на странице New дважды щелкнем по пиктограмме Service Application.

В результате Delphi создаст шаблон проекта службы с одним сервисом.

Начнем работу с конфигурирования сервиса. Для этого выберем модуль Service1 и внесем ряд изменений в его свойства:

Сохраните проект в отдельном каталоге, при этом модуль службы назовите DemoSrv.pas, а весь проект – dmsrv.dpr. В секции частных объявлений модуля DemoSrv.pas опишем две переменные:

В момент старта сервиса получаем контекст дисплея и обнуляем счетчик:

Переходим к описанию события OnExecute() сервиса. О факте работы сервиса информируем пользователя текстовой строкой, в которой выводим текущее значение счетчика. Служба остановится в случае, когда счетчик превысит значение 100 или по команде от внешней управляющей программы. Для этого внутри цикла с помощью ProcessRequests() регулярно производим асинхронный опрос менеджера служб на предмет поступления команд от внешних приложений.

Обращаю внимание, что вывод текстовой строки на экран возможен только в случае, когда сервис работает в интерактивном режиме. Событие остановки используем для освобождения дескриптора контекста устройства:

Регистрация службы средствами приложения

Для регистрации службы в операционной системе владеющее службой приложение должно быть запущено из командной строки с ключом /INSTALL. Например:

Для снятия с регистрации применяют ключ /UNINSTALL. Процесс установки сервиса сопровождается выводом уведомляющего сообщения. Для отказа от показа окна уведомления используйте ключ /SILENT. Откройте консоль управления службами компьютера, найдите в ней наш сервис «Демонстрация сервиса» и запустите его на выполнение…

Источник: Д.Осипов — Delphi. Профессиональное программирование.

Исходный код примера здесь. Выполнен на Delphi XE.

Источник

Пара нюансов при создании службы (Windows Service) и не только

Оказывается, в VCL нет встроенных средств для запуска службы. Службу можно установить, а запускаться она будет только после перезагрузки компьютера. Довольно странно, но факт.
Решить эту проблему через WinAPI (если класс нашей службы называется TMyService):

Каким же образом сообщить службе об изменении конфигурации (чтобы она прочитала её заново – из реестра или с диска)? Проще всего – создать глобальное именованное событие (CreateEvent) и через него сигнализировать (SetEvent) из конфигуратора службе (которая будет ждать его, либо периодически проверять, через WaitForSingleObject). Но тут нас поджидает засада: при попытке открыть из конфигуратора событие (OpenEvent), созданное службой, мы получим ошибку запрета доступа (GetLastError = ERROR_ACCESS_DENIED).

Это происходит из-за того, что объект (событие) создан «системой» (службы запускаются от имени «системы»), а открывается администратором (если конфигуратор находится в том же EXE – установить/удалить службу может только администратор) или даже обычным пользователем (если конфигуратор находится в другом EXE-шнике). Тоже самое будет при попытке открыть обычным пользователем объект, созданный администратором.

Что же делать? Сначала я решил пойти по странному пути: создать объект в конфигураторе, а в службе периодически пытаться открыть его, и после успешного открытия начать проверять состояние («система» может открыть объект, созданный администратором или обычным пользователем). Но потом эта идея мне показалась костыльной, и я решил разобраться, как создать объект в службе, не защищённый от доступа админов и обычных юзеров.

Вот так это делается (в службе):

(разумеется, при необходимости создания нескольких событий нет смысла создавать и настраивать несколько дескрипторов и атрибутов безопасности, можно использовать одни и те же; при завершении работы ничего, кроме события, закрывать или освобождать не нужно)

Источник

Как писать сервисы на Delphi

Если Вы воспользуетесь мастером создания сервиса в delphi, то он даст Вам минимальный код, который годится разве что только для самого начала работы по созданию заготовки пустого ничего не делающего сервиса. К тому же сервис довольно трудно отлаживать. А в операционных системах windows 9x невозможно использовать вовсе. Поэтому, обычно, сервис делают одновременно обычным приложением с возможностью регистрации и запуска как сервис. Т.е. если операционная система windows 9x, то запускаем его в автозагрузке, если windows nt, xp и выше, то регистрируем в сервисах. Если сервис нуждается в настройках или показе текущего состояния, то лучше всего, чтобы он отображал свою иконку в панели задач, как это делают, например, часы, с возможностью управлять им через всплывающее меню. Вот такой сервис мы с Вами сейчас и создадим.
Итак, выполним пункт меню file|new|other… В списке категорий выберите delphi projects и дважды щелкните по иконке service applications.

Сохраните полученные модули на диск. Я сохранил сервис как main.pas, а проект – myservice.pas. Переименуйте сервис в myservice. Затем, добавьте к проекту окно. Это будет окно, показывающее состояние сервера и информацию о программе. Сохраните модуль под именем aboutform. Так как мы будем запускать наш сервис еще и в режиме простой программы, то нам как-то нужно различать эти два режима. Для этого можно завести глобальную переменную в модуле aboutform. Я назвал её fromservice: boolean. Если запускается сервис, то она равна true, если как программа – false. Вот модуль сервиса:

unit main;
interface
uses
windows, messages, sysutils, classes, graphics, controls, svcmgr, dialogs,
menus;
type
tmyservice = class(tservice)
procedure servicestop(sender: tservice; var stopped: boolean);
procedure servicestart(sender: tservice; var started: boolean);
private
public
function getservicecontroller: tservicecontroller; override;
< public declarations >
end;
var
myservice: tmyservice;
implementation
uses aboutform;
<$r *.dfm>
procedure servicecontroller(ctrlcode: dword); stdcall;
begin
myservice.controller(ctrlcode);
end;
function tmyservice.getservicecontroller: tservicecontroller;
begin
result:=servicecontroller;
end;
procedure tmyservice.servicestart(sender: tservice; var started: boolean);
begin
started:=true;
end;
procedure tmyservice.servicestop(sender: tservice; var stopped: boolean);
begin
stopped:=true;
end;
end.
Как видите, он практически пустой. Здесь есть только два обработчика на старт и останов сервиса. Вот код окна about:

unit aboutform;
interface
uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, menus, shellapi, buttons, stdctrls;
const wm_midasicon = wm_user + 1;
type
tfabout = class(tform)
popupmenu: tpopupmenu;
miclose: tmenuitem;
n1: tmenuitem;
config1: tmenuitem;
miproperties: tmenuitem;
speedbutton1: tspeedbutton;
label8: tlabel;
label9: tlabel;
label11: tlabel;
label7: tlabel;
label6: tlabel;
procedure config1click(sender: tobject);
procedure label7click(sender: tobject);
procedure label6click(sender: tobject);
procedure speedbutton1click(sender: tobject);
procedure formclose(sender: tobject; var action: tcloseaction);
procedure formdestroy(sender: tobject);
procedure formcreate(sender: tobject);
procedure mipropertiesclick(sender: tobject);
procedure micloseclick(sender: tobject);
private
fnt351: boolean;
ficondata: tnotifyicondata;
fclosing: boolean;
procedure addicon;
procedure deleteicon;
procedure wmmidasicon(var message: tmessage); message wm_midasicon;
protected
public
end;
var
fabout: tfabout;
fromservice: boolean;
implementation
<$r *.dfm>
uses main;

Иконку можно добавить только начиная с windows 95 или windows nt4 (как известно, у неё рабочий стол от windows 95). Поэтому, сначала нужно проверить версию windows, и если она выше nt 3.51, то можно добавлять. Добавляется иконка вызовом api оболочки — shell_notifyicon. Для этого просто заполняется структура tnotifyicondata и делается соответствующий вызов. Как видите, саму иконку можно взять из окна about. Это хорошо, т.к. тогда можно сделать иконку 16Х16, а не 32Х32. Такая иконка будет лучше смотреться в панели задач. ucallbackmessage будет посылаться оболочкой всякий раз, когда там происходят некоторые события с мышью.

procedure tfabout.addicon;
begin
if not fnt351 then
begin
with ficondata do
begin
cbsize := sizeof(ficondata);
wnd:=handle;
uid:=$dedb;
uflags:=nif_message or nif_icon or nif_tip;
hicon:=icon.handle;
ucallbackmessage:=wm_midasicon;
strcopy(sztip, pchar(‘my service’));
end;
shell_notifyicon(nim_add, @ficondata);
end;
end;

Здесь мы просто просим оболочку удалить иконку из панели задач.

procedure tfabout.deleteicon;
begin
if not fnt351 then
shell_notifyicon(nim_delete, @ficondata);
end;

Метод wmmidasicon объявлен как обработчик события wm_midasicon. Здесь проверяется какое именно событие произошло. Если двойной клик по иконке, то показывается окно about, если клик правой кнопкой мыши, то показывается всплывающее меню. Это меню можно поставить прямо на окно about. Там три пункта: close, разделитель, configuration, about. К нему мы еще вернемся позже.

procedure tfabout.wmmidasicon(var message: tmessage);
var pt: tpoint;
begin
case message.lparam of
wm_rbuttonup: begin
if not visible then
begin
setforegroundwindow(handle);
getcursorpos(pt);
popupmenu.popup(pt.x, pt.y);
end
else
setforegroundwindow(handle);
end;
wm_lbuttondblclk: if visible then
setforegroundwindow(handle)
else
mipropertiesclick(nil);
end;
end;

При создании окна проверяется версия windows, затем, если программа запущена как сервис, то делается невидимым пункт меню close и разделитель. Это сделано специально, чтобы останавливать сервис можно было только в штатном режиме из апплета управления компьютером. Далее, добавляется иконка.

procedure tfabout.formcreate(sender: tobject);
begin
fnt351 := (win32majorversion 0 then
begin
svc:=openservice(mgr, pchar(‘myservice’), service_all_access);
result:=svc <> 0;
if result then
begin
queryserviceconfig(svc, nil, 0, size);
config:=allocmem(size);
try
queryserviceconfig(svc, config, size, size);
servicestartname:=pqueryserviceconfig(config)^.lpservicestartname;
if comparetext(servicestartname, ‘localsystem’) = 0 then
servicestartname:=’system’;
finally
dispose(config);
end;
closeservicehandle(svc);
end;
closeservicehandle(mgr);
end;
if result then
begin
size:=256;
setlength(username, size);
getusername(pchar(username), size);
setlength(username, strlen(pchar(username)));
result:=comparetext(username, servicestartname) = 0;
end;
end;

Если приложение запускается как сервис, или если его хотят зарегистрировать как сервис, то мы идем по пути как в проекте, созданном delphi по умолчанию. Единственное, что лучше явно указывать, какой именно application мы используем: в svcmrg – это сервис, а в forms – это простое приложение. Если же запуск идет как простое приложение, указываем, что не нужно показывать главную форму, делаем форму about основной (первая созданная), создаем форму сервиса. Важно, что сервис – это tdatamodule. И когда мы его так создадим из tapplication, то сервис не будет запущен. Это и хорошо – у нас будет просто подходящий модуль данных j

Источник