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

fcl-web: moved OnLog from TSimpleFileModule to TFPCustomFileModule

Browse Source
This commit is contained in:
mattias 2023-02-15 00:52:42 +01:00
parent 2780b5f830
commit 11cf24891d
1 changed files with 7 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,6 +25,8 @@ uses SysUtils, Classes, httpdefs, fphttp, httproute;
Type Type
EFileLocation = class(EHTTP); EFileLocation = class(EHTTP);
TSimpleFileLog = Procedure (EventType : TEventType; Const Msg : String) of object;
{ TFPCustomFileModule } { TFPCustomFileModule }
TFPCustomFileModule = Class(TCustomHTTPModule) TFPCustomFileModule = Class(TCustomHTTPModule)
@ -45,6 +47,9 @@ Type
// Overrides TCustomHTTPModule to implement file serving. // Overrides TCustomHTTPModule to implement file serving.
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override; Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
Property CacheControlMaxAge : Integer Read FCacheControlMaxAge Write FCacheControlMaxAge; Property CacheControlMaxAge : Integer Read FCacheControlMaxAge Write FCacheControlMaxAge;
Public Class Var
// If you want some logging, set this.
OnLog : TSimpleFileLog;
Published Published
Property CORS; Property CORS;
property Kind; property Kind;
@ -86,7 +91,6 @@ Type
{ TSimpleFileModule } { TSimpleFileModule }
TSimpleFileLog = Procedure (EventType : TEventType; Const Msg : String) of object;
TSimpleFileModule = class(TFPCustomFileModule,IRouteInterface) TSimpleFileModule = class(TFPCustomFileModule,IRouteInterface)
Private Private
class var class var
@ -99,16 +103,12 @@ Type
Function AllowFile(Const AFileName : String) : Boolean; override; Function AllowFile(Const AFileName : String) : Boolean; override;
Function MapFileName(Const AFileName : String) : String; override; Function MapFileName(Const AFileName : String) : String; override;
Function GetRequestFileName(Const ARequest : TRequest) : String; override; Function GetRequestFileName(Const ARequest : TRequest) : String; override;
Public
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
Public Public
Class var Class var
// Where to serve files from // Where to serve files from
BaseDir : String; BaseDir : String;
// For directories, convert to index.html if this is set. // For directories, convert to index.html if this is set.
IndexPageName : String; IndexPageName : String;
// If you want some logging, set this.
OnLog : TSimpleFileLog;
DefaultSimpleFileModuleClass: TSimpleFileModuleClass; DefaultSimpleFileModuleClass: TSimpleFileModuleClass;
Class Procedure RegisterDefaultRoute(OverAllDefault : Boolean = True); Class Procedure RegisterDefaultRoute(OverAllDefault : Boolean = True);
Class function DefaultRouteActive : Boolean; Class function DefaultRouteActive : Boolean;
@ -263,13 +263,6 @@ begin
Result:=Result+IndexPageName; Result:=Result+IndexPageName;
end; end;
procedure TSimpleFileModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
begin
Inherited;
if Assigned (OnLog) then
OnLog(etInfo,Format('%d serving "%s" -> "%s"',[AResponse.Code,FRequestedFileName,FMappedFileName]));
end;
class procedure TSimpleFileModule.RegisterDefaultRoute(OverAllDefault : Boolean = True); class procedure TSimpleFileModule.RegisterDefaultRoute(OverAllDefault : Boolean = True);
begin begin
if BaseDir='' then if BaseDir='' then
@ -411,6 +404,8 @@ begin
exit; exit;
end; end;
SendFile(FN,AResponse); SendFile(FN,AResponse);
if Assigned (OnLog) then
OnLog(etInfo,Format('%d serving "%s" -> "%s"',[AResponse.Code,RFN,FN]));
end; end;
procedure TFPWebFileLocationAPIModule.SetCors(AValue: TCORSSupport); procedure TFPWebFileLocationAPIModule.SetCors(AValue: TCORSSupport);