* Support for Daemon applications

git-svn-id: trunk@6278 -

.gitattributes

@@ -881,6 +881,7 @@ fcl/inc/cachecls.pp svneol=native#text/plain
 fcl/inc/cgiapp.pp svneol=native#text/plain
 fcl/inc/contnrs.pp svneol=native#text/plain
 fcl/inc/custapp.pp svneol=native#text/plain
+fcl/inc/daemonapp.pp svneol=native#text/plain
 fcl/inc/dbugintf.pp svneol=native#text/plain
 fcl/inc/dbugmsg.pp svneol=native#text/plain
 fcl/inc/eventlog.pp svneol=native#text/plain
@@ -999,6 +1000,7 @@ fcl/tests/b64test.pp svneol=native#text/plain
 fcl/tests/b64test2.pp svneol=native#text/plain
 fcl/tests/cachetest.pp svneol=native#text/plain
 fcl/tests/cfgtest.pp svneol=native#text/plain
+fcl/tests/daemon.pp svneol=native#text/plain
 fcl/tests/dbugsrv.pp svneol=native#text/plain
 fcl/tests/debugtest.pp svneol=native#text/plain
 fcl/tests/doecho.pp svneol=native#text/plain
@@ -1071,6 +1073,7 @@ fcl/tests/txmlreg.pp svneol=native#text/plain
 fcl/tests/xmldump.pp svneol=native#text/plain
 fcl/unix/asyncio.inc svneol=native#text/plain
 fcl/unix/asyncioh.inc svneol=native#text/plain
+fcl/unix/daemonapp.inc svneol=native#text/plain
 fcl/unix/eventlog.inc svneol=native#text/plain
 fcl/unix/pipes.inc svneol=native#text/plain
 fcl/unix/process.inc svneol=native#text/plain
@@ -1095,6 +1098,7 @@ fcl/web/websession.pp svneol=native#text/plain
 fcl/web/webutil.pp svneol=native#text/plain
 fcl/web/wtagsimpl.inc svneol=native#text/plain
 fcl/web/wtagsintf.inc svneol=native#text/plain
+fcl/win/daemonapp.inc svneol=native#text/plain
 fcl/win/eventlog.inc svneol=native#text/plain
 fcl/win/fclel.mc -text
 fcl/win/fclel.rc -text

fcl/Makefile.fpc

@@ -42,16 +42,16 @@ units=contnrs inifiles ezcgi pipes rtfpars idea base64 gettext \
       iostream zstream cachecls avl_tree htmldefs testutils fpcunit \
       eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream \
       streamex blowfish zipper streamio inicol pooledmm libtar streamcoll \
-      xmlreg registry 
-units_freebsd=process ssockets resolve fpasync syncobjs simpleipc dbugmsg dbugintf
-units_darwin=process ssockets resolve fpasync syncobjs simpleipc dbugmsg dbugintf
-units_solaris=process ssockets resolve fpasync syncobjs simpleipc dbugmsg dbugintf
-units_netbsd=process ssockets resolve fpasync simpleipc dbugmsg dbugintf
-units_openbsd=process ssockets resolve fpasync simpleipc dbugmsg dbugintf
-units_linux=process resolve ssockets fpasync syncobjs simpleipc dbugmsg dbugintf
-units_win32=process fileinfo resolve ssockets syncobjs simpleipc dbugmsg dbugintf
-units_win64=process fileinfo resolve ssockets syncobjs simpleipc dbugmsg dbugintf
-units_wince=process fileinfo resolve ssockets syncobjs simpleipc dbugmsg dbugintf
+      xmlreg registry
+units_freebsd=process ssockets resolve fpasync syncobjs simpleipc dbugmsg dbugintf daemonapp
+units_darwin=process ssockets resolve fpasync syncobjs simpleipc dbugmsg dbugintf daemonapp
+units_solaris=process ssockets resolve fpasync syncobjs simpleipc dbugmsg dbugintf daemonapp
+units_netbsd=process ssockets resolve fpasync simpleipc dbugmsg dbugintf daemonapp
+units_openbsd=process ssockets resolve fpasync simpleipc dbugmsg dbugintf daemonapp
+units_linux=process resolve ssockets fpasync syncobjs simpleipc dbugmsg dbugintf daemonapp
+units_win32=process fileinfo resolve ssockets syncobjs simpleipc dbugmsg dbugintf daemonapp
+units_win64=process fileinfo resolve ssockets syncobjs simpleipc dbugmsg dbugintf daemonapp
+units_wince=process fileinfo resolve ssockets syncobjs simpleipc dbugmsg dbugintf daemonapp
 units_os2=resolve ssockets
 units_emx=resolve ssockets
 units_netware=resolve ssockets

fcl/inc/daemonapp.pp

