Browse Source

* Allow max-age for cache control

git-svn-id: trunk@43081 -
michael 5 years ago
parent
commit
1cd501229f
1 changed files with 16 additions and 0 deletions
  1. 16 0
      packages/fcl-web/src/base/fpwebfile.pp

+ 16 - 0
packages/fcl-web/src/base/fpwebfile.pp

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