Browse Source

* Added logging functionality using TEventLog

git-svn-id: trunk@14991 -
joost 15 years ago
parent
commit
97207e8676
1 changed files with 25 additions and 1 deletions
  1. 25 1
      packages/fcl-web/src/custweb.pp

+ 25 - 1
packages/fcl-web/src/custweb.pp

@@ -21,7 +21,7 @@ unit custweb;
 Interface
 Interface
 
 
 uses
 uses
-  CustApp,Classes,SysUtils, httpdefs, fphttp;
+  CustApp,Classes,SysUtils, httpdefs, fphttp, eventlog;
 
 
 Const
 Const
   CGIVarCount = 36;
   CGIVarCount = 36;
@@ -88,6 +88,8 @@ Type
     FHandleGetOnPost : Boolean;
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnErrorURL : String;
     FRedirectOnErrorURL : String;
+    FEventLog: TEventLog;
+    function GetEventLog: TEventLog;
   protected
   protected
     Function GetModuleName(Arequest : TRequest) : string;
     Function GetModuleName(Arequest : TRequest) : string;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; virtual; abstract;
@@ -99,11 +101,13 @@ Type
     Function GetAdministrator : String; virtual;
     Function GetAdministrator : String; virtual;
   Public
   Public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent);
     Procedure CreateForm(AClass : TComponentClass; Var Reference : TComponent);
     Procedure Initialize; override;
     Procedure Initialize; override;
     Procedure ShowException(E: Exception);override;
     Procedure ShowException(E: Exception);override;
     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;
+    Procedure Log(EventType: TEventType; Msg: String); override;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
@@ -114,6 +118,7 @@ Type
     Property Email : String Read GetEmail Write FEmail;
     Property Email : String Read GetEmail Write FEmail;
     Property Administrator : String Read GetAdministrator Write FAdministrator;
     Property Administrator : String Read GetAdministrator Write FAdministrator;
     property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
     property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
+    Property EventLog: TEventLog read GetEventLog;
   end;
   end;
 
 
   EFPWebError = Class(Exception);
   EFPWebError = Class(Exception);
@@ -281,6 +286,11 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TCustomWebApplication.Log(EventType: TEventType; Msg: String);
+begin
+  EventLog.log(EventType,Msg);
+end;
+
 Procedure TCustomWebApplication.Initialize;
 Procedure TCustomWebApplication.Initialize;
 
 
 begin
 begin
@@ -288,6 +298,13 @@ begin
   Inherited;
   Inherited;
 end;
 end;
 
 
+function TCustomWebApplication.GetEventLog: TEventLog;
+begin
+  if not assigned(FEventLog) then
+    FEventLog := TEventLog.Create(self);
+  Result := FEventLog;
+end;
+
 function TCustomWebApplication.GetModuleName(Arequest: TRequest): string;
 function TCustomWebApplication.GetModuleName(Arequest: TRequest): string;
 var
 var
   S : String;
   S : String;
@@ -341,6 +358,13 @@ begin
   FRedirectOnErrorURL := '';
   FRedirectOnErrorURL := '';
 end;
 end;
 
 
+destructor TCustomWebApplication.Destroy;
+begin
+  if assigned(FEventLog) then
+    FEventLog.Free;
+  inherited Destroy;
+end;
+
 procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; var Reference: TComponent);
 procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; var Reference: TComponent);
 begin
 begin
   Reference:=AClass.Create(Self);
   Reference:=AClass.Create(Self);