@@ -0,0 +1,1340 @@
+unit daemonapp;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Custapp, Classes, SysUtils, eventlog, rtlconsts;
+  
+Type
+  TCustomDaemon = Class;
+  TDaemonController = Class;
+
+  TDaemonEvent = procedure(Sender: TCustomDaemon) of object;
+  TDaemonOKEvent = procedure(Sender: TCustomDaemon; var OK: Boolean) of object;
+  
+  TDaemonOption = (doAllowStop,doAllowPause,doInteractive);
+  TDaemonOptions = Set of TDaemonOption;
+
+  TDaemonRunMode = (drmUnknown,drmInstall,drmUninstall,drmRun);
+  
+  { TCustomDaemonDescription }
+  TDaemonDef = Class;
+  TCurrentStatus =
+    (csStopped, csStartPending, csStopPending, csRunning,
+     csContinuePending, csPausePending, csPaused);
+
+  TCustomDaemon = Class(TDataModule)
+  private
+    FController: TDaemonController;
+    FDaemonDef: TDaemonDef;
+    FThread : TThread;
+    FStatus: TCurrentStatus;
+    function GetLogger: TEventLog;
+    procedure SetStatus(const AValue: TCurrentStatus);
+  Protected
+    Function Start : Boolean; virtual;
+    Function Stop : Boolean; virtual;
+    Function Pause : Boolean; virtual;
+    Function Continue : Boolean; virtual;
+    Function Execute : Boolean; virtual;
+    Function ShutDown : Boolean; virtual;
+    Function Install : Boolean; virtual;
+    Function UnInstall: boolean; virtual;
+    Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
+  Public
+    Procedure LogMessage(Msg : String);
+    Procedure ReportStatus;
+    
+    // Filled in at runtime by controller
+    Property Definition : TDaemonDef Read FDaemonDef;
+    Property DaemonThread : TThread Read FThread;
+    Property Controller : TDaemonController Read FController;
+    Property Status : TCurrentStatus Read FStatus Write SetStatus;
+    Property Logger : TEventLog Read GetLogger;
+  end;
+
+  TCustomDaemonClass = Class of TCustomDaemon;
+
+  { TDaemon }
+  TCustomControlCodeEvent = Procedure(Sender : TCustomDaemon; ACode : DWord; Var Handled : Boolean) of object;
+
+  TDaemon = Class(TCustomDaemon)
+  private
+    FAfterInstall: TDaemonEvent;
+    FAfterUnInstall: TDaemonEvent;
+    FBeforeInstall: TDaemonEvent;
+    FBeforeUnInstall: TDaemonEvent;
+    FOnContinue: TDaemonOKEvent;
+    FOnCustomControl: TCustomControlCodeEvent;
+    FOnExecute: TDaemonEvent;
+    FOnPause: TDaemonOKEvent;
+    FOnShutDown: TDaemonEvent;
+    FOnStart: TDaemonOKEvent;
+    FOnStop: TDaemonOKEvent;
+  Protected
+    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;
+    Function HandleCustomCode(ACode : DWord) : Boolean; Override;
+  Public
+    Property Definition;
+    Property Status;
+  Published
+    Property OnStart : TDaemonOKEvent Read FOnStart Write FOnStart;
+    Property OnStop : TDaemonOKEvent Read FOnStop Write FOnStop;
+    Property OnPause : TDaemonOKEvent Read FOnPause Write FOnPause;
+    Property OnContinue : TDaemonOKEvent Read FOnContinue Write FOnContinue;
+    Property OnShutDown : TDaemonEvent Read FOnShutDown Write FOnShutDown;
+    Property OnExecute : TDaemonEvent Read FOnExecute Write FOnExecute;
+    Property BeforeInstall : TDaemonEvent Read FBeforeInstall Write FBeforeInstall;
+    Property AfterInstall : TDaemonEvent Read FAfterInstall Write FAfterInstall;
+    Property BeforeUnInstall : TDaemonEvent Read FBeforeUnInstall Write FBeforeUnInstall;
+    Property AfterUnInstall : TDaemonEvent Read FAfterUnInstall Write FAfterUnInstall;
+    Property OnControlCode : TCustomControlCodeEvent Read FOnCustomControl Write FOnCustomControl;
+  end;
+
+  { TDaemonController }
+
+  TDaemonController = Class(TComponent)
+  Private
+    FDaemon : TCustomDaemon;
+    FLastStatus: TCurrentStatus;
+    FSysData : TObject;
+    FParams : TStrings;
+    FCheckPoint : DWord;
+    procedure ThreadTerminated(Sender: TObject);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure StartService; virtual;
+    Procedure Main(Argc : DWord; Args : PPChar); Virtual;
+    Procedure Controller(ControlCode,EventType : DWord; EventData : Pointer); Virtual;
+    Function ReportStatus : Boolean; virtual;
+    Property Daemon : TCustomDaemon Read FDaemon;
+    Property Params : TStrings Read FParams;
+    Property LastStatus : TCurrentStatus Read FLastStatus;
+    Property CheckPoint : DWord;
+  end;
+  
+  TDaemonClass = Class of TDaemon;
+  
+  { Windows specific service registration types }
+  
+  TServiceType   = (stWin32, stDevice, stFileSystem);
+  TErrorSeverity = (esIgnore, esNormal, esSevere, esCritical);
+  TStartType     = (stBoot, stSystem, stAuto, stManual, stDisabled);
+  
+  { TDependency }
+
+  TDependency = class(TCollectionItem)
+  private
+    FName: String;
+    FIsGroup: Boolean;
+  protected
+    function GetDisplayName: string; override;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  published
+    property Name: String read FName write FName;
+    property IsGroup: Boolean read FIsGroup write FIsGroup;
+  end;
+  
+  { TDependencies }
+
+  TDependencies = class(TCollection)
+  private
+    FOwner: TPersistent;
+    function GetItem(Index: Integer): TDependency;
+    procedure SetItem(Index: Integer; Value: TDependency);
+  protected
+    function GetOwner: TPersistent; override;
+  public
+    constructor Create(AOwner: TPersistent);
+    property Items[Index: Integer]: TDependency read GetItem write SetItem; default;
+  end;
+
+
+  { TWinBindings }
+
+  TWinBindings = class(TPersistent)
+  private
+    FDependencies: TDependencies;
+    FErrCode: DWord;
+    FErrorSeverity: TErrorSeverity;
+    FLoadGroup: String;
+    FPassWord: String;
+    FServiceType: TServiceType;
+    FStartType: TStartType;
+    FTagID: DWord;
+    FUserName: String;
+    FWaitHint: Integer;
+    FWin32ErrorCode: DWord;
+    procedure SetDependencies(const AValue: TDependencies);
+  Public
+    Constructor Create;
+    Destructor Destroy; override;
+    Procedure Assign(Source : TPersistent); override;
+    property ErrCode: DWord read FErrCode write FErrCode;
+    property Win32ErrCode: DWord read FWin32ErrorCode write FWin32ErrorCode;
+  Published
+    Property Dependencies : TDependencies Read FDependencies Write SetDependencies;
+    Property GroupName : String Read FLoadGroup Write FLoadGroup;
+    Property Password : String Read FPassWord Write FPassword;
+    Property UserName : String Read FUserName Write FUserName;
+    Property StartType : TStartType Read FStartType Write FStartType;
+    Property WaitHint : Integer Read FWaitHint Write FWaitHint;
+    Property IDTag : DWord Read FTagID Write FTagID;
+    Property ServiceType : TServiceType Read FServiceType Write FServiceType;
+    Property ErrorSeverity : TErrorSeverity Read FErrorSeverity Write FErrorSeverity;
+  end;
+
+  { TDaemonDef }
+  
+  TDaemonDef = Class(TCollectionItem)
+  private
+    FDaemonClass: TCustomDaemonClass;
+    FDaemonClassName: String;
+    FDescription: String;
+    FDisplayName: String;
+    FEnabled: Boolean;
+    FInstance: TCustomDaemon;
+    FLogStatusReport: Boolean;
+    FName: String;
+    FOnCreateInstance: TNotifyEvent;
+    FOptions: TDaemonOptions;
+    FServiceName: String;
+    FWinBindings: TWinBindings;
+    procedure SetName(const AValue: String);
+    procedure SetWinBindings(const AValue: TWinBindings);
+  Protected
+    function GetDisplayName: string; override;
+  Public
+    Constructor Create(ACollection : TCollection); override;
+    Destructor Destroy; override;
+    Property DaemonClass : TCustomDaemonClass read FDaemonClass;
+    Property Instance : TCustomDaemon Read FInstance Write FInstance;
+  Published
+    Property DaemonClassName : String Read FDaemonClassName Write FDaemonClassName;
+    Property Name : String Read FName Write SetName;
+    Property DisplayName : String Read FDisplayName Write FDisplayName;
+    Property Options : TDaemonOptions Read FOptions Write FOptions;
+    Property Enabled : Boolean Read FEnabled Write FEnabled default true;
+    Property WinBindings : TWinBindings Read FWinBindings Write SetWinBindings;
+    Property OnCreateInstance : TNotifyEvent Read FOnCreateInstance Write FOnCreateInstance;
+    Property LogStatusReport : Boolean Read FLogStatusReport Write FLogStatusReport;
+  end;
+
+  { TDaemonDefs }
+
+  TDaemonDefs = Class(TCollection)
+    FOwner : TPersistent;
+  private
+    function GetDaemonDef(Index : Integer): TDaemonDef;
+    procedure SetDaemonDef(Index : Integer; const AValue: TDaemonDef);
+  Protected
+    Procedure BindClasses;
+    Function GetOwner : TPersistent; override;
+  Public
+    Constructor Create(AOwner : TPersistent; AClass : TCollectionItemClass);
+    Function IndexOfDaemonDef(Const DaemonName : String) : Integer;
+    Function FindDaemonDef(Const DaemonName : String) : TDaemonDef;
+    Function DaemonDefByName(Const DaemonName : String) : TDaemonDef;
+    Property Daemons[Index : Integer] : TDaemonDef Read GetDaemonDef Write SetDaemonDef; default;
+  end;
+  
+  { TCustomDaemonMapper }
+  TCustomDaemonMapper = Class(TComponent)
+  private
+    FDaemonDefs: TDaemonDefs;
+    FOnCreate: TNotifyEvent;
+    FOnDestroy: TNotifyEvent;
+    FOnInstall: TNotifyEvent;
+    FOnRun: TNotifyEvent;
+    FOnUnInStall: TNotifyEvent;
+    procedure SetDaemonDefs(const AValue: TDaemonDefs);
+  Protected
+    Procedure CreateDefs; virtual;
+    Procedure DoOnCreate; virtual;
+    Procedure DoOnDestroy; virtual;
+    Procedure DoOnInstall; virtual;
+    Procedure DoOnUnInstall; virtual;
+    Procedure DoOnRun; virtual;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property DaemonDefs : TDaemonDefs Read FDaemonDefs Write SetDaemonDefs;
+    Property OnCreate : TNotifyEvent Read FOnCreate Write FOnCreate;
+    Property OnDestroy : TNotifyEvent Read FOnDestroy Write FOnDestroy;
+    Property OnRun : TNotifyEvent Read FOnRun Write FOnRun;
+    Property OnInstall : TNotifyEvent Read FOnInstall Write FOnInstall;
+    Property OnUnInstall : TNotifyEvent Read FOnUnInStall Write FOnUninStall;
+  end;
+  
+  { TDaemonMapper }
+
+  TDaemonMapper = Class(TCustomDaemonMapper)
+    Constructor Create(AOwner : TComponent); override;
+    Constructor CreateNew(AOwner : TComponent; Dummy : Integer = 0);
+  end;
+  
+  TCustomDaemonMapperClass = Class of TCustomDaemonMapper;
+  
+  { TDaemonThread }
+
+  TDaemonThread = Class(TThread)
+  Private
+    FDaemon : TCustomDaemon;
+  Protected
+    procedure StartServiceExecute; virtual;
+    procedure HandleControlCode(ACode : DWord); virtual;
+  Public
+    Constructor Create(ADaemon : TCustomDaemon);
+    Procedure Execute; override;
+    Procedure CheckControlMessage(WaitForMessage : Boolean);
+    Function StopDaemon : Boolean; virtual;
+    Function PauseDaemon : Boolean; virtual;
+    Function ContinueDaemon : Boolean; virtual;
+    Function ShutDownDaemon : Boolean; virtual;
+    Function InterrogateDaemon : Boolean; virtual;
+    Property Daemon : TCustomDaemon Read FDaemon;
+  end;
+
+  { TCustomDaemonApplication }
+  TGuiLoopEvent = Procedure Of Object;
+  
+  TCustomDaemonApplication = Class(TCustomApplication)
+  private
+    FGUIHandle: THandle;
+    FGUIMainLoop: TGuiLoopEvent;
+    FLogger: TEventLog;
+    FMapper : TCustomDaemonMapper;
+    FOnRun: TNotifyEvent;
+    FRunMode: TDaemonRunMode;
+    FSysData: TObject;
+    FControllerCount : Integer;
+    procedure BindDaemonDefs(AMapper: TCustomDaemonMapper);
+    function  InstallRun: Boolean;
+    procedure SysInstallDaemon(Daemon: TCustomDaemon);
+    procedure SysUnInstallDaemon(Daemon: TCustomDaemon);
+    function  UnInstallRun: Boolean;
+    function  RunDaemonsRun: Boolean;
+    Procedure Main(Argc : DWord; Args : PPchar);
+    Function  RunGUIloop(P : Pointer) : integer;
+  Protected
+    // OS (System) dependent calls
+    Procedure SysStartUnInstallDaemons;
+    Procedure SysEndUnInstallDaemons;
+    Procedure SysStartInstallDaemons;
+    Procedure SysEndInstallDaemons;
+    Procedure SysStartRunDaemons;
+    Procedure SysEndRunDaemons;
+
+    // Customizable behaviour
+    procedure CreateDaemonController(Var AController : TDaemonController); virtual;
+    Procedure CreateServiceMapper(Var AMapper : TCustomDaemonMapper); virtual;
+    Procedure RemoveController(AController : TDaemonController); virtual;
+    procedure SetupLogger;
+    procedure StopLogger;
+    Procedure DoRun; override;
+    Property  OnRun : TNotifyEvent Read FOnRun Write FOnRun;
+    Property SysData : TObject Read FSysData Write FSysData;
+  Public
+    Procedure ShowException(E : Exception); override;
+    Function CreateDaemon(DaemonDef : TDaemonDef) : TCustomDaemon;
+    Procedure StopDaemons(Force : Boolean);
+    procedure InstallDaemons;
+    procedure RunDaemons;
+    procedure UnInstallDaemons;
+    procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
+    Property Logger : TEventLog Read FLogger;
+    Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
+    Property GuiHandle : THandle Read FGUIHandle Write FGUIHandle;
+    Property RunMode : TDaemonRunMode Read FRunMode;
+  end;
+  
+  TDaemonApplication = Class(TCustomDaemonApplication)
+  end;
+
+  EDaemon = Class(Exception);
+
+Function Application : TCustomDaemonApplication;
+Procedure RegisterDaemonMapper(AMapperClass : TCustomDaemonMapperClass);
+Procedure RegisterDaemonClass(AClass : TCustomDaemonClass);
+Procedure DaemonError(Msg : String);
+Procedure DaemonError(Fmt : String; Args : Array of const);
+
+
+Resourcestring
+  SErrNoServiceMapper           = 'No daemon mapper class registered.';
+  SErrOnlyOneMapperAllowed      = 'Not changing daemon mapper class %s with %s: Only 1 mapper allowed.';
+  SErrNothingToDo               = 'Options do not allow determining what needs to be done.';
+  SErrDuplicateName             = 'Duplicate daemon name: %s';
+  SErrUnknownDaemonClass        = 'Unknown daemon class name: %s';
+  SErrDaemonStartFailed         = 'Failed to start daemon %s : %s';
+  SDaemonStatus                 = 'Daemon %s current status: %s';
+  SControlFailed                = 'Control code %s handling failed: %s';
+  SCustomCode                   = '[Custom code %d]';
+  SErrServiceManagerStartFailed = 'Failed to start service manager: %s';
+  SErrNoDaemonForStatus         = '%s: No daemon for status report';
+  SErrNoDaemonDefForStatus      = '%s: No daemon definition for status report';
+  SErrWindowClass               = 'Could not register window class';
+
+{ $define svcdebug}
+
+{$ifdef svcdebug}
+Procedure DebugLog(Msg : String);
+{$endif}
+
+Var
+  CurrentStatusNames : Array[TCurrentStatus] of string =
+    ('Stopped', 'Start Pending', 'Stop Pending', 'Running',
+     'Continue Pending', 'Pause Pending', 'Paused');
+  SStatus : Array[1..5] of string =
+    ('Stop','Pause','Continue','Interrogate','Shutdown');
+  DefaultDaemonOptions : TDaemonOptions =  [doAllowStop,doAllowPause];
+  
+implementation
+
+// This must come first, so a uses clause can be added.
+{$i daemonapp.inc}
+
+Var
+  AppInstance  : TCustomDaemonApplication;
+  MapperClass  : TCustomDaemonMapperClass;
+  DesignMapper : TCustomDaemonMapper;
+  DaemonClasses : TStringList;
+
+{$ifdef svcdebug}
+Var
+  FL : Text;
+  LCS : TRTLCriticalSection;
+  
+Procedure StartLog;
+
+begin
+{$ifdef win32}
+  Assign(FL,'c:\service.log');
+{$else}
+  Assign(FL,'/tmp/service.log');
+{$endif}
+  Rewrite(FL);
+  InitCriticalSection(LCS);
+  DebugLog('Start logging');
+end;
+
+Procedure DebugLog(Msg : String);
+begin
+  EnterCriticalSection(LCS);
+  try
+    Writeln(FL,Msg);
+    Flush(FL);
+  Finally
+    LeaveCriticalSection(LCS);
+  end;
+end;
+
+Procedure EndLog;
+
+begin
+  DebugLog('Done logging');
+  Close(FL);
+  DoneCriticalSection(LCS);
+end;
+{$endif svcdebug}
+
+Procedure RegisterDaemonClass(AClass : TCustomDaemonClass);
+
+Var
+  DN : String;
+  I  : Integer;
+  
+begin
+  If Not Assigned(DaemonClasses) then
+    begin
+    DaemonClasses:=TStringList.Create;
+    DaemonClasses.Sorted:=True;
+    end;
+  DN:=AClass.ClassName;
+  I:=DaemonClasses.IndexOf(DN);
+  If (I=-1) then
+    I:=DaemonClasses.Add(DN);
+  DaemonClasses.Objects[I]:=TObject(AClass);
+end;
+
+Procedure CreateDaemonApplication;
+
+begin
+  AppInstance:=TDaemonApplication.Create(Nil);
+end;
+
+Procedure DoneDaemonApplication;
+
+begin
+  FreeAndNil(AppInstance);
+  FreeAndNil(DaemonClasses);
+end;
+
+function Application: TCustomDaemonApplication;
+begin
+  If (AppInstance=Nil) then
+    CreateDaemonApplication;
+  Result:=AppInstance;
+end;
+
+Procedure RegisterDaemonMapper(AMapperClass : TCustomDaemonMapperClass);
+
+begin
+  If Assigned(MapperClass) then
+    DaemonError(SErrOnlyOneMapperAllowed,[MapperClass.ClassName,AMapperClass.ClassName]);
+  MapperClass:=AMapperClass;
+end;
+
+procedure DaemonError(Msg: String);
+begin
+  Raise EDaemon.Create(MSg);
+end;
+
+procedure DaemonError(Fmt: String; Args: array of const);
+begin
+  Raise EDaemon.CreateFmt(Fmt,Args);
+end;
+
+{ TDaemon }
+
+function TDaemon.Start: Boolean;
+begin
+  Result:=inherited Start;
+  If assigned(FOnStart) then
+    FOnStart(Self,Result);
+end;
+
+function TDaemon.Stop: Boolean;
+begin
+  Result:=inherited Start;
+  If assigned(FOnStop) then
+    FOnStop(Self,Result);
+end;
+
+function TDaemon.Pause: Boolean;
+begin
+  Result:=inherited Start;
+  If assigned(FOnPause) then
+    FOnPause(Self,Result);
+end;
+
+function TDaemon.Continue: Boolean;
+begin
+  Result:=inherited Continue;
+  If assigned(FOnContinue) then
+    FOnContinue(Self,Result);
+end;
+
+function TDaemon.Execute: Boolean;
+begin
+  Result:=Assigned(FOnExecute);
+  If Result Then
+    FOnExecute(Self);
+end;
+
+function TDaemon.ShutDown: Boolean;
+begin
+  Result:=Inherited ShutDown;
+  If Assigned(FOnShutDown) then
+    FOnShutDown(Self);
+end;
+
+function TDaemon.Install: Boolean;
+begin
+  If Assigned(FBeforeInstall) then
+    FBeforeInstall(Self);
+  Result:=inherited Install;
+  If Assigned(FAfterInstall) then
+    FAfterInstall(Self)
+end;
+
+function TDaemon.UnInstall: boolean;
+begin
+  If Assigned(FBeforeUnInstall) then
+    FBeforeUnInstall(Self);
+  Result:=inherited UnInstall;
+  If Assigned(FAfterUnInstall) then
+    FAfterUnInstall(Self)
+end;
+
+function TDaemon.HandleCustomCode(ACode: DWord): Boolean;
+begin
+  Result:=Assigned(FOnCustomControl);
+  If Result then
+    FOnCustomControl(Self,ACode,Result);
+end;
+
+{ TCustomDaemon }
+
+Function TCustomDaemon.Start : Boolean;
+
+begin
+  Result:=True;
+end;
+
+Function  TCustomDaemon.Stop : Boolean;
+begin
+  Result:=True;
+end;
+
+Function TCustomDaemon.Pause : Boolean;
+begin
+  Result:=True;
+end;
+
+Function TCustomDaemon.Continue : Boolean;
+begin
+  Result:=True;
+end;
+
+function TCustomDaemon.Execute: Boolean;
+begin
+  Result:=False;
+end;
+
+Function TCustomDaemon.ShutDown : Boolean;
+begin
+  Result:=True;
+end;
+
+Procedure TCustomDaemon.ReportStatus;
+begin
+  Controller.ReportStatus;
+end;
+
+
+
+procedure TCustomDaemon.LogMessage(Msg: String);
+begin
+  Application.Logger.Error(Msg);
+end;
+
+function TCustomDaemon.GetLogger: TEventLog;
+begin
+  Result:=Application.Logger;
+end;
+
+procedure TCustomDaemon.SetStatus(const AValue: TCurrentStatus);
+begin
+  FStatus:=AValue;
+  Controller.ReportStatus;
+end;
+
+Function TCustomDaemon.Install : Boolean;
+begin
+  Result:=True;
+end;
+
+
+Function TCustomDaemon.UnInstall : Boolean;
+begin
+  Result:=True;
+end;
+
+function TCustomDaemon.HandleCustomCode(ACode: DWord): Boolean;
+begin
+  Result:=False
+end;
+
+{ TCustomServiceApplication }
+
+
+procedure TCustomDaemonApplication.CreateServiceMapper(Var AMapper : TCustomDaemonMapper);
+
+begin
+  AMapper:=MapperClass.Create(Self);
+  BindDaemonDefs(Amapper);
+end;
+
+procedure TCustomDaemonApplication.BindDaemonDefs(AMapper : TCustomDaemonMapper);
+
+begin
+  AMApper.DaemonDefs.BindClasses;
+end;
+
+procedure TCustomDaemonApplication.CreateDaemonController(Var AController : TDaemonController);
+
+begin
+  ACOntroller:=TDaemonController.Create(Self);
+end;
+
+Function TCustomDaemonApplication.RunDaemonsRun : Boolean;
+
+begin
+  Result:=HasOption('r','run');
+  // No Borland compatibility needed, as the install will take care of the -r
+end;
+
+procedure TCustomDaemonApplication.Main(Argc: DWord; Args: PPchar);
+
+Var
+  SN : String;
+  DD : TDaemonDef;
+  
+begin
+  If (Args=Nil) then
+    Exit;
+  SN:=StrPas(Args^);
+  DD:=FMapper.DaemonDefs.FindDaemonDef(SN);
+  If (DD<>Nil) then
+    DD.Instance.Controller.Main(Argc,Args);
+end;
+
+
+Function TCustomDaemonApplication.InstallRun : Boolean;
+
+begin
+  Result:=HasOption('i','install');
+  // Borland compatibility.
+  If not Result then
+    Result:=FindCmdLineSwitch ('install',['/'],True);
+end;
+
+
+
+Function TCustomDaemonApplication.UnInstallRun : Boolean;
+
+begin
+  Result:=HasOption('u','uninstall');
+  // Borland compatibility.
+  If not Result then
+    Result:=FindCmdLineSwitch ('uninstall',['/'],True);
+end;
+
+
+
+Procedure TCustomDaemonApplication.InstallDaemons;
+
+Var
+  D : TCustomDaemon;
+  DD : TDaemonDef;
+  C : TDaemonController;
+  I : Integer;
+
+begin
+  FrunMode:=drmInstall;
+  SysStartInstallDaemons;
+  try
+    FMapper.DoOnInstall;
+    For I:=0 to FMapper.DaemonDefs.Count-1 do
+      begin
+      DD:=FMapper.DaemonDefs[i];
+      If DD.Enabled then
+        begin
+        D:=CreateDaemon(DD);
+        Try
+          // Need to call this because of the before/after events.
+          D.Install;
+        Finally
+          D.Free;
+        end;
+        end;
+      end;
+  Finally
+    SysEndInstallDaemons;
+  end;
+end;
+
+Procedure TCustomDaemonApplication.UnInstallDaemons;
+
+Var
+  D : TCustomDaemon;
+  DD : TDaemonDef;
+  I : Integer;
+
+begin
+  FrunMode:=drmUnInstall;
+  SysStartUnInstallDaemons;
+  Try
+    FMapper.DoOnUnInstall;
+    // Uninstall in reverse order. One never knows.
+    For I:=FMapper.DaemonDefs.Count-1 downto 0 do
+      begin
+      DD:=FMapper.DaemonDefs[i];
+      If DD.Enabled then
+        begin
+        D:=CreateDaemon(FMapper.DaemonDefs[i]);
+        Try
+          // Need to call this because of the before/after events.
+          D.UnInstall;
+        Finally
+          D.Free;
+        end;
+        end;
+      end;
+  Finally
+    SysEndUnInstallDaemons;
+  end;
+end;
+
+procedure TCustomDaemonApplication.CreateForm(InstanceClass: TComponentClass;
+  var Reference);
+  
+Var
+  Instance: TComponent;
+  
+begin
+  // Allocate the instance, without calling the constructor
+  Instance := TComponent(InstanceClass.NewInstance);
+  // set the Reference before the constructor is called, so that
+  // events and constructors can refer to it
+  TComponent(Reference) := Instance;
+  try
+    Instance.Create(Self);
+  except
+    TComponent(Reference) := nil;
+    Raise;
+  end;
+end;
+
+Procedure TCustomDaemonApplication.RunDaemons;
+
+Var
+  D : TCustomDaemon;
+  DD : TDaemonDef;
+  I : Integer;
+
+begin
+  FRunMode:=drmRun;
+  SysStartRunDaemons;
+  FMapper.DoOnRun;
+  For I:=0 to FMapper.DaemonDefs.Count-1 do
+    begin
+    DD:=FMapper.DaemonDefs[i];
+    If DD.Enabled then
+      D:=CreateDaemon(FMapper.DaemonDefs[i]);
+    end;
+  try
+    SysEndRunDaemons;
+  except
+    HandleException(Self);
+    Terminate;
+  end;
+end;
+
+procedure TCustomDaemonApplication.SetupLogger;
+
+begin
+  FLogger:=TEventlog.Create(Self);
+  FLogger.RegisterMessageFile('');
+end;
+
+procedure TCustomDaemonApplication.StopLogger;
+
+begin
+  Flogger.Active:=False;
+  FreeAndNil(Flogger);
+end;
+
+procedure TCustomDaemonApplication.DoRun;
+
+begin
+  SetupLogger;
+  Try
+    try
+      If Not Assigned(MapperClass) then
+        DaemonError(SErrNoServiceMapper);
+      CreateServiceMapper(FMapper);
+      If InstallRun then
+        InstallDaemons
+      else If UnInstallRun then
+        UnInstallDaemons
+      else if RunDaemonsRun then
+        RunDaemons
+      else if Assigned(OnRun) then
+       OnRun(Self)
+      else
+        DaemonError(SErrNothingToDo);
+      {$ifdef svcdebug}DebugLog('Terminating');{$endif svcdebug}
+      Terminate;
+      {$ifdef svcdebug}DebugLog('Terminated');{$endif svcdebug}
+    except
+      Terminate;
+      Raise
+    end;
+  Finally
+    StopLogger;
+  end;
+end;
+
+procedure TCustomDaemonApplication.ShowException(E: Exception);
+begin
+  If assigned(Flogger) then
+    FLogger.Error(E.Message)
+  else
+   inherited ShowException(E)
+end;
+
+
+function TCustomDaemonApplication.CreateDaemon(DaemonDef: TDaemonDef): TCustomDaemon;
+
+Var
+  C : TDaemonController;
+
+begin
+  Result:=DaemonDef.DaemonClass.CreateNew(Self,0);
+  CreateDaemonController(C);
+  C.FDaemon:=Result;
+  Result.FController:=C;
+  Result.FDaemonDef:=DaemonDef;
+  If (Daemondef.Instance=Nil) then
+    DaemonDef.Instance:=Result;
+end;
+
+procedure TCustomDaemonApplication.StopDaemons(Force: Boolean);
+
+Const
+  ControlCodes : Array[Boolean] of DWord
+               = (SERVICE_CONTROL_STOP,SERVICE_CONTROL_SHUTDOWN);
+
+Var
+  L : TFPList;
+  I : Integer;
+
+begin
+  L:=TFPList.Create;
+  try
+    For I:=0 to ComponentCount-1 do
+      If Components[i] is TDaemonController then
+        L.Add(Components[i]);
+    For I:=L.Count-1 downto 0 do
+      TDaemonController(L[i]).Controller(ControlCodes[Force],0,Nil);
+  finally
+    L.Free;
+  end;
+end;
+
+
+
+
+{ TDaemonDefs }
+
+function TDaemonDefs.GetDaemonDef(Index : Integer): TDaemonDef;
+begin
+  Result:=TDaemonDef(Items[index]);
+end;
+
+procedure TDaemonDefs.SetDaemonDef(Index : Integer; const AValue: TDaemonDef);
+begin
+  Items[Index]:=AValue;
+end;
+
+procedure TDaemonDefs.BindClasses;
+
+Var
+  D : TDaemonDef;
+  I,J : Integer;
+  
+begin
+  For I:=0 to Count-1 do
+    begin
+    D:=GetDaemonDef(I);
+    J:=DaemonClasses.IndexOf(D.DaemonClassName);
+    If (J=-1) then
+      DaemonError(SErrUnknownDaemonClass,[D.DaemonClassName])
+    else
+      D.FDaemonClass:=TCustomDaemonClass(DaemonClasses.Objects[J]);
+    end;
+
+end;
+
+function TDaemonDefs.GetOwner: TPersistent;
+begin
+  Result:=FOwner;
+end;
+
+constructor TDaemonDefs.Create(AOwner: TPersistent; AClass : TCollectionItemClass);
+begin
+  Inherited Create(AClass);
+  FOwner:=AOwner;
+  
+end;
+
+function TDaemonDefs.IndexOfDaemonDef(Const DaemonName: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (CompareText(GetDaemonDef(Result).Name,DaemonName)<>0) do
+    Dec(Result);
+end;
+
+function TDaemonDefs.FindDaemonDef(Const DaemonName: String): TDaemonDef;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfDaemonDef(DaemonName);
+  If I<>-1 then
+    Result:=GetDaemonDef(I)
+  else
+    Result:=Nil;
+end;
+
+function TDaemonDefs.DaemonDefByName(Const DaemonName: String): TDaemonDef;
+begin
+  Result:=FindDaemonDef(DaemonName);
+end;
+
+{ TDaemonDef }
+
+procedure TDaemonDef.SetName(const AValue: String);
+begin
+  If (AValue<>FName) then
+    begin
+    If (AValue<>'') and (Collection<>Nil)
+       and (Collection is TDaemonDefs)
+       and ((Collection as TDaemonDefs).IndexOfDaemonDef(AValue)<>-1) then
+      DaemonError(SErrDuplicateName,[Avalue]);
+    FName:=AValue;
+    end;
+end;
+
+procedure TDaemonDef.SetWinBindings(const AValue: TWinBindings);
+begin
+  FWinBindings.Assign(AValue);
+end;
+
+function TDaemonDef.GetDisplayName: string;
+begin
+  Result:=Name;
+end;
+
+constructor TDaemonDef.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FWinBindings:=TWinBindings.Create;
+  FEnabled:=True;
+  FOptions:=DefaultDaemonOptions;
+end;
+
+destructor TDaemonDef.Destroy;
+begin
+  FreeAndNil(FWinBindings);
+  inherited Destroy;
+end;
+
+{ TCustomDaemonMapper }
+
+procedure TCustomDaemonMapper.SetDaemonDefs(const AValue: TDaemonDefs);
+begin
+  if (FDaemonDefs=AValue) then
+    exit;
+  FDaemonDefs.Assign(AValue);
+end;
+
+procedure TCustomDaemonMapper.CreateDefs;
+begin
+  FDaemonDefs:=TDaemonDefs.Create(Self,TDaemonDef);
+end;
+
+procedure TCustomDaemonMapper.DoOnCreate;
+begin
+  If Assigned(FOnCreate) then
+    FOnCreate(Self);
+end;
+
+procedure TCustomDaemonMapper.DoOnDestroy;
+begin
+  If Assigned(FOnDestroy) then
+    FOnDestroy(Self);
+end;
+
+procedure TCustomDaemonMapper.DoOnInstall;
+begin
+  If Assigned(FOnInstall) then
+    FOnInstall(Self);
+end;
+
+procedure TCustomDaemonMapper.DoOnUnInstall;
+begin
+  If Assigned(FOnUnInstall) then
+    FOnUnInstall(Self);
+end;
+
+procedure TCustomDaemonMapper.DoOnRun;
+begin
+  If Assigned(FOnRun) then
+    FOnRun(Self);
+end;
+
+constructor TCustomDaemonMapper.Create(AOwner: TComponent);
+begin
+  CreateDefs; // First, otherwise streaming will fail.
+  inherited Create(AOwner);
+  DoOnCreate;
+end;
+
+destructor TCustomDaemonMapper.Destroy;
+begin
+  DoOnDestroy;
+  FreeAndNil(FDaemonDefs);
+  inherited Destroy;
+end;
+
+{ TDaemonThread }
+
+constructor TDaemonThread.Create(ADaemon: TCustomDaemon);
+begin
+  FDaemon:=ADAemon;
+  FDaemon.FThread:=Self;
+  FreeOnTerminate:=False;
+  Inherited Create(True);
+end;
+
+procedure TDaemonThread.Execute;
+
+begin
+  If FDaemon.Start then
+    begin
+    FDaemon.Status:=csRunning;
+    StartServiceExecute;
+    if not FDaemon.Execute then
+      begin
+      While Not Terminated do
+        CheckControlMessage(True);
+      CheckControlMessage(False);
+      end;
+    end;
+end;
+
+
+procedure TDaemonThread.HandleControlCode(ACode : DWord);
+
+Var
+  CS : TCurrentStatus;
+  CC,OK : Boolean;
+  S : String;
+
+begin
+  CS:=FDaemon.Status;
+  Try
+    OK:=True;
+    CC:=False;
+    Case ACode of
+      SERVICE_CONTROL_STOP        : OK:=StopDaemon;
+      SERVICE_CONTROL_PAUSE       : OK:=PauseDaemon;
+      SERVICE_CONTROL_CONTINUE    : OK:=ContinueDaemon;
+      SERVICE_CONTROL_SHUTDOWN    : OK:=ShutDownDaemon;
+      SERVICE_CONTROL_INTERROGATE : OK:=InterrogateDaemon;
+    else
+      CC:=True;
+      FDaemon.HandleCustomCode(ACode);
+    end;
+    If not OK then
+      FDaemon.Status:=CS;
+  Except
+    On E : Exception do
+      begin
+      // Shutdown MUST be done, in all other cases roll back status.
+      If (ACode<>SERVICE_CONTROL_SHUTDOWN) then
+        FDaemon.Status:=CS;
+      If (ACode in [1..5]) then
+        S:=SStatus[ACode]
+      else
+        S:=Format(SCustomCode,[ACode]);
+      Application.Logger.Error(SControlFailed,[S,E.Message]);
+      end;
+  end;
+end;
+
+function TDaemonThread.StopDaemon: Boolean;
+
+begin
+  FDaemon.Status:=csStopPending;
+  Result:=FDaemon.Stop;
+  If Result then
+    begin
+    FDaemon.Status:=csStopped;
+    Terminate;
+    end;
+end;
+
+function TDaemonThread.PauseDaemon: Boolean;
+begin
+  FDaemon.Status:=csPausePending;
+  Result:=FDaemon.Pause;
+  If Result then
+    begin
+    FDaemon.Status:=csPaused;
+    Suspend;
+    end;
+end;
+
+function TDaemonThread.ContinueDaemon: Boolean;
+begin
+  FDaemon.Status:=csContinuePending;
+  Result:=FDaemon.Continue;
+  If Result then
+    FDaemon.Status:=csRunning;
+end;
+
+function TDaemonThread.ShutDownDaemon: Boolean;
+begin
+  FDaemon.Status:=csStopPending;
+  Try
+    Result:=FDaemon.ShutDown;
+  except
+    FDaemon.Status:=csStopped;
+    Terminate;
+  end;
+end;
+
+Function TDaemonThread.InterrogateDaemon: Boolean;
+begin
+  FDaemon.ReportStatus;
+  Result:=True;
+end;
+
+{ ---------------------------------------------------------------------
+  TDaemonController - Global implementation
+  ---------------------------------------------------------------------}
+
+
+constructor TDaemonController.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FParams:=TStringList.Create;
+end;
+
+destructor TDaemonController.Destroy;
+begin
+  FreeAndNil(FSysData);
+  FreeAndNil(FParams);
+  inherited Destroy;
+end;
+
+
+
+{ TWinBindings }
+
+procedure TWinBindings.SetDependencies(const AValue: TDependencies);
+begin
+  if (FDependencies<>AValue) then
+    FDependencies.Assign(AValue);
+end;
+
+Constructor TWinBindings.Create;
+begin
+  FDependencies:=TDependencies.Create(Self);
+end;
+
+destructor TWinBindings.Destroy;
+begin
+  FreeAndNil(FDependencies);
+  inherited Destroy;
+end;
+
+procedure TWinBindings.Assign(Source: TPersistent);
+
+Var
+  WB : TWinBindings;
+
+begin
+  if Source is TWinBindings then
+    begin
+    WB:=Source as TWinBindings;
+    GroupName:=WB.GroupName;
+    Password:=WB.PassWord;
+    UserName:=WB.UserName;
+    StartType:=WB.StartType;
+    WaitHint:=WB.WaitHint;
+    IDTag:=WB.IDTag;
+    ServiceType:=WB.ServiceType;
+    ErrorSeverity:=WB.ErrorSeverity;
+    Dependencies.Assign(WB.Dependencies);
+    ErrCode:=WB.ErrCode;
+    Win32ErrCode:=WB.Win32ErrCode;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TDependency }
+
+function TDependency.GetDisplayName: string;
+begin
+  Result:=Name;
+end;
+
+procedure TDependency.Assign(Source: TPersistent);
+
+Var
+  D : TDependency;
+
+begin
+  if Source is TDependency then
+    begin
+    D:=Source as TDependency;
+    Name:=D.Name;
+    IsGroup:=D.IsGroup;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TDependencies }
+
+function TDependencies.GetItem(Index: Integer): TDependency;
+begin
+  Result:=TDependency(Inherited GetItem(Index));
+end;
+
+procedure TDependencies.SetItem(Index: Integer; Value: TDependency);
+begin
+  Inherited SetItem(Index,Value);
+end;
+
+function TDependencies.GetOwner: TPersistent;
+begin
+  Result:=FOwner;
+end;
+
+constructor TDependencies.Create(AOwner: TPersistent);
+begin
+  Inherited Create(TDependency);
+  FOwner:=AOwner;
+end;
+
+{ TDaemonMapper }
+
+constructor TDaemonMapper.Create(AOwner: TComponent);
+begin
+ CreateNew(AOwner,0);
+ if (ClassType<>TDaemonMapper) and not (csDesigning in ComponentState) then
+    begin
+    if not InitInheritedComponent(Self,TDaemonMapper) then
+      raise EStreamError.CreateFmt(SErrNoSTreaming, [ClassName]);
+    end;
+end;
+
+constructor TDaemonMapper.CreateNew(AOwner: TComponent; Dummy: Integer);
+begin
+  inherited Create(AOwner);
+end;
+
+Initialization
+{$ifdef svcdebug}
+  StartLog;
+{$endif}
+  SysInitDaemonApp;
+
+Finalization
+  SysDoneDaemonApp;
+  DoneDaemonApplication;
+{$ifdef svcdebug}
+  EndLog;
+{$endif}
+end.
+

