NT-Services
Ein eigener Service
Wie schreibe ich nun einen Service?
Das ist nicht so schwer wie man glauben mag. Man binde die WinSVC Unit in sein Projekt ein (das im besten Falle ein Konsolenprogramm sein sollte, da nur interaktive Services mit dem Benutzer interagieren können).
Wir gehen also erstmal von einem Konsolenprogramm aus.
program svc;
uses
windows,
winsvc;
const
servicename='testservice';
displayname='assarbad''s testservice';
procedure service_main;forward;
{$include consolehlp.pas}
{$include service.pas}
procedure service_main;
begin
repeat
if not paused then begin
end;
until stopped;
end;
begin
prog_main;
end.
Die Prozedur PROG_MAIN ist in SERVICE.PAS definiert und CONSOLEHLP.PAS enthält einige Hilfroutinen für Konsolenprogramme die zum Teil der CRT Unit von Turbo Pascal nachempfunden sind.
Da eine jede eingebundene Unit extra Overhead mit sich bringt (das entsteht durch die Compilertechnologie, die verschiedene Informationen bei Units zwischenspeichert, die dann nicht mehr entfernt werden), nutzen wir INCLUDE Dateien.
PROG_MAIN sieht wie folgt aus:
procedure PROG_MAIN;
begin
case paramcount OF
0:startasservice;
else begin
GetModuleFileName(hInstance, @modname[0], MAX_PATH);
Getlasterror;
param:=paramstr(1);
case param[1]='/' OF
true: begin
currtextattr:=textattribute;
settextattribute(FOREGROUND_GREEN or FOREGROUND_INTENSITY);
writeln(cmd_header);
settextattribute(currtextattr);
case param[2] of
'I', 'i':begin
currtextattr:=textattribute;
settextattribute(FOREGROUND_BLUE or
FOREGROUND_INTENSITY);
StartupMode:=SERVICE_DEMAND_START;
if length(param)>2 then
case param[3] of
'A', 'a':startupMode:=SERVICE_AUTO_START;
end
else StartupMode:=SERVICE_DEMAND_START;
case startupMode of
SERVICE_AUTO_START:writeln(cmd_install+
'n autostart service');
SERVICE_DEMAND_START:writeln(cmd_install+
' manual start service');
end;
settextattribute(currtextattr);
hSCM:=OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
case hSCM of
0:FatalError;
else begin
hService:=CreateService(hSCM,
PChar(ServiceName),
PChar(DisplayName),
SERVICE_START OR SERVICE_QUERY_STATUS OR _DELETE,
SERVICE_WIN32_OWN_PROCESS,
StartupMode,
SERVICE_ERROR_NORMAL,
@modname[0],
NIL, NIL, NIL, NIL, NIL);
case hService of
0:begin
CloseServiceHandle(hSCM);
FatalError;
end;
else begin
CloseServiceHandle(hSCM);
CloseServiceHandle(hService);
writeln(frmt(cmd_installed, [pchar(servicename),
NIL]));
end;
end;
end;
end;
end;
'U', 'u':begin
currtextattr:=textattribute;
settextattribute(FOREGROUND_BLUE or
FOREGROUND_INTENSITY);
writeln('Attempting to uninstall "'+servicename+'"');
settextattribute(currtextattr);
hSCM:=OpenSCManager(NIL, NIL, SC_MANAGER_ALL_ACCESS);
case hSCM of
0:FatalError;
else begin
hService:=OpenService(hSCM, PChar(Servicename),
SERVICE_ALL_ACCESS);
case hService of
0:begin
CloseServiceHandle(hSCM);
FatalError;
end;
else begin
startupMode:=
integer(DeleteService(hService));
CloseServiceHandle(hService);
CloseServiceHandle(hSCM);
case startupMode of
0:FatalError;
else
writeln(frmt(cmd_installed,
[pchar(servicename), PChar('un')]));
end;//case
end;
end;//case
end;
end;//case
end;
else showsyntax;
begin
end;
end;//case
end;
false:startasservice;
end;
end;
end;
end;
Es überprüft die übergebenen Parameter und installiert/deinstalliert gegebenenfalls den Service oder eben startet diesen als Service:
procedure startasservice; begin dispatchtable[0].lpservicename:=pchar(servicename); dispatchtable[0].lpserviceproc:=@serviceproc; dispatchtable[1].lpservicename:=NIL; dispatchtable[1].lpserviceproc:=NIL; startservicectrldispatcher(dispatchtable[0]); end;
startservicectrldispatcher() übergibt den Hauptthread des Prozesses an den Service Control Manager (SCM).
Auffällig im Hauptprogramm ist noch die Prozedur SERVICE_MAIN. Sie enthält die eigentliche Hauptschleife des Services, wobei die Variablen STOPPED und PAUSED innerhalb des Programms vordefiniert sind.
Alles innerhalb dieser Prozedur wird also ausgeführt, während der Service als Service läuft.
Download des Beispielservices (Service-Skelett) (ca. 14 KB)