paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow logging in TWebHandler

Browse Source 
* Better construction of TLogEVent

git-svn-id: trunk@17504 -
This commit is contained in:
michael 2011-05-19 14:22:05 +00:00
parent 3ea608a6f4
commit 96dedbdd4d
1 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
packages/fcl-web/src/base/custweb.pp
View File

@ -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);