Browse Source

* Allow logging in TWebHandler
* Better construction of TLogEVent

git-svn-id: trunk@17504 -

michael 14 years ago
parent
commit
96dedbdd4d
1 changed files with 18 additions and 1 deletions
  1. 18 1
      packages/fcl-web/src/base/custweb.pp

+ 18 - 1
packages/fcl-web/src/base/custweb.pp

@@ -77,6 +77,7 @@ Type
   TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
   TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
                                Var ModuleClass : TCustomHTTPModuleClass) of object;
                                Var ModuleClass : TCustomHTTPModuleClass) of object;
   TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
   TOnShowRequestException = procedure(AResponse: TResponse; AnException: Exception; var handled: boolean);
+  TLogEvent = Procedure (EventType: TEventType; const Msg: String) of object;
 
 
   { TWebHandler }
   { TWebHandler }
 
 
@@ -97,6 +98,7 @@ Type
     FRedirectOnErrorURL : String;
     FRedirectOnErrorURL : String;
     FTitle: string;
     FTitle: string;
     FOnTerminate : TNotifyEvent;
     FOnTerminate : TNotifyEvent;
+    FOnLog : TLogEvent;
   protected
   protected
     procedure Terminate;
     procedure Terminate;
     Function GetModuleName(Arequest : TRequest) : string;
     Function GetModuleName(Arequest : TRequest) : string;
@@ -112,6 +114,7 @@ Type
   Public
   Public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     Procedure Run; virtual;
     Procedure Run; virtual;
+    Procedure Log(EventType : TEventType; Const Msg : String);
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
@@ -241,6 +244,12 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TWebHandler.Log(EventType: TEventType; const Msg: String);
+begin
+  If Assigned(FOnLog) then
+    FOnLog(EventType,Msg);
+end;
+
 procedure TWebHandler.ShowRequestException(R: TResponse; E: Exception);
 procedure TWebHandler.ShowRequestException(R: TResponse; E: Exception);
 Var
 Var
  S : TStrings;
  S : TStrings;
@@ -460,7 +469,14 @@ end;
 function TCustomWebApplication.GetEventLog: TEventLog;
 function TCustomWebApplication.GetEventLog: TEventLog;
 begin
 begin
   if not assigned(FEventLog) then
   if not assigned(FEventLog) then
-    FEventLog := TEventLog.Create(self);
+    begin
+    FEventLog := TEventLog.Create(Nil);
+    FEventLog.Name:=Self.Name+'Logger';
+    FEventLog.Identification:=Title;
+    FEventLog.RegisterMessageFile(ParamStr(0));
+    FEventLog.LogType:=ltSystem;
+    FEventLog.Active:=True;
+    end;
   Result := FEventLog;
   Result := FEventLog;
 end;
 end;
 
 
@@ -560,6 +576,7 @@ begin
   Inherited Create(AOwner);
   Inherited Create(AOwner);
   FWebHandler := InitializeWebHandler;
   FWebHandler := InitializeWebHandler;
   FWebHandler.FOnTerminate:=@DoOnTerminate;
   FWebHandler.FOnTerminate:=@DoOnTerminate;
+  FWebHandler.FOnLog:=@Log;
 end;
 end;
 
 
 procedure TCustomWebApplication.DoOnTerminate(Sender : TObject);
 procedure TCustomWebApplication.DoOnTerminate(Sender : TObject);