freepascal.compiler/packages/fcl-base/examples/daemon.pp

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.Logger.Info(Format('Tick : %d',[C]));
  Until Terminated;
end;

Procedure AWriteln(MSg : String; B : Boolean);

begin
  Application.Logger.Info(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.