Sfoglia il codice sorgente

* Log event no longer virtual, descendents must override DoLog
Filtering is applied in Log in CustApp.

git-svn-id: trunk@17530 -

michael 14 anni fa
parent
commit
d7dbe6f778

+ 10 - 2
packages/fcl-base/src/custapp.pp

@@ -46,6 +46,7 @@ Type
     Procedure DoRun; Virtual;
     Function GetParams(Index : Integer) : String;virtual;
     function GetParamCount: Integer;Virtual;
+    Procedure DoLog(EventType : TEventType; const Msg : String);  virtual;
   Public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -67,7 +68,7 @@ Type
     Function CheckOptions(Const ShortOptions : String; Const LongOpts : String) : String;
     Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
     Procedure GetEnvironmentList(List : TStrings);
-    Procedure Log(EventType : TEventType; const Msg : String); virtual;
+    Procedure Log(EventType : TEventType; const Msg : String);
     // Delphi properties
     property ExeName: string read GetExeName;
     property HelpFile: string read FHelpFile write FHelpFile;
@@ -228,10 +229,17 @@ begin
   // Do nothing. Override in descendent classes.
 end;
 
+Procedure TCustomApplication.DoLog(EventType : TEventType; const Msg : String);
+
+begin
+  // Do nothing, override in descendants
+end;
+
 Procedure TCustomApplication.Log(EventType : TEventType; const Msg : String);
 
 begin
-  // Do nothing. Override in descendent classes.
+  If (FEventLogFilter=[]) or (EventType in FEventLogFilter) then
+    DoLog(EventType,Msg);
 end;
 
 constructor TCustomApplication.Create(AOwner: TComponent);

+ 41 - 8
packages/fcl-extra/src/daemonapp.pp

@@ -359,6 +359,7 @@ Type
     Procedure RemoveController(AController : TDaemonController); virtual;
     Function GetEventLog: TEventLog; virtual;
     Procedure DoRun; override;
+    procedure DoLog(EventType: TEventType; const Msg: String); override;
     Property SysData : TObject Read FSysData Write FSysData;
   Public
     destructor Destroy; override;
@@ -370,7 +371,6 @@ Type
     procedure UnInstallDaemons;
     procedure ShowHelp;
     procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
-    procedure Log(EventType: TEventType; const Msg: String); override;
     Property  OnRun : TNotifyEvent Read FOnRun Write FOnRun;
     Property EventLog : TEventLog Read GetEventLog;
     Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
@@ -412,7 +412,7 @@ Resourcestring
   SHelpUnInstall                = 'To uninstall the service';
   SHelpRun                      = 'To run the service';
 
-{ $define svcdebug}
+{$define svcdebug}
 
 {$ifdef svcdebug}
 Procedure DebugLog(Msg : String);
@@ -520,8 +520,12 @@ end;
 
 function Application: TCustomDaemonApplication;
 begin
+ {$ifdef svcdebug}Debuglog('Application');{$endif}
   If (AppInstance=Nil) then
+    begin
+    {$ifdef svcdebug}Debuglog('Application creating instance');{$endif}
     CreateDaemonApplication;
+    end;
   Result:=AppInstance;
 end;
 
@@ -722,12 +726,39 @@ Var
   DD : TDaemonDef;
   
 begin
-  If (Args=Nil) then
-    Exit;
-  SN:=StrPas(Args^);
-  DD:=FMapper.DaemonDefs.FindDaemonDef(SN);
+ {$ifdef svcdebug}DebugLog('Application.Main');{$endif svcdebug}
+  If (Argc=0) then
+    begin
+    {$ifdef svcdebug}DebugLog('Using Default daemon');{$endif svcdebug}
+    if FMapper.DaemonDefs.Count=1 then
+      DD:=FMapper.DaemonDefs[0]
+    else
+      DD:=Nil
+    end
+  else
+    begin
+    {$ifdef svcdebug}DebugLog('Application.Main 2 : '+IntToStr(Argc));{$endif svcdebug}
+    DD:=Nil;
+    SN:='';
+    If (Args<>Nil) then
+      begin
+      If (Args^<>Nil) then
+        SN:=StrPas(Args^)
+      else
+        SN:='';
+      end;
+    {$ifdef svcdebug}DebugLog('Looking for daemon '+SN);{$endif svcdebug}
+    DD:=FMapper.DaemonDefs.FindDaemonDef(SN);
+    end;
   If (DD<>Nil) then
+    begin
+    {$ifdef svcdebug}DebugLog('Found daemon '+SN);{$endif svcdebug}
     DD.Instance.Controller.Main(Argc,Args);
+    end
+  else
+    begin
+  {$ifdef svcdebug}DebugLog('Did not fin daemon '+SN);{$endif svcdebug}
+    end;
 end;
 
 
@@ -848,7 +879,7 @@ begin
   end;
 end;
 
-procedure TCustomDaemonApplication.Log(EventType: TEventType; const Msg: String);
+procedure TCustomDaemonApplication.DoLog(EventType: TEventType; const Msg: String);
 begin
   EventLog.Log(EventType,Msg);
 end;
@@ -884,8 +915,9 @@ begin
   if not assigned(FEventLog) then
     begin
     FEventLog:=TEventlog.Create(Self);
-    FEventLog.RaiseExceptionOnError:=true;
+    FEventLog.RaiseExceptionOnError:=False;
     FEventLog.RegisterMessageFile('');
+    FEventLog.Active:=True;
     end;
   result := FEventLog;
 end;
@@ -1190,6 +1222,7 @@ Var
   S : String;
 
 begin
+ {$ifdef svcdebug}DebugLog('Handling control code '+IntToStr(ACode));{$endif svcdebug}
   CS:=FDaemon.Status;
   Try
     OK:=True;

+ 2 - 2
packages/fcl-web/src/base/custweb.pp

@@ -162,6 +162,7 @@ Type
   protected
     Procedure DoRun; override;
     function InitializeWebHandler: TWebHandler; virtual; abstract;
+    Procedure DoLog(EventType: TEventType; const Msg: String); override;
     procedure SetTitle(const AValue: string); override;
     property WebHandler: TWebHandler read FWebHandler write FWebHandler;
   Public
@@ -169,7 +170,6 @@ Type
     destructor Destroy; override;
     Procedure CreateForm(AClass : TComponentClass; out Reference);
     Procedure Initialize; override;
-    Procedure Log(EventType: TEventType; const Msg: String); override;
     procedure Terminate; override;
     Property HandleGetOnPost : Boolean Read GetHandleGetOnPost Write SetHandleGetOnPost;
     Property RedirectOnError : boolean Read GetRedirectOnError Write SetRedirectOnError;
@@ -604,7 +604,7 @@ begin
   Inherited;
 end;
 
-procedure TCustomWebApplication.Log(EventType: TEventType; const Msg: String);
+procedure TCustomWebApplication.DoLog(EventType: TEventType; const Msg: String);
 begin
   EventLog.log(EventType,Msg);
 end;