Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement