unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls;
type
Tstest =
class(TService)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure ServiceCreate(Sender: TObject);
private
PROCEDURE WriteLog(sText:
STRING);
procedure start;
{ Private-Deklarationen }
public
function GetServiceController: TServiceController;
override;
{ Public-Deklarationen }
end;
var
stest: Tstest;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
stest.Controller(CtrlCode);
end;
function Tstest.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure Tstest.start;
begin
WriteLog('
Test');
end;
procedure Tstest.WriteLog(sText:
STRING);
VAR
F: TextFile;
s:
STRING;
BEGIN
s := '
Fehlerlog.log';
// das kann nach Belieben angepasst werden
IF FileExists(s)
THEN
BEGIN
AssignFile(F, s);
Append(F);
Writeln(F, DateTimeToStr(Now) + '
: ' + sText);
END
ELSE
BEGIN
AssignFile(F, s);
Rewrite(F);
Writeln(F, DateTimeToStr(Now) + '
: ' + sText + '
(neu)');
END;
CloseFile(F);
end;
procedure Tstest.Timer1Timer(Sender: TObject);
begin
start;
end;
procedure Tstest.ServiceCreate(Sender: TObject);
begin
if not Timer1.Enabled
then
Timer1.Enabled := True;
end;
end.