unit MyServiceDataModul;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, SvcMgr, Math, AppEvnts, Registry, Dialogs, ExtCtrls, Types, StdCtrls;
type
TMyService =
class(TService)
function GetServiceController: TServiceController;
override;
procedure ServiceCreate(Sender: TObject);
procedure ServiceStart(Sender: TService;
var Started: Boolean);
procedure ServiceExecute(Sender: TService);
procedure DebugServiceClose(Sender: TObject;
var CanClose: Boolean);
end;
var
MyService: TMyService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
MyService.Controller(CtrlCode);
end;
function TMyService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
type
TServiceApplicationHack =
class(TServiceApplication);
procedure TMyService.ServiceCreate(Sender: TObject);
var
Started: Boolean;
Temp: TForm;
begin
if IsDebuggerPresent
or FindCmdLineSwitch('
DEBUG', ['
-', '
/'], True)
then begin
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;
{ SvcMgr.Application.Run; }
{}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
{} while not Terminated
do begin
{} Forms.Application.ProcessMessages;
{} Sleep(20);
{} end;
{} Forms.Application.Terminate;
{}end;
end;
end;
procedure TMyService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
try
...
except
on E:
Exception do begin
Started := False;
ErrCode := 666;
E.
Message := '
Service konnte nicht gestartet werden.' + sLineBreak + E.
Message;
raise;
end;
end;
end;
procedure TMyService.ServiceExecute(Sender: TService);
begin
while not Terminated
do
try
ServiceThread.ProcessRequests(False);
except
on E:
Exception do begin
LogEvent('
Es ist ein nicht abgefangener Fehler aufgetreten.', E);
Sleep(500);
end;
end;
end;
procedure TMyService.DebugServiceClose(Sender: TObject;
var CanClose: Boolean);
begin
if Assigned(MyService)
and Assigned(MyService.ServiceThread)
then
MyService.ServiceThread.Terminate;
end;
end.