uses
..., Forms, SvcMgr, ...;
// Forms (vor der SvcMgr), damit man Zugriff auf die Messagebehandlung und auf die normale TForm hat.
procedure TMyService.ServiceCreate(Sender: TObject);
var
Started: Boolean;
Temp: TForm;
begin
LogMessage('
Service wird erzeugt', EVENTLOG_INFORMATION_TYPE, 0, 1);
...
if IsDebuggerPresent
or FindCmdLineSwitch('
DEBUG', ['
-', '
/'], True)
then begin
MyService := Self;
// wird sonst von Application.CreateForm gesetzt, aber durch die Messageloop kommt es dort nicht vorbei
Forms.Application.MainFormOnTaskBar := False;
// geht leider doch nicht ohne Form
Forms.Application.CreateForm(TForm, Temp);
// Form zum Beenden und für Eintrag in Taskbar
Temp.Caption := '
Debug-Mode: ' + SvcMgr.Application.Title;
Temp.OnCloseQuery := DebugServiceClose;
Temp.Visible := True;
// ab hier der Ersatz für SvcMgr.Application.Run, welches sonst sofort Beenden würde, da es kein echter Service ist
if FindCmdLineSwitch('
INSTALL', ['
-', '
/'], True)
then
TServiceApplicationHack(Application).RegisterServices(True, FindCmdLineSwitch('
SILENT', ['
-', '
/'], True))
else if FindCmdLineSwitch('
UNINSTALL', ['
-', '
/'], True)
then
TServiceApplicationHack(Application).RegisterServices(False, FindCmdLineSwitch('
SILENT', ['
-', '
/'], True))
else begin
Started := True;
ServiceStart(Self, Started);
if Started
then begin
ServiceExecute(
nil);
while not Terminated
do
try
Forms.Application.ProcessMessages;
Sleep(10);
except
on E:
Exception do begin
LogMessage('
Error: ' + E.ClassName + '
= ' + E.
Message, EVENTLOG_WARNING_TYPE, 0, 22);
Sleep(1000);
end;
end;
end;
Forms.Application.Terminate;
end;
end;
end;
procedure TMyService.ServiceExecute(Sender: TService);
begin
LogMessage('
Service wird ausgeführt', EVENTLOG_INFORMATION_TYPE, 0, 3);
...
while Assigned(Sender)
and not Terminated
do//warten auf beenden
try
ServiceThread.ProcessRequests(False);
Sleep(10);
except
on E:
Exception do begin
LogMessage('
Error: ' + E.ClassName + '
= ' + E.
Message, EVENTLOG_WARNING_TYPE, 0, 22);
Sleep(1000);
end;
end;
LogMessage('
Service wurde beendet', EVENTLOG_INFORMATION_TYPE, 0, 5);
end;
procedure TMyService.DebugServiceClose(Sender: TObject;
var CanClose: Boolean);
begin
if Assigned(MyService)
and Assigned(MyService.ServiceThread)
then
MyService.ServiceThread.Terminate;
end;