mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-26 20:23:42 +02:00
156 lines
2.9 KiB
ObjectPascal
156 lines
2.9 KiB
ObjectPascal
program daemon;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$define usecthreads}
|
|
{$apptype gui}
|
|
|
|
uses
|
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
|
cthreads,
|
|
{$ENDIF}{$ENDIF}
|
|
sysutils,
|
|
Classes
|
|
{ add your units here }, daemonapp;
|
|
|
|
Type
|
|
|
|
{ TTestDaemon }
|
|
|
|
{ TTestThread }
|
|
|
|
TTestThread = Class(TThread)
|
|
Procedure Execute; override;
|
|
end;
|
|
|
|
TTestDaemon = Class(TCustomDaemon)
|
|
Private
|
|
FThread : TTestThread;
|
|
Procedure ThreadStopped (Sender : TObject);
|
|
public
|
|
Function Start : Boolean; override;
|
|
Function Stop : Boolean; override;
|
|
Function Pause : Boolean; override;
|
|
Function Continue : Boolean; override;
|
|
Function Execute : Boolean; override;
|
|
Function ShutDown : Boolean; override;
|
|
Function Install : Boolean; override;
|
|
Function UnInstall: boolean; override;
|
|
end;
|
|
|
|
{ TTestThread }
|
|
|
|
procedure TTestThread.Execute;
|
|
|
|
Var
|
|
C : Integer;
|
|
|
|
begin
|
|
C:=0;
|
|
Repeat
|
|
Sleep(1000);
|
|
inc(c);
|
|
Application.Log(etcustom,Format('Tick : %d',[C]));
|
|
Until Terminated;
|
|
end;
|
|
|
|
Procedure AWriteln(MSg : String; B : Boolean);
|
|
|
|
begin
|
|
Application.Log(etcustom,Msg+BoolToStr(B));
|
|
end;
|
|
|
|
{ TTestDaemon }
|
|
|
|
procedure TTestDaemon.ThreadStopped(Sender: TObject);
|
|
begin
|
|
FreeAndNil(FThread);
|
|
end;
|
|
|
|
function TTestDaemon.Start: Boolean;
|
|
begin
|
|
Result:=inherited Start;
|
|
AWriteln('Daemon Start',Result);
|
|
FThread:=TTestThread.Create(True);
|
|
FThread.OnTerminate:=@ThreadStopped;
|
|
FThread.FreeOnTerminate:=False;
|
|
FThread.Resume;
|
|
end;
|
|
|
|
function TTestDaemon.Stop: Boolean;
|
|
begin
|
|
Result:=inherited Stop;
|
|
AWriteln('Daemon Stop: ',Result);
|
|
FThread.Terminate;
|
|
end;
|
|
|
|
function TTestDaemon.Pause: Boolean;
|
|
begin
|
|
Result:=inherited Pause;
|
|
AWriteln('Daemon pause: ',Result);
|
|
FThread.Suspend;
|
|
end;
|
|
|
|
function TTestDaemon.Continue: Boolean;
|
|
begin
|
|
Result:=inherited Continue;
|
|
AWriteln('Daemon continue: ',Result);
|
|
FThread.Resume;
|
|
end;
|
|
|
|
function TTestDaemon.Execute: Boolean;
|
|
begin
|
|
Result:=inherited Execute;
|
|
AWriteln('Daemon execute: ',Result);
|
|
end;
|
|
|
|
function TTestDaemon.ShutDown: Boolean;
|
|
begin
|
|
Result:=inherited ShutDown;
|
|
AWriteln('Daemon Shutdown: ',Result);
|
|
FThread.Terminate;
|
|
end;
|
|
|
|
function TTestDaemon.Install: Boolean;
|
|
begin
|
|
Result:=inherited Install;
|
|
AWriteln('Daemon Install: ',Result);
|
|
end;
|
|
|
|
function TTestDaemon.UnInstall: boolean;
|
|
begin
|
|
Result:=inherited UnInstall;
|
|
AWriteln('Daemon UnInstall: ',Result);
|
|
end;
|
|
|
|
Type
|
|
|
|
{ TTestDaemonMapper }
|
|
|
|
TTestDaemonMapper = Class(TCustomDaemonMapper)
|
|
Constructor Create(AOwner : TComponent); override;
|
|
end;
|
|
|
|
{ TTestDaemonMapper }
|
|
|
|
constructor TTestDaemonMapper.Create(AOwner: TComponent);
|
|
|
|
Var
|
|
D : TDaemonDef;
|
|
|
|
begin
|
|
inherited Create(AOwner);
|
|
D:=DaemonDefs.Add as TDaemonDef;
|
|
D.DisplayName:='Test daemon';
|
|
D.Name:='TestDaemon';
|
|
D.DaemonClassName:='TTestDaemon';
|
|
D.WinBindings.ServiceType:=stWin32;
|
|
end;
|
|
|
|
begin
|
|
RegisterDaemonClass(TTestDaemon);
|
|
RegisterDaemonMapper(TTestDaemonMapper);
|
|
Application.Title:='Daemon test application';
|
|
Application.Run;
|
|
end.
|
|
|