fcl/tests/README

@@ -71,3 +71,4 @@ testzip.pp   Test for TZipper class (MVC)
 poolmm1.pp   Test for pooledmm (free) (MG)
 poolmm2.pp   Test for pooledmm (nonfree) (VS)
 testweb.pp   Test for fpcgi (MVC)
+daemon.pp    Test for daemonapp (MVC)

fcl/tests/daemon.pp

@@ -0,0 +1,155 @@
+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.
+

fcl/unix/daemonapp.inc

@@ -0,0 +1,189 @@
+{ System dependent service stuff }
+
+uses baseunix;
+
+{ ---------------------------------------------------------------------
+  TCustomDaemonApplication
+  ---------------------------------------------------------------------}
+Const
+  SERVICE_CONTROL_STOP                  = $00000001;
+  SERVICE_CONTROL_PAUSE                 = $00000002;
+  SERVICE_CONTROL_CONTINUE              = $00000003;
+  SERVICE_CONTROL_INTERROGATE           = $00000004;
+  SERVICE_CONTROL_SHUTDOWN              = $00000005;
+  
+function TCustomDaemonApplication.RunGUIloop(P: Pointer): integer;
+begin
+
+end;
+
+
+procedure TCustomDaemonApplication.SysInstallDaemon(Daemon: TCustomDaemon);
+begin
+
+end;
+
+procedure TCustomDaemonApplication.SysUnInstallDaemon(Daemon: TCustomDaemon);
+begin
+
+end;
+
+procedure TCustomDaemonApplication.SysStartUnInstallDaemons;
+begin
+
+end;
+
+procedure TCustomDaemonApplication.SysEndUnInstallDaemons;
+begin
+
+end;
+
+
+procedure TCustomDaemonApplication.SysStartInstallDaemons;
+begin
+
+end;
+
+procedure TCustomDaemonApplication.SysEndInstallDaemons;
+begin
+
+end;
+
+procedure TCustomDaemonApplication.SysStartRunDaemons;
+begin
+
+end;
+
+procedure TCustomDaemonApplication.SysEndRunDaemons;
+
+Var
+  I : Integer;
+  DC : TDaemonController;
+  
+begin
+  For I:=ComponentCount-1 downto 0 do
+    If Components[i] is TDaemoncontroller then
+      begin
+      DC:=Components[i] as TDaemoncontroller;
+      DC.Main(0,Nil); // Returns after starting thread.
+      end;
+  if Assigned(GUIMainLoop) then
+    GuiMainLoop
+  else
+    // Simply wait till everything terminates.
+    While Not Terminated do
+      fpPause;
+end;
+
+procedure TCustomDaemonApplication.RemoveController(
+  AController: TDaemonController);
+  
+Var
+  I : Integer;
+  HC : Boolean;
+  
+begin
+  FreeAndNil(AController.FDaemon);
+  AController.Free;
+end;
+
+
+{ ---------------------------------------------------------------------
+  TDaemonThread
+  ---------------------------------------------------------------------}
+
+procedure TDaemonThread.StartServiceExecute;
+begin
+
+end;
+
+procedure TDaemonThread.CheckControlMessage(WaitForMessage : Boolean);
+begin
+end;
+
+
+{ ---------------------------------------------------------------------
+  TDaemonController
+  ---------------------------------------------------------------------}
+
+procedure TDaemonController.StartService;
+begin
+  Main(0,Nil);
+end;
+
+procedure TDaemonController.Main(Argc: DWord; Args: PPChar);
+
+Var
+  T : TThread;
+
+begin
+  FDaemon.Status:=csStartPending;
+  Try
+    T:=TDaemonThread.Create(FDaemon);
+    T.FreeOnTerminate:=True;
+    T.Resume;
+    T.WaitFor;
+    FDaemon.FThread:=Nil;
+  except
+    On E : Exception do
+      FDaemon.Logmessage(Format(SErrDaemonStartFailed,[FDaemon.Definition.Name,E.Message]));
+  end;
+end;
+
+procedure TDaemonController.Controller(ControlCode, EventType: DWord;
+  EventData: Pointer);
+
+begin
+  // Send control code to daemon thread.
+end;
+
+function TDaemonController.ReportStatus: Boolean;
+
+Var
+  S : String;
+
+begin
+  S:='';
+  If Assigned(FDaemon) then
+    With FDaemon do
+      S:=Format(SDaemonStatus,[Definition.DisplayName,
+                               CurrentStatusNames[Status]]);
+  Application.Logger.Info(S);
+end;
+
+Procedure TDaemonController.ThreadTerminated(Sender : TObject);
+
+begin
+end;
+
+
+{ ---------------------------------------------------------------------
+  Global initialization/Finalization
+  ---------------------------------------------------------------------}
+
+Procedure DoShutDown(Sig : Longint; Info : PSigInfo; Context : PSigContext); cdecl;
+
+begin
+  Application.StopDaemons(True);
+  Application.Terminate;
+end;
+
+Procedure SysInitDaemonApp;
+
+Var
+  old,new : SigactionRec;
+
+begin
+  New.sa_handler:=@DoShutDown;
+  fpSigaction(SIGQUIT,@New,@Old);
+  fpSigaction(SIGTERM,@New,@Old);
+  fpSigaction(SIGINT,@New,@Old);
+end;
+
+
+Procedure SysDoneDaemonApp;
+
+begin
+end;
+
+

fcl/win/daemonapp.inc

@@ -0,0 +1,617 @@
+{ Win32 implementation of service application }
+
+uses windows,jwawinsvc;
+
+Const
+  CM_SERVICE_CONTROL_CODE = WM_USER+1;
+  
+Resourcestring
+  SErrRegisterHandler  = 'Could not register control handler, error code %d';
+  SErrNoControlContext = 'Not handling Control message without control context: (%d %d %d).';
+  SControlCodeReceived = 'Control message received: (%d %d %d).';
+
+function StartServiceCtrlDispatcher(lpServiceStartTable: LPSERVICE_TABLE_ENTRY): BOOL; stdcall; external 'advapi32.dll' name 'StartServiceCtrlDispatcherA';
+function RegisterServiceCtrlHandlerEx(lpServiceName: LPCSTR;lpHandlerProc: LPHANDLER_FUNCTION_EX; lpContext: LPVOID): SERVICE_STATUS_HANDLE; stdcall;external 'advapi32.dll' name 'RegisterServiceCtrlHandlerExA';
+function SetServiceStatus(hServiceStatus: SERVICE_STATUS_HANDLE; const lpServiceStatus: SERVICE_STATUS): BOOL; stdcall; external 'advapi32.dll' name 'SetServiceStatus';
+
+{ ---------------------------------------------------------------------
+  Win32 entry points
+  ---------------------------------------------------------------------}
+
+Function ServiceControlHandlerEntry(dwControl,dwEventType: DWord; lpEventData,lpContext : Pointer) : DWord; StdCall;
+
+begin
+  If (Nil<>lpContext) then
+    TDaemonController(lpContext).Controller(dwControl,dwEventType,lpEventData)
+  else
+    If Assigned(Application.Logger) then
+      Application.Logger.Error(SerrNoControlContext,[dwControl,dwEventType,ptrint(lpEventData)]);
+end;
+
+Procedure ServiceMainEntry(Argc : DWord; Args : Pchar); stdcall;
+
+begin
+  If Assigned(Application) then
+    Application.Main(Argc,PPChar(Args));
+{$ifdef svcdebug}Debuglog('Main end');{$endif}
+end;
+
+{ ---------------------------------------------------------------------
+  TDaemonStartThread
+  ---------------------------------------------------------------------}
+Type
+  TDaemonStartThread = Class(TThread)
+    FEntryTable : PServiceTableEntry;
+    FLoopHandle : THandle;
+  Public
+    Constructor Create(T : PServiceTableEntry; LoopHandle : THandle);
+    Procedure DoTerminate; override;
+    Procedure Execute; override;
+    Property ReturnValue;
+  end;
+
+{ TDaemonStartThread }
+
+constructor TDaemonStartThread.create(T: PServiceTableEntry; LoopHandle : THandle);
+begin
+  FEntryTable:=T;
+  FLoopHandle:=LoopHandle;
+  FreeOnTerminate:=False;
+  ReturnValue:=0;
+  Inherited Create(False,DefaultStackSize*2);
+end;
+
+procedure TDaemonStartThread.DoTerminate;
+begin
+  Inherited DoTerminate;
+  If (FLoopHandle<>0) then
+    PostMessage(FLoopHandle,WM_QUIT,0,0);
+end;
+
+procedure TDaemonStartThread.Execute;
+begin
+{$ifdef svcdebug}DebugLog('Calling service dispatcher');{$endif svcdebug}
+  if StartServiceCtrlDispatcher(FEntryTable) then
+    ReturnValue:=0
+  else
+    ReturnValue:=GetLastError;
+{$ifdef svcdebug}DebugLog('Called service dispatcher');{$endif svcdebug}
+end;
+
+{ ---------------------------------------------------------------------
+  TSCMData : private data of controller.
+  ---------------------------------------------------------------------}
+
+Type
+  TSCMData = Class(TObject)
+    FHandle : SERVICE_STATUS_HANDLE;
+    Constructor Create(AHandle : SERVICE_STATUS_HANDLE);
+  end;
+
+Constructor TSCMData.Create(AHandle : SERVICE_STATUS_HANDLE);
+begin
+  FHandle:=AHandle;
+end;
+
+{ ---------------------------------------------------------------------
+  TSMData : private data of Application.
+  ---------------------------------------------------------------------}
+
+Type
+
+  { TSMData }
+
+  TSMData = Class(TObject)
+  Private
+    FHandle : SC_HANDLE;
+  Public
+    Constructor Create(AHandle : SC_HANDLE);
+    Destructor Destroy; override;
+  end;
+
+Constructor TSMData.Create(AHandle : SC_HANDLE);
+begin
+  FHandle:=AHandle;
+end;
+
+destructor TSMData.Destroy;
+begin
+  inherited;
+end;
+
+{ ---------------------------------------------------------------------
+  TCustomDaemonApplication
+  ---------------------------------------------------------------------}
+  
+const
+  WinServiceTypes : array[TServiceType] of Integer
+                  = (SERVICE_WIN32_OWN_PROCESS, SERVICE_KERNEL_DRIVER,
+                     SERVICE_FILE_SYSTEM_DRIVER);
+
+  WinStartTypes : array[TStartType] of Integer
+                = (SERVICE_BOOT_START, SERVICE_SYSTEM_START,
+                   SERVICE_AUTO_START, SERVICE_DEMAND_START,
+                   SERVICE_DISABLED);
+  WinErrorSeverities : array[TErrorSeverity] of Integer
+                     = (SERVICE_ERROR_IGNORE, SERVICE_ERROR_NORMAL,
+                        SERVICE_ERROR_SEVERE, SERVICE_ERROR_CRITICAL);
+
+// Careful, result of this function must be freed !!
+
+Function GetDependencies(D : TDependencies) : PChar;
+  
+var
+  I,L : Integer;
+  P   : PChar;
+
+begin
+  Result:=Nil;
+  L:=0;
+  for i:=0 to D.Count-1 do
+    Inc(L, Length(D[i].Name)+1+Ord(D[i].IsGroup));
+  if (L<>0) then
+    begin
+    Inc(L); // For final null-terminator;
+    GetMem(Result,L);
+    P:=Result;
+    for i:=0 to D.Count - 1 do
+      begin
+      if D[i].IsGroup then
+        begin
+        P^:=Char(SC_GROUP_IDENTIFIER);
+        Inc(P);
+        end;
+      P:=StrECopy(P,PChar(D[i].Name));
+      Inc(P);
+      end;
+    P^:=#0;
+    end;
+end;
+
+Procedure TCustomDaemonApplication.SysInstallDaemon(Daemon : TCustomDaemon);
+
+Var
+  SM,SV: SC_HANDLE;
+  N,DN,E,LG,UN,UP : String;
+  DD : TDaemonDef;
+  ST,STT,ES: Integer;
+  IDTag : DWord;
+  PIDTag : LPDWord;
+  PDeps,PN,PP : PChar;
+  
+begin
+  SM:=TSMData(FSysData).FHandle;
+  DD:=Daemon.Definition;
+  E:=Paramstr(0);
+  If (Pos(' ',E)<>0) then
+    E:='"'+E+'"';
+  E:=E+' --run'; // Add --run argument;
+  N:=DD.Name;
+  DN:=DD.DisplayName;
+  With DD.WinBindings do
+    begin
+    LG:=GroupName;
+    UN:=UserName;
+    If (UN='') then
+      PN:=Nil
+    else
+      PN:=PChar(UN);
+    UP:=Password;
+    if (UP='') then
+      PP:=Nil
+    else
+      PP:=PChar(UP);
+    // ServiceType ST
+      ST:=WinServiceTypes[ServiceType];
+    if (doInteractive in DD.Options) and (ServiceType=stWin32)  then
+      ST:=ST or SERVICE_INTERACTIVE_PROCESS;
+    // Actually, we should check count of enabled definitons only :/
+    if (ServiceType=stWin32) and (FMapper.DaemonDefs.Count>1) then
+      ST:=(ST xor SERVICE_WIN32_OWN_PROCESS) or SERVICE_WIN32_SHARE_PROCESS;
+    // StartType STT
+    STT:=WinStartTypes[StartType];
+    if (StartType in [stBoot, stSystem]) and (ServiceType<>stDevice) then
+      STT:=SERVICE_AUTO_START;
+    IDTag:=IDTag;
+    If (IDTag<>0) then
+      PIDTag:=@IDTag
+    else
+      PIDTag:=Nil;
+    ES:=WinErrorSeverities[ErrorSeverity];
+    PDeps:=GetDependencies(Dependencies);
+    end;
+  Try
+    flush(output);
+    SV:=CreateService(SM, PChar(N), PChar(DN), SERVICE_ALL_ACCESS, ST, STT, ES,
+                      PChar(E), PChar(LG), PIDTag, PDeps, PN, PP);
+    If (SV=0) then
+      RaiseLastOSError;
+    Try
+      If (PIDTag<>Nil) then
+        DD.WinBindings.IDTag:=IDTag;
+    finally
+      CloseServiceHandle(SV);
+    end
+  Finally
+    If (PDeps<>Nil) then
+      FreeMem(PDeps);
+  end;
+end;
+
+procedure TCustomDaemonApplication.SysUnInstallDaemon(Daemon: TCustomDaemon);
+
+var
+  SM,SV : SC_HANDLE;
+  DN : String;
+begin
+  SM:=TSMData(FSysData).FHandle;
+  DN:=Daemon.Definition.Name;
+  SV:=OpenService(SM,PChar(DN),SERVICE_ALL_ACCESS);
+  if (SV=0) then
+    RaiseLastOSError;
+  try
+    if Not DeleteService(SV) then
+      RaiseLastOSError;
+  finally
+    CloseServiceHandle(SV);
+  end;
+end;
+
+procedure TCustomDaemonApplication.SysStartUnInstallDaemons;
+Var
+  SM : SC_HANDLE;
+
+begin
+  SM:=OpenSCManager(Nil,Nil,SC_MANAGER_ALL_ACCESS);
+  if (SM=0) then
+    RaiseLastOSError;
+  FSysData:=TSMData.Create(SM);
+end;
+
+procedure TCustomDaemonApplication.SysEndUnInstallDaemons;
+begin
+  CloseServiceHandle(TSMData(FSysData).FHandle);
+  FreeandNil(FSysData);
+end;
+
+
+procedure TCustomDaemonApplication.SysStartInstallDaemons;
+
+Var
+  SM : SC_HANDLE;
+  
+begin
+  SM:=OpenSCManager(Nil,Nil,SC_MANAGER_ALL_ACCESS);
+  if (SM=0) then
+    RaiseLastOSError;
+  FSysData:=TSMData.Create(SM);
+end;
+
+procedure TCustomDaemonApplication.SysEndInstallDaemons;
+begin
+  CloseServiceHandle(TSMData(FSysData).FHandle);
+  FreeandNil(FSysData);
+end;
+
+procedure TCustomDaemonApplication.SysStartRunDaemons;
+begin
+  // Do nothing.
+end;
+
+Function TCustomDaemonApplication.RunGUIloop(P : Pointer) : integer;
+
+Const
+  HandleOpts=WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU or WS_MINIMIZEBOX;
+
+Var
+  T : TDaemonStartThread;
+  Msg : TMsg;
+  TClass: TWndClass;
+  AWClass: TWndClass = (
+    style: 0;
+    lpfnWndProc: @DefWindowProc;
+    cbClsExtra: 0;
+    cbWndExtra: 0;
+    hInstance: 0;
+    hIcon: 0;
+    hCursor: 0;
+    hbrBackground: 0;
+    lpszMenuName: nil;
+    lpszClassName: 'TDaemonApplication');
+
+begin
+  If (GUIHandle=0) then
+    begin
+    if not GetClassInfo(HInstance,AWClass.lpszClassName,TClass) then
+      begin
+      AWClass.hInstance := HInstance;
+      if Windows.RegisterClass(AWClass) = 0 then
+        DaemonError(SErrWindowClass);
+      end;
+    GUIHandle := CreateWindow(AWClass.lpszClassName, Pchar(Title),
+      HandleOpts, 1,1, 0, 0, 0, 0, HInstance, nil);
+    end;
+  T:=TDaemonStartThread.Create(P,GUIHandle);
+  Try
+    If Assigned(GuiMainLoop) then
+       GUIMainLoop
+    else
+      begin
+      // Run a message loop.
+      Msg.Message:=0;
+      Repeat
+        if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
+          begin
+          if (Msg.Message<>WM_QUIT) and (Msg.Message<>WM_ENDSESSION) then
+            begin
+            TranslateMessage(Msg);
+            DispatchMessage(Msg);
+            end
+          else
+            Terminate;
+          end;
+      Until Terminated;
+      end;
+  finally
+    Result:=T.ReturnValue;
+    T.Free;
+  end;
+end;
+
+procedure TCustomDaemonApplication.SysEndRunDaemons;
+
+Var
+  P : PServiceTableEntry;
+  I,C : Integer;
+  RV : Integer;
+  
+begin
+  GetMem(P,SizeOf(TServiceTableEntry)*FMapper.DaemonDefs.Count+1);
+  Try
+    C:=FMapper.DaemonDefs.Count;
+    For I:=0 to C-1 do
+      If Assigned(FMapper.DaemonDefs[i].Instance) then
+        begin
+        P[i].lpServiceName:=Pchar(FMapper.DaemonDefs[i].Name);
+        P[i].lpServiceProc:=@ServiceMainEntry;
+        end;
+    // Set last entry to Nil.
+    P[C].lpServiceName:=Nil;
+    P[C].lpServiceProc:=Nil;
+    If IsConsole then
+      begin
+       {$ifdef svcdebug}DebugLog('Starting ctrl dispatcher');{$endif svcdebug}
+      Try
+        if StartServiceCtrlDispatcher(P) then
+          begin
+          {$ifdef svcdebug}DebugLog('Return of dispatcher OK');{$endif svcdebug}
+          RV:=0;
+          end
+        else
+          begin
+          RV:=GetLastError;
+          {$ifdef svcdebug}DebugLog('Return of dispatcher NOK');{$endif svcdebug}
+          end;
+      except
+        On E : Exception do
+          begin
+          {$ifdef svcdebug}Debuglog('Caught exception : '+E.MEssage);{$endif svcdebug}
+          Raise;
+          end;
+      end;
+      end
+    else
+      begin
+      RV:=RunGuiLoop(P);
+      end;
+    {$ifdef svcdebug}DebugLog('SysRun Terminating');{$endif svcdebug}
+    Terminate;
+    If (RV<>0) then
+      Logger.Error(SErrServiceManagerStartFailed,[SysErrorMessage(RV)]);
+  Finally
+    FreeMem(P);
+  end;
+end;
+
+procedure TCustomDaemonApplication.RemoveController(
+  AController: TDaemonController);
+  
+begin
+  FreeAndNil(AController.FDaemon);
+  AController.Free;
+end;
+
+{ ---------------------------------------------------------------------
+  TDaemonThread
+  ---------------------------------------------------------------------}
+
+procedure TDaemonThread.StartServiceExecute;
+
+Var
+  Msg : TMsg;
+  
+begin
+  PeekMessage(Msg,0,WM_USER,WM_USER,PM_NOREMOVE);
+end;
+
+
+procedure TDaemonThread.CheckControlMessage(WaitForMessage : Boolean);
+
+Var
+  Msg : TMsg;
+  StopLoop : Boolean;
+
+begin
+  StopLoop:=False;
+  Repeat
+    StopLoop:=Terminated and WaitForMessage;
+    If Not StopLoop then
+      begin
+      If WaitForMessage Then
+        StopLoop:=Not GetMessage(Msg,0,0,0)
+      else
+        StopLoop:=Not PeekMessage(Msg,0,0,0,PM_REMOVE);
+      If Not StopLoop then
+        begin
+        If (Msg.hwnd<>0) or (Msg.Message<>CM_SERVICE_CONTROL_CODE) then
+          DispatchMessage(Msg)
+        else
+          HandleControlCode(Msg.wParam);
+        end;
+      end;
+  Until StopLoop;
+end;
+
+{ ---------------------------------------------------------------------
+  TDaemonController
+  ---------------------------------------------------------------------}
+
+procedure TDaemonController.StartService;
+begin
+  Main(0,Nil);
+end;
+
+
+procedure TDaemonController.Main(Argc: DWord; Args: PPChar);
+
+Var
+  T : TThread;
+  H : SERVICE_STATUS_HANDLE;
+  I : Integer;
+  
+begin
+  For I:=0 to Argc-1 do
+    FParams.Add(StrPas(Args[I]));
+  H:=RegisterServiceCtrlHandlerEx(Args[0],@ServiceControlHandlerEntry,Self);
+  if (H=0) then
+    Application.Logger.Error(SErrRegisterHandler,[getlasterror]);
+  FSysData:=TSCMData.Create(H);
+  FDaemon.Status:=csStartPending;
+  Try
+    T:=TDaemonThread.Create(FDaemon);
+    T.Resume;
+    T.WaitFor;
+    FreeAndNil(T);
+    FDaemon.FThread:=Nil;
+  except
+    On E : Exception do
+      FDaemon.Logmessage(Format(SErrDaemonStartFailed,[FDaemon.Definition.Name,E.Message]));
+  end;
+end;
+
+procedure TDaemonController.Controller(ControlCode, EventType: DWord;
+  EventData: Pointer);
+
+Var
+  TID : THandle;
+
+begin
+  if Assigned(FDaemon.FThread) then
+    begin
+    TID:=FDaemon.FThread.ThreadID;
+    If FDaemon.FThread.Suspended then
+      FDaemon.FThread.Resume;
+    PostThreadMessage(TID,CM_SERVICE_CONTROL_CODE,ControlCode,EventType);
+    end;
+end;
+
+
+function TDaemonController.ReportStatus: Boolean;
+
+  Function GetAcceptedCodes : Integer;
+
+  begin
+    Result := SERVICE_ACCEPT_SHUTDOWN;
+    if doAllowStop in FDAemon.Definition.Options then
+      Result := Result or SERVICE_ACCEPT_STOP;
+    if doAllowPause in FDAemon.Definition.Options then
+      Result := Result or SERVICE_ACCEPT_PAUSE_CONTINUE;
+  end;
+
+Var
+  S : String;
+  DD : TDaemonDef;
+  SS : TServiceStatus;
+  WB : TWinBindings;
+
+Const
+  WinServiceStatus : array[TCurrentStatus] of Integer
+                   = (SERVICE_STOPPED, SERVICE_START_PENDING,
+                      SERVICE_STOP_PENDING, SERVICE_RUNNING,
+                      SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING,
+                      SERVICE_PAUSED);
+  PendingStatus : set of TCurrentStatus
+                = [csStartPending, csStopPending,
+                   csContinuePending,csPausePending];
+
+begin
+  If not Assigned(FDaemon) then
+    begin
+    Application.Logger.Error(SErrNoDaemonForStatus,[Name]);
+    Exit;
+    end;
+  DD:=FDaemon.Definition;
+  If not Assigned(DD) then
+    begin
+    Application.Logger.Error(SErrNoDaemonDefForStatus,[Name]);
+    Exit;
+    end;
+  DD.LogStatusReport:=True;
+{$ifndef svcdebug}
+  If DD.LogStatusReport then
+{$endif svcdebug}
+    With FDaemon do
+      begin
+      S:=Format(SDaemonStatus,[Definition.DisplayName, CurrentStatusNames[Status]]);
+      Application.Logger.Info(S);
+      {$ifdef svcdebug}DebugLog(S);{$endif svcdebug}
+      end;
+  FillChar(SS,SizeOf(SS),0);
+  WB:=DD.WinBindings;
+  with SS do
+    begin
+    dwWaitHint := WB.WaitHint;
+    dwServiceType :=WinServiceTypes[WB.ServiceType];
+    if (FDaemon.Status=csStartPending) then
+      dwControlsAccepted := 0
+    else
+      dwControlsAccepted := GetAcceptedCodes;
+    if (FDaemon.Status in PendingStatus) and (FDaemon.Status = LastStatus) then
+      Inc(FCheckPoint)
+    else
+      FCheckPoint := 0;
+    dwCheckPoint:=FCheckPoint;
+    FLastStatus := FDaemon.Status;
+    dwCurrentState := WinServiceStatus[FDaemon.Status];
+    dwServiceSpecificExitCode:=WB.ErrCode;
+    if (WB.ErrCode<>0) then
+      dwWin32ExitCode:=ERROR_SERVICE_SPECIFIC_ERROR
+    else
+      dwWin32ExitCode := WB.Win32ErrCode;
+    if not SetServiceStatus(TSCMData(FSysData).FHandle, SS) then
+      Application.Logger.Error(SysErrorMessage(GetLastError));
+  end;
+end;
+
+Procedure TDaemonController.ThreadTerminated(Sender : TObject);
+
+begin
+end;
+
+
+{ ---------------------------------------------------------------------
+  Global initialization/Finalization
+  ---------------------------------------------------------------------}
+
+Procedure SysInitDaemonApp;
+
+begin
+end;
+
+
+Procedure SysDoneDaemonApp;
+
+begin
+end;
+
+