{ Lazarus servie, Windows 10 64.
Lazarus 2.2.0 (rev lazarus_2_2_0-7-gb938b1d561)
FPC 3.2.3 i386-win32-win32/win64
Windows: cmd line administrator:
install service : LazarusService.exe -i
: sc create "LazarusService" binpath="C:\L\_src\DaemonService\Service\LazarusService.exe"
start service : sc start LazarusService
stop service : sc stop LazarusService --> mem leak
uninstall service: sc delete LazarusService
check status : sc queryex LazarusService
https://forum.lazarus.freepascal.org/index.php/topic,57754.0.html, thanks getmem }
program LazarusService;
{$mode objfpc}{$H+}
uses
HeapTrc,
{$IFDEF UNIX}{$IFDEF UseCThreads}
CThreads,
{$ENDIF} Cmem,{$ENDIF}
sysutils, classes, daemonapp, {jwawindows, } eventlog;
type
{ TWorkerThread }
TWorkerThread = class(TThread)
private
FIsPaused: Boolean;
protected
procedure Execute; override;
public
destructor Destroy; override;
end;
TDaemon = class(TCustomDaemon)
private
FWorkerThread: TWorkerThread;
procedure DoTerminate(Sender: TObject);
public
function ShutDown: Boolean; override;
function Stop: Boolean; override;
function Start: Boolean; override;
function Pause: Boolean; override;
function Continue: Boolean; override;
end;
TDaemonMapper = class(TCustomDaemonMapper)
private
public
constructor Create(AOwner: TComponent); override;
end;
procedure TWorkerThread.Execute;
const ii : int64 = 0;
begin
Application.Log(etDebug, 'WorkerThreadExecute: entering Execute event');
try
while not Terminated do begin
try
Sleep(5000);
if (not FIsPaused) then begin
//do something
end;
Application.Log(etDebug, ii.ToString);
inc(ii);
except
on e:Exception do begin
Application.Log(etDebug, e.Message);
end;//on e
end;//except
end;//while
finally
Application.Log(etDebug, 'WorkerThreadExecute: leaving Execute event ---- .');
OnTerminate(Self);
end;
end;//procedure TWorkerThread.Execute;
destructor TWorkerThread.Destroy;
begin
Application.Log(etDebug, 'WorkerThreadDestroy');
inherited Destroy;
end;
procedure TDaemon.DoTerminate(Sender: TObject);
begin
Application.Log(etDebug, 'DaemonDoTerminate: Worker thread terminated!!!!!');
if FWorkerThread <> nil then
FreeAndNil(FWorkerThread);
end;
function TDaemon.Start: Boolean;
begin
Result := inherited Start;
Application.Log(etDebug, 'DaemonStart: LazarusService started.');
FWorkerThread := TWorkerThread.Create(True);
FWorkerThread.FIsPaused := False;
FWorkerThread.OnTerminate := @DoTerminate;
FWorkerThread.FreeOnTerminate := False;
FWorkerThread.Start;
end;
function TDaemon.Stop: Boolean;
var ii : Int64 = 0;
begin
FWorkerThread.Terminate;
while(FWorkerThread<>nil)do begin
Sleep(500);
Application.Log(etDebug, 'DaemonStop: Waiting for workerThread '+ii.ToString);
inc(ii);
end;
Result := inherited Stop;
Application.Log(etDebug, 'DaemonStop: LazarusService stopped.');
end;
function TDaemon.Pause: Boolean;
begin
Result := inherited Pause;
FWorkerThread.FIsPaused := True;
Application.Log(etDebug, 'DaemonPause: LazarusService paused.');
end;
function TDaemon.Continue: Boolean;
begin
Result := inherited Continue;
FWorkerThread.FIsPaused := False;
Application.Log(etDebug, 'DaemonContinue: LazarusService resumed.');
end;
function TDaemon.ShutDown: Boolean;
begin
Result := inherited ShutDown;
Application.Log(etDebug, 'DaemonShutdown: LazarusService shutdown.');
end;
constructor TDaemonMapper.Create(AOwner: TComponent);
var MyDaemonDef: TDaemonDef;
begin
inherited Create(AOwner);
Application.Log(etDebug, 'DaemonCreate: LazarusService successfully created.');
MyDaemonDef := DaemonDefs.Add as TDaemonDef;
MyDaemonDef.DaemonClassName := TDaemon.ClassName;
MyDaemonDef.Name := 'LazarusService';
MyDaemonDef.DisplayName := 'LazarusService display name';
MyDaemonDef.Description := 'Description Break session 0 isolation';
MyDaemonDef.LogStatusReport := False;
with MyDaemonDef.WinBindings do begin
ServiceType := stWin32;
StartType := stAuto; //stBoot //stManual
ErrorSeverity := esNormal;
WaitHint := 0;
IDTag := 0;
end;
end;//constructor TDaemonMapper.Create(AOwner: TComponent);
begin//main program LazarusService;
RegisterDaemonClass(TDaemon);
RegisterDaemonMapper(TDaemonMapper);
heaptrc.SetHeapTraceOutput(ChangeFileExt(ParamStr(0), '.heaptrc.txt'));
with Application do begin
Title := 'LazarusServiceApplication';
EventLog.LogType := ltFile;
EventLog.DefaultEventType := etDebug;
EventLog.AppendContent := true;
//EventLog.FileName := ExtractFilePath(Application.ExeName) + '.log';
EventLog.FileName := ChangeFileExt(ParamStr(0), '.log');
Initialize;
Run;
end;
end.//file
Recent
