paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 00:39:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added support for TCustomDaemonApplication descendents (enabling streaming)

Browse Source 
git-svn-id: trunk@6288 -
This commit is contained in:
michael 2007-02-01 21:34:07 +00:00
parent f9eefa118c
commit 1d049300fd
1 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
fcl/inc/daemonapp.pp
View File

@ -340,6 +340,7 @@ Type
// Customizable behaviour
procedure CreateDaemonController(Var AController : TDaemonController); virtual;
Procedure CreateServiceMapper(Var AMapper : TCustomDaemonMapper); virtual;
Procedure CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); virtual;
Procedure RemoveController(AController : TDaemonController); virtual;
procedure SetupLogger;
procedure StopLogger;
@ -359,15 +360,16 @@ Type
Property GuiHandle : THandle Read FGUIHandle Write FGUIHandle;
Property RunMode : TDaemonRunMode Read FRunMode;
end;
TCustomDaemonApplicationClass = Class of TCustomDaemonApplication;
TDaemonApplication = Class(TCustomDaemonApplication)
end;
TDaemonApplication = Class(TCustomDaemonApplication);
EDaemon = Class(Exception);
Function Application : TCustomDaemonApplication;
Procedure RegisterDaemonMapper(AMapperClass : TCustomDaemonMapperClass);
Procedure RegisterDaemonClass(AClass : TCustomDaemonClass);
Procedure RegisterDaemonApplicationClass(AClass : TCustomDaemonApplicationClass);
Procedure DaemonError(Msg : String);
Procedure DaemonError(Fmt : String; Args : Array of const);
@ -386,7 +388,8 @@ Resourcestring
SErrNoDaemonForStatus = '%s: No daemon for status report';
SErrNoDaemonDefForStatus = '%s: No daemon definition for status report';
SErrWindowClass = 'Could not register window class';
SErrApplicationAlreadyCreated = 'An application instance of class %s was already created.';
{ $define svcdebug}
{$ifdef svcdebug}
@ -407,11 +410,12 @@ implementation
{$i daemonapp.inc}
Var
AppInstance : TCustomDaemonApplication;
MapperClass : TCustomDaemonMapperClass;
DesignMapper : TCustomDaemonMapper;
AppInstance : TCustomDaemonApplication;
MapperClass : TCustomDaemonMapperClass;
DesignMapper : TCustomDaemonMapper;
DaemonClasses : TStringList;
AppClass : TCustomDaemonApplicationClass;
{$ifdef svcdebug}
Var
FL : Text;
@ -450,6 +454,14 @@ begin
end;
{$endif svcdebug}
Procedure RegisterDaemonApplicationClass(AClass : TCustomDaemonApplicationClass);
begin
If (AppInstance<>Nil) then
DaemonError(SErrApplicationAlreadyCreated,[AppInstance.ClassName]);
AppClass:=AClass;
end;
Procedure RegisterDaemonClass(AClass : TCustomDaemonClass);
Var
@ -472,7 +484,9 @@ end;
Procedure CreateDaemonApplication;
begin
AppInstance:=TDaemonApplication.Create(Nil);
If (AppClass=Nil) then
AppClass:=TCustomDaemonApplication;
AppInstance:=AppClass.Create(Nil);
end;
Procedure DoneDaemonApplication;
@ -877,6 +891,11 @@ begin
inherited ShowException(E)
end;
Procedure TCustomDaemonApplication.CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef);
begin
ADaemon:=DaemonDef.DaemonClass.CreateNew(Self,0);
end;
function TCustomDaemonApplication.CreateDaemon(DaemonDef: TDaemonDef): TCustomDaemon;
@ -884,7 +903,7 @@ Var
C : TDaemonController;
begin
Result:=DaemonDef.DaemonClass.CreateNew(Self,0);
CreateDaemonInstance(Result,DaemonDef);
CreateDaemonController(C);
C.FDaemon:=Result;
Result.FController:=C;