Advertisement
Guest User

Untitled

a guest
Jan 9th, 2013
121
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 3.05 KB | None | 0 0
  1. program daemon;
  2.  
  3. {$mode objfpc}{$H+}
  4. {$define usecthreads}
  5. {$apptype gui}
  6.  
  7. uses
  8.   {$IFDEF UNIX}{$IFDEF UseCThreads}
  9.   cthreads,
  10.   {$ENDIF}{$ENDIF}
  11.   sysutils,
  12.   Classes
  13.   { add your units here }, daemonapp;
  14.  
  15. Type
  16.  
  17.   { TTestDaemon }
  18.  
  19.   { TTestThread }
  20.  
  21.   TTestThread = Class(TThread)
  22.     Procedure Execute; override;
  23.   end;
  24.  
  25.   TTestDaemon = Class(TCustomDaemon)
  26.   Private
  27.     FThread : TTestThread;
  28.     Procedure ThreadStopped (Sender : TObject);
  29.   public
  30.     Function Start : Boolean; override;
  31.     Function Stop : Boolean; override;
  32.     Function Pause : Boolean; override;
  33.     Function Continue : Boolean; override;
  34.     Function Execute : Boolean; override;
  35.     Function ShutDown : Boolean; override;
  36.     Function Install : Boolean; override;
  37.     Function UnInstall: boolean; override;
  38.   end;
  39.  
  40. { TTestThread }
  41.  
  42. procedure TTestThread.Execute;
  43.  
  44. Var
  45.   C : Integer;
  46.  
  47. begin
  48.   C:=0;
  49.   Repeat
  50.     Sleep(1000);
  51.     inc(c);
  52.     Application.Log(etcustom,Format('Tick : %d',[C]));
  53.   Until Terminated;
  54. end;
  55.  
  56. Procedure AWriteln(MSg : String; B : Boolean);
  57.  
  58. begin
  59.   Application.Log(etcustom,Msg+BoolToStr(B));
  60. end;
  61.  
  62. { TTestDaemon }
  63.  
  64. procedure TTestDaemon.ThreadStopped(Sender: TObject);
  65. begin
  66.   FreeAndNil(FThread);
  67. end;
  68.  
  69. function TTestDaemon.Start: Boolean;
  70. begin
  71.   Result:=inherited Start;
  72.   AWriteln('Daemon Start',Result);
  73.   FThread:=TTestThread.Create(True);
  74.   FThread.OnTerminate:=@ThreadStopped;
  75.   FThread.FreeOnTerminate:=False;
  76.   FThread.Resume;
  77. end;
  78.  
  79. function TTestDaemon.Stop: Boolean;
  80. begin
  81.   Result:=inherited Stop;
  82.   AWriteln('Daemon Stop: ',Result);
  83.   FThread.Terminate;
  84. end;
  85.  
  86. function TTestDaemon.Pause: Boolean;
  87. begin
  88.   Result:=inherited Pause;
  89.   AWriteln('Daemon pause: ',Result);
  90.   FThread.Suspend;
  91. end;
  92.  
  93. function TTestDaemon.Continue: Boolean;
  94. begin
  95.   Result:=inherited Continue;
  96.   AWriteln('Daemon continue: ',Result);
  97.   FThread.Resume;
  98. end;
  99.  
  100. function TTestDaemon.Execute: Boolean;
  101. begin
  102.   Result:=inherited Execute;
  103.   AWriteln('Daemon execute: ',Result);
  104. end;
  105.  
  106. function TTestDaemon.ShutDown: Boolean;
  107. begin
  108.   Result:=inherited ShutDown;
  109.   AWriteln('Daemon Shutdown: ',Result);
  110.   FThread.Terminate;
  111. end;
  112.  
  113. function TTestDaemon.Install: Boolean;
  114. begin
  115.   Result:=inherited Install;
  116.   AWriteln('Daemon Install: ',Result);
  117. end;
  118.  
  119. function TTestDaemon.UnInstall: boolean;
  120. begin
  121.   Result:=inherited UnInstall;
  122.   AWriteln('Daemon UnInstall: ',Result);
  123. end;
  124.  
  125. Type
  126.  
  127.   { TTestDaemonMapper }
  128.  
  129.   TTestDaemonMapper = Class(TCustomDaemonMapper)
  130.     Constructor Create(AOwner : TComponent); override;
  131.   end;
  132.  
  133. { TTestDaemonMapper }
  134.  
  135. constructor TTestDaemonMapper.Create(AOwner: TComponent);
  136.  
  137. Var
  138.   D : TDaemonDef;
  139.  
  140. begin
  141.   inherited Create(AOwner);
  142.   D:=DaemonDefs.Add as TDaemonDef;
  143.   D.DisplayName:='Test daemon';
  144.   D.Name:='TestDaemon';
  145.   D.DaemonClassName:='TTestDaemon';
  146.   D.WinBindings.ServiceType:=stWin32;
  147. end;
  148.  
  149. begin
  150.   RegisterDaemonClass(TTestDaemon);
  151.   RegisterDaemonMapper(TTestDaemonMapper);
  152.   Application.Title:='Daemon test application';
  153.   Application.Run;
  154. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement