procedure TMyService.ServiceCreate(Sender: TObject);
// TService.OnCreate
var
Started: Boolean;
DebugWindow: TForm;
begin
FIsDebugging := IsDebuggerPresent
or FindCmdLineSwitch('
DEBUG', ['
-', '
/'], True);
// Das war der Teil, damit es sich mit der Console verbindet und man dann einfach z.B. via WriteLn('log message'); was ausgeben kann.
// Oder z.B. noch ein Memo ins DebugWindow.
// Gebe in die Console, sowie ins Windows-EreignisLog, eh nur wichtigsten Stati aus, damit der Admin vor Ort einen Überblick bekommt (der Rest in normale Logdateien)
if FIsDebugging
then
AttachConsole(ATTACH_PARENT_PROCESS);
try
if FIsDebugging
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, DebugWindow);
// Form zum Beenden und für Eintrag in Taskbar
DebugWindow.
Name := '
DebugWindow';
DebugWindow.Caption := '
Debug-Mode: ' + DM1.DSDisplayName + GenerateViewID(True);
DebugWindow.OnCloseQuery := DebugServiceClose;
DebugWindow.Width := 500;
DebugWindow.Height := 125;
DebugWindow.Visible := True;
with TButton.Create(DebugWindow)
do begin
Name := '
DebugWindowsClose';
Parent := DebugWindow;
Caption := '
Close';
Width := 100;
OnClick := DebugServiceClose2;
end;
{ SvcMgr.Application.Run; // bricht ab, wenn nicht als Service gestartet, darum dessen Code hier nachgebaut }
if FindCmdLineSwitch('
INSTALL', ['
-', '
/'], True)
then begin
TServiceApplicationAccess(SvcMgr.Application).RegisterServices(True, FindCmdLineSwitch('
SILENT', ['
-', '
/'], True));
end else if FindCmdLineSwitch('
UNINSTALL', ['
-', '
/'], True)
then begin
TServiceApplicationAccess(SvcMgr.Application).RegisterServices(False, FindCmdLineSwitch('
SILENT', ['
-', '
/'], True));
end else begin
Started := True;
ServiceStart(Self, Started);
if Started
then begin
ServiceExecute(
nil);
// der Service-Thread existiert/läuft nicht, wenn die EXE nicht aus der Service-Verwaltung gestartet wurde, daher manueller Aufruf, um die BackgroundThreads zu starten
while not Terminated
and not Forms.Application.Terminated
do
try
Forms.Application.ProcessMessages;
Sleep(10);
except
{error logging ...}
end;
Forms.Application.Terminate;
for i := 1
to 30
do begin // Bissl warten, damit sich die BackgroundThreads sich noch rechtzeitig beenden können.
(DebugWindow.FindComponent('
DebugWindowsClose')
as TButton).Caption := Format('
Terminate (%ds)', [31 - i]);
Forms.Application.ProcessMessages;
Sleep(1*MSecsPerSec);
end;
try DebugWindow.Free;
except end;
end else begin
Forms.Application.Terminate;
end;
end;
end;
except
on E:
Exception do begin
if ExitCode = 0
then
ExitCode := 38;
// Fehlercode für IF ERRORLEVEL im aufrufenden Batch
raise;
end;
end;
end;
procedure TMyService.DebugServiceClose(Sender: TObject;
var CanClose: Boolean);
begin
if not Forms.Application.Terminated
then
DebugServiceClose2((Sender
as TForm).FindComponent('
DebugWindowsClose'));
end;
procedure TMyService.DebugServiceClose2(Sender: TObject);
begin
if not ContainsText(TButton(Sender).Caption, '
Terminate')
then begin
//if Assigned(MyService) then
// MyService.Terminate; // hier gibt es zwar ein Terminated, aber kein Terminate -> Status wird aus ServiceThread.Terminated geholt
if Assigned(MyService)
and Assigned(MyService.ServiceThread)
then
MyService.ServiceThread.Terminate;
// eigentlich aktuell nicht nötig, da im Debugmodus der Service-Thread nicht existiert/läuft -> siehe ServiceExecute(nil);
Forms.Application.Terminate;
TButton(Sender).Caption := '
Terminate (30s)';
end else begin
// Wenn der Apps nicht auf Terminate hören will, dann eben die harte Tour. (beim zweiten Klicken auf Close)
TerminateProcess(GetCurrentProcess, 1);
// Halt() versucht noch die Units zu entladen, wobei es hängen bleiben kann.
Halt(1);
end;
end;