Сохраните полученные модули на диск. Я сохранил сервис как 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 <= 3) and (win32platform = ver_platform_win32_nt);
if fromservice then
begin
miclose.visible:=false;
n1.visible:=false;
end;
addicon;
fclosing:=false;
end;

При уничтожении окна иконка удаляется.

procedure tfabout.formdestroy(sender: tobject);
begin
deleteicon;
end;

На всякий случай, если запушено как приложение, то закрытие окна не должно закрывать программу, но если нажать пункт меню close, то программа должна закрываться. Т.к. мы показываем форму модально, то так оно и будет, но лучше оставить этот код, чтобы быть полностью уверенным.

procedure tfabout.formclose(sender: tobject; var action: tcloseaction);
begin
if fclosing then
action:=cafree
else
action:=cahide;
end;

На форме about есть кнопка для вызова справки. Т.к. application для сервиса не имеет методов вызова файла помощи, то пришлось пользоваться api. Здесь id_cont определен в файле помощи пункт, а myserver.hlp – имя файла помощи.

procedure tfabout.speedbutton1click(sender: tobject);
var command: array[0..255] of char;
begin
strlfmt(command, sizeof(command) - 1, 'jumpid("","%s")', ['id_cont']);
winhelp(handle, pchar(extractfilepath(paramstr(0))+'myserver.hlp'), help_contents, longint(@command));
end;

На форме стоит две метки с надписью support и www.myserver.ru для перехода на сайт разработчика.
procedure tfabout.label6click(sender: tobject);
begin
shellexecute(forms.application.handle, 'open', 'mailto:support@myserver.ru?subject=myserver : bugs!!!', '', '', sw_show);
end;
procedure tfabout.label7click(sender: tobject);
begin
shellexecute(forms.application.handle,'open','http://www.myserver.ru','','',sw_show);
end;

Пункт меню close. Когда запушено приложение, то уничтожение окна about закрывает программу, т.к. оно является главным окном.

procedure tfabout.micloseclick(sender: tobject);
begin
fclosing:=true;
close;
end;

Пункт меню about – просто показывает форму, т.е. саму себя.

procedure tfabout.mipropertiesclick(sender: tobject);
begin
showmodal;
deleteicon;
addicon;
end;

Пункт меню configuration. Здесь один из вариантов решения проблемы. Часто для управления настройками сервисов используют апплеты в панели управления. Для этого достаточно написать свою cpl. Но, не хотелось бы повторять весь этот код в сервере. Как известно, cpl – это обычная dll, поэтому нам ничего не мешает экспортировать какой-нибудь метод из нее и загрузить её динамически…

procedure tfabout.config1click(sender: tobject);
type tgetdesignerinterface = procedure; safecall;
var getfunc: tgetdesignerinterface;
dllhandle: thandle;
const
dllname = 'mysrvcnf.cpl';
funcname = 'editconfiguration';
begin
dllhandle:=loadlibrary(pchar(dllname));
if dllhandle < 32 then
raise exception.create('not found "'+dllname+'" !');
getfunc:=getprocaddress(dllhandle, pchar(funcname));
if not assigned(getfunc) then
begin
freelibrary(dllhandle);
raise exception.create('not fount function "'+funcname+'"');
end;
try
getfunc;
finally
freelibrary(dllhandle);
end;
end;
end.
Наконец, код проекта сервиса:

program myserver;

Обратите внимание, что в uses указан модуль forms, который не включается автоматически в проект. Он нам понадобится для запуска нашего сервера как приложения.
uses
svcmgr,
forms,
sysutils,
windows,
types,
winsvc,
main in 'main.pas' {myserver: tservice},
aboutform in 'aboutform.pas' {fabout};
{$r *.res}
Проверка командной строки на предмет указаний инсталлировать или удалить сервис.

function installing: boolean;
begin
result:=findcmdlineswitch('install',['-','','/'], true) or
findcmdlineswitch('uninstall',['-','','/'], true);
end;
Функция проверяет, что приложение запущено как сервис. Этот код просто взят из модуля scktsrvr.dpr. Кстати, если разобраться в этом проекте, то Вы сможете писать сервисы даже на delphi 2, 3.
function startservice: boolean;
var mgr, svc: integer;
username, servicestartname: string;
config: pointer;
size: dword;
begin
result:=false;
mgr:=openscmanager(nil, nil, sc_manager_all_access);
if mgr <> 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

begin
if installing or startservice then
begin
svcmgr.application.initialize;
aboutform.fromservice:=true;
svcmgr.application.createform(tfabout, fabout);
svcmgr.application.createform(tmyservice, myservice);
svcmgr.application.run;
end
else
begin
forms.application.showmainform:=false;
forms.application.initialize;
aboutform.fromservice:=false;
forms.application.createform(tfabout, fabout);
forms.application.createform(tmyservice, myservice);
forms.application.run;
end;
end.
Уже можно запустить и покликать по меню, закрыть, зарегистрировать и запустить как сервис – все работает. Но, наш сервис пуст и ничего не делает. Что он должен делать – Вам решать.
И последнее, зарегистрировать сервис можно командой myserver /install, а удалить регистрацию – myserver /uninstall.
Успехов в разработке своих сервисов!