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

* (Modified) Patch from Sven Barth to add AfterInitModule

Browse Source 
git-svn-id: trunk@20494 -
This commit is contained in:
michael 2012-03-10 14:19:00 +00:00
parent b50bd10818
commit 7ab32986ef
3 changed files with 19 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -78,12 +78,14 @@ Type
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; TLogEvent = Procedure (EventType: TEventType; const Msg: String) of object;
TInitModuleEvent = Procedure (Sender : TObject; Module: TCustomHTTPModule) of object;
{ TWebHandler } { TWebHandler }
TWebHandler = class(TComponent) TWebHandler = class(TComponent)
private private
FOnIdle: TNotifyEvent; FOnIdle: TNotifyEvent;
FOnInitModule: TInitModuleEvent;
FOnUnknownRequestEncoding: TOnUnknownEncodingEvent; FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
FTerminated: boolean; FTerminated: boolean;
FAdministrator: String; FAdministrator: String;
@ -133,6 +135,7 @@ Type
property OnIdle: TNotifyEvent read FOnIdle write FOnIdle; property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
Property OnLog : TLogEvent Read FOnLog Write FOnLog; Property OnLog : TLogEvent Read FOnLog Write FOnLog;
Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read FOnUnknownRequestEncoding Write FOnUnknownRequestEncoding; Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read FOnUnknownRequestEncoding Write FOnUnknownRequestEncoding;
Property OnInitModule: TInitModuleEvent Read FOnInitModule write FOnInitModule;
end; end;
TCustomWebApplication = Class(TCustomApplication) TCustomWebApplication = Class(TCustomApplication)
@ -343,6 +346,9 @@ begin
else else
M:=MC.Create(Self); M:=MC.Create(Self);
SetBaseURL(M,MN,ARequest); SetBaseURL(M,MN,ARequest);
if (OnInitModule<>Nil) then
OnInitModule(Self,M);
M.DoAfterInitModule(ARequest);
if M.Kind=wkOneShot then if M.Kind=wkOneShot then
begin begin
try try

12
packages/fcl-web/src/base/fphttp.pp
View File

@ -104,14 +104,18 @@ Type
{ TCustomHTTPModule } { TCustomHTTPModule }
TInitModuleEvent = Procedure (Sender : TObject; ARequest : TRequest) of object;
TCustomHTTPModule = Class(TDataModule) TCustomHTTPModule = Class(TDataModule)
private private
FAfterInitModule : TInitModuleEvent;
FBaseURL: String; FBaseURL: String;
FWebModuleKind: TWebModuleKind; FWebModuleKind: TWebModuleKind;
public public
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract; Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
Procedure DoAfterInitModule(ARequest : TRequest); virtual;
property Kind: TWebModuleKind read FWebModuleKind write FWebModuleKind default wkPooled; property Kind: TWebModuleKind read FWebModuleKind write FWebModuleKind default wkPooled;
Property BaseURL : String Read FBaseURL Write FBaseURL; Property BaseURL : String Read FBaseURL Write FBaseURL;
Property AfterInitModule : TInitModuleEvent Read FAfterInitModule Write FAfterInitModule;
end; end;
TCustomHTTPModuleClass = Class of TCustomHTTPModule; TCustomHTTPModuleClass = Class of TCustomHTTPModule;
@ -244,6 +248,14 @@ begin
Result:=GSM; Result:=GSM;
end; end;
{ TCustomHTTPModule }
procedure TCustomHTTPModule.DoAfterInitModule(ARequest: TRequest);
begin
If Assigned(FAfterInitModule) then
FAfterInitModule(Self, ARequest);
end;
{ TSessionFactory } { TSessionFactory }
function TSessionFactory.CreateSession(ARequest: TRequest): TCustomSession; function TSessionFactory.CreateSession(ARequest: TRequest): TCustomSession;

1
packages/fcl-web/src/base/fpweb.pp
View File

@ -150,6 +150,7 @@ Type
property Kind; property Kind;
Property OnNewSession; Property OnNewSession;
Property OnSessionExpired; Property OnSessionExpired;
Property AfterInitModule;
end; end;
EFPWebError = Class(HTTPError); EFPWebError = Class(HTTPError);