paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 07:50:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow max-age for cache control

Browse Source 
git-svn-id: trunk@43081 -
This commit is contained in:
michael 2019-09-26 13:54:23 +00:00
parent 413b5adb59
commit 1cd501229f
1 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,12 @@ interface
uses SysUtils, Classes, httpdefs, fphttp, httproute; uses SysUtils, Classes, httpdefs, fphttp, httproute;
Type Type
{ TFPCustomFileModule }
TFPCustomFileModule = Class(TCustomHTTPModule) TFPCustomFileModule = Class(TCustomHTTPModule)
private
FCacheControlMaxAge: Integer;
Protected Protected
// Determine filename frome request. // Determine filename frome request.
Function GetRequestFileName(Const ARequest : TRequest) : String; virtual; Function GetRequestFileName(Const ARequest : TRequest) : String; virtual;
@ -33,8 +38,10 @@ Type
// Actually Send file to client. // Actually Send file to client.
Procedure SendFile(Const AFileName : String; AResponse : TResponse); virtual; Procedure SendFile(Const AFileName : String; AResponse : TResponse); virtual;
Public Public
Constructor CreateNew(AOwner: TComponent; CreateMode: Integer); override; overload;
// 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;
end; end;
TFPCustomFileModuleClass = Class of TFPCustomFileModule; TFPCustomFileModuleClass = Class of TFPCustomFileModule;
@ -69,6 +76,7 @@ Var
DefaultFileModuleClass : TFPCustomFileModuleClass = TFPCustomFileModule; DefaultFileModuleClass : TFPCustomFileModuleClass = TFPCustomFileModule;
// Setting this will load mime types from that file. // Setting this will load mime types from that file.
MimeTypesFile : string; MimeTypesFile : string;
DefaultCacheControlMaxAge : Integer = 0;
// use this to map locations (relative to BaseURL of the application) to physical directories. // use this to map locations (relative to BaseURL of the application) to physical directories.
// More than one location can be registered. Directory must exist, location must not have / or \ // More than one location can be registered. Directory must exist, location must not have / or \
@ -250,6 +258,8 @@ begin
AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(AFileName)); AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(AFileName));
If (AResponse.ContentType='') then If (AResponse.ContentType='') then
AResponse.ContentType:='Application/octet-stream'; AResponse.ContentType:='Application/octet-stream';
if CacheControlMaxAge>0 then
aResponse.CacheControl:=Format('max-age=%d',[CacheControlMaxAge]);
F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite); F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
try try
AResponse.ContentLength:=F.Size; AResponse.ContentLength:=F.Size;
@ -261,6 +271,12 @@ begin
end; end;
end; end;
constructor TFPCustomFileModule.CreateNew(AOwner: TComponent; CreateMode: Integer);
begin
inherited CreateNew(aOwner,CreateMode);
CacheControlMaxAge:=DefaultCacheControlMaxAge;
end;
Procedure TFPCustomFileModule.HandleRequest(ARequest : TRequest; AResponse : TResponse); Procedure TFPCustomFileModule.HandleRequest(ARequest : TRequest; AResponse : TResponse);