Browse Source

--- Merging r21245 into '.':
U packages/fcl-web/src/base/custweb.pp
--- Merging r21313 into '.':
U packages/fcl-web/src/base/custfcgi.pp
--- Merging r21390 into '.':
U packages/fcl-web/src/base/httpdefs.pp

# revisions: 21245,21313,21390
r21245 | michael | 2012-05-06 09:59:28 +0200 (Sun, 06 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/custweb.pp

* Default Modulename can be set
r21313 | michael | 2012-05-17 10:07:33 +0200 (Thu, 17 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/custfcgi.pp

* Applied patch from Joao Morais to customize request/response (bug 21980)
r21390 | michael | 2012-05-26 12:41:54 +0200 (Sat, 26 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Added FreeContentStream property to TResponse.

git-svn-id: branches/fixes_2_6@21720 -

marco 13 years ago
parent
commit
c87545dc62

+ 14 - 2
packages/fcl-web/src/base/custfcgi.pp

@@ -124,6 +124,8 @@ Type
     function Read_FCGIRecord : PFCGI_Header;
     function Read_FCGIRecord : PFCGI_Header;
     function DataAvailable : Boolean;
     function DataAvailable : Boolean;
   protected
   protected
+    function CreateRequest : TFCGIRequest; virtual;
+    function CreateResponse(ARequest: TFCGIRequest) : TFCGIResponse; virtual;
     Function DoFastCGIRead(AHandle : THandle; Var ABuf; ACount : Integer) : Integer; virtual;
     Function DoFastCGIRead(AHandle : THandle; Var ABuf; ACount : Integer) : Integer; virtual;
     Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer) : Integer; virtual;
     Function DoFastCGIWrite(AHandle : THandle; Const ABuf; ACount : Integer) : Integer; virtual;
     function  ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest;  out AResponse: TResponse): boolean; virtual;
     function  ProcessRecord(AFCGI_Record: PFCGI_Header; out ARequest: TRequest;  out AResponse: TResponse): boolean; virtual;
@@ -801,6 +803,16 @@ begin
 end;
 end;
 {$endif}
 {$endif}
 
 
+function TFCgiHandler.CreateRequest: TFCGIRequest;
+begin
+  Result := TFCGIRequest.Create;
+end;
+
+function TFCgiHandler.CreateResponse(ARequest: TFCGIRequest): TFCGIResponse;
+begin
+  Result := TFCGIResponse.Create(ARequest);
+end;
+
 function TFCgiHandler.DoFastCGIRead(AHandle: THandle; var ABuf; ACount: Integer): Integer;
 function TFCgiHandler.DoFastCGIRead(AHandle: THandle; var ABuf; ACount: Integer): Integer;
 begin
 begin
 {$ifdef windowspipe}
 {$ifdef windowspipe}
@@ -839,7 +851,7 @@ begin
       end;
       end;
     assert(not assigned(FRequestsArray[ARequestID].Request));
     assert(not assigned(FRequestsArray[ARequestID].Request));
     assert(not assigned(FRequestsArray[ARequestID].Response));
     assert(not assigned(FRequestsArray[ARequestID].Response));
-    ATempRequest:=TFCGIRequest.Create;
+    ATempRequest:=CreateRequest;
     InitRequest(ATempRequest);
     InitRequest(ATempRequest);
     ATempRequest.RequestID:=ARequestID;
     ATempRequest.RequestID:=ARequestID;
     ATempRequest.Handle:=FHandle;
     ATempRequest.Handle:=FHandle;
@@ -856,7 +868,7 @@ begin
   else if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
   else if FRequestsArray[ARequestID].Request.ProcessFCGIRecord(AFCGI_Record) then
     begin
     begin
     ARequest:=FRequestsArray[ARequestID].Request;
     ARequest:=FRequestsArray[ARequestID].Request;
-    FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
+    FRequestsArray[ARequestID].Response := CreateResponse(TFCGIRequest(ARequest));
     InitResponse(FRequestsArray[ARequestID].Response);
     InitResponse(FRequestsArray[ARequestID].Response);
     FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
     FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
     FRequestsArray[ARequestID].Response.FOnWrite:=@DoFastCGIWrite;
     FRequestsArray[ARequestID].Response.FOnWrite:=@DoFastCGIWrite;

+ 18 - 1
packages/fcl-web/src/base/custweb.pp

@@ -84,6 +84,7 @@ Type
 
 
   TWebHandler = class(TComponent)
   TWebHandler = class(TComponent)
   private
   private
+    FDefaultModuleName: String;
     FOnIdle: TNotifyEvent;
     FOnIdle: TNotifyEvent;
     FOnInitModule: TInitModuleEvent;
     FOnInitModule: TInitModuleEvent;
     FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
@@ -127,6 +128,7 @@ Type
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
     Property ApplicationURL : String Read FApplicationURL Write FApplicationURL;
     Property ApplicationURL : String Read FApplicationURL Write FApplicationURL;
     Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
     Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
+    Property DefaultModuleName : String Read FDefaultModuleName Write FDefaultModuleName;
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
     Property Email : String Read GetEmail Write FEmail;
     Property Email : String Read GetEmail Write FEmail;
@@ -147,6 +149,7 @@ Type
     function GetAdministrator: String;
     function GetAdministrator: String;
     function GetAllowDefaultModule: Boolean;
     function GetAllowDefaultModule: Boolean;
     function GetApplicationURL: String;
     function GetApplicationURL: String;
+    function GetDefaultModuleName: String;
     function GetEmail: String;
     function GetEmail: String;
     function GetEventLog: TEventLog;
     function GetEventLog: TEventLog;
     function GetHandleGetOnPost: Boolean;
     function GetHandleGetOnPost: Boolean;
@@ -160,6 +163,7 @@ Type
     procedure SetAdministrator(const AValue: String);
     procedure SetAdministrator(const AValue: String);
     procedure SetAllowDefaultModule(const AValue: Boolean);
     procedure SetAllowDefaultModule(const AValue: Boolean);
     procedure SetApplicationURL(const AValue: String);
     procedure SetApplicationURL(const AValue: String);
+    procedure SetDefaultModuleName(AValue: String);
     procedure SetEmail(const AValue: String);
     procedure SetEmail(const AValue: String);
     procedure SetHandleGetOnPost(const AValue: Boolean);
     procedure SetHandleGetOnPost(const AValue: Boolean);
     procedure SetModuleVar(const AValue: String);
     procedure SetModuleVar(const AValue: String);
@@ -187,6 +191,7 @@ Type
     Property RedirectOnErrorURL : string Read GetRedirectOnErrorURL Write SetRedirectOnErrorURL;
     Property RedirectOnErrorURL : string Read GetRedirectOnErrorURL Write SetRedirectOnErrorURL;
     Property ApplicationURL : String Read GetApplicationURL Write SetApplicationURL;
     Property ApplicationURL : String Read GetApplicationURL Write SetApplicationURL;
     Property AllowDefaultModule : Boolean Read GetAllowDefaultModule Write SetAllowDefaultModule;
     Property AllowDefaultModule : Boolean Read GetAllowDefaultModule Write SetAllowDefaultModule;
+    Property DefaultModuleName : String Read GetDefaultModuleName Write SetDefaultModuleName;
     Property ModuleVariable : String Read GetModuleVar Write SetModuleVar;
     Property ModuleVariable : String Read GetModuleVar Write SetModuleVar;
     Property OnGetModule : TGetModuleEvent Read GetOnGetModule Write SetOnGetModule;
     Property OnGetModule : TGetModuleEvent Read GetOnGetModule Write SetOnGetModule;
     Property Email : String Read GetEmail Write SetEmail;
     Property Email : String Read GetEmail Write SetEmail;
@@ -389,7 +394,9 @@ function TWebHandler.GetModuleName(Arequest: TRequest): string;
    Function GetDefaultModuleName : String;
    Function GetDefaultModuleName : String;
 
 
    begin
    begin
-      If (ModuleFactory.Count=1) then
+      if (DefaultModuleName<>'') then
+        Result:=DefaultModuleName
+      else if (ModuleFactory.Count=1) then
         Result:=ModuleFactory[0].ModuleName;
         Result:=ModuleFactory[0].ModuleName;
    end;
    end;
 
 
@@ -493,6 +500,11 @@ begin
   result := FWebHandler.ApplicationURL;
   result := FWebHandler.ApplicationURL;
 end;
 end;
 
 
+function TCustomWebApplication.GetDefaultModuleName: String;
+begin
+  Result:=FWebHandler.DefaultModuleName;
+end;
+
 function TCustomWebApplication.GetEmail: String;
 function TCustomWebApplication.GetEmail: String;
 begin
 begin
   result := FWebHandler.Email;
   result := FWebHandler.Email;
@@ -567,6 +579,11 @@ begin
   FWebHandler.ApplicationURL := AValue;
   FWebHandler.ApplicationURL := AValue;
 end;
 end;
 
 
+procedure TCustomWebApplication.SetDefaultModuleName(AValue: String);
+begin
+  FWebHandler.DefaultModuleName:=AValue;
+end;
+
 procedure TCustomWebApplication.SetEmail(const AValue: String);
 procedure TCustomWebApplication.SetEmail(const AValue: String);
 begin
 begin
   FWebHandler.Email := AValue;
   FWebHandler.Email := AValue;

+ 9 - 3
packages/fcl-web/src/base/httpdefs.pp

@@ -319,6 +319,7 @@ type
     FContentStream : TStream;
     FContentStream : TStream;
     FCode: Integer;
     FCode: Integer;
     FCodeText: String;
     FCodeText: String;
+    FFreeContentStream: Boolean;
     FHeadersSent: Boolean;
     FHeadersSent: Boolean;
     FContentSent: Boolean;
     FContentSent: Boolean;
     FRequest : TRequest;
     FRequest : TRequest;
@@ -341,6 +342,9 @@ type
     Procedure SendContent;
     Procedure SendContent;
     Procedure SendHeaders;
     Procedure SendHeaders;
     Procedure SendResponse; // Delphi compatibility
     Procedure SendResponse; // Delphi compatibility
+    Function GetCustomHeader(const Name: String) : String;
+    Procedure SetCustomHeader(const Name, Value: String);
+    Procedure SendRedirect(const TargetURL:String);
     Property Request : TRequest Read FRequest;
     Property Request : TRequest Read FRequest;
     Property Code: Integer Read FCode Write FCode;
     Property Code: Integer Read FCode Write FCode;
     Property CodeText: String Read FCodeText Write FCodeText;
     Property CodeText: String Read FCodeText Write FCodeText;
@@ -352,9 +356,7 @@ type
     Property ContentSent : Boolean Read FContentSent;
     Property ContentSent : Boolean Read FContentSent;
     property Cookies: TCookies read FCookies;
     property Cookies: TCookies read FCookies;
     Property CustomHeaders: TStringList read FCustomHeaders;
     Property CustomHeaders: TStringList read FCustomHeaders;
-    Function GetCustomHeader(const Name: String) : String;
-    Procedure SetCustomHeader(const Name, Value: String);
-    Procedure SendRedirect(const TargetURL:String);
+    Property FreeContentStream : Boolean Read FFreeContentStream Write FFreeContentStream;
   end;
   end;
   
   
   { TSessionVariable }
   { TSessionVariable }
@@ -1483,6 +1485,8 @@ end;
 
 
 destructor TResponse.destroy;
 destructor TResponse.destroy;
 begin
 begin
+  if FreeContentStream then
+    FreeAndNil(FContentStream);
   FreeAndNil(FCookies);
   FreeAndNil(FCookies);
   FreeAndNil(FContents);
   FreeAndNil(FContents);
   FreeAndNil(FCustomHeaders);
   FreeAndNil(FCustomHeaders);
@@ -1593,6 +1597,8 @@ procedure TResponse.SetContentStream(const AValue: TStream);
 begin
 begin
   If (FContentStream<>AValue) then
   If (FContentStream<>AValue) then
     begin
     begin
+    if (FContentStream<>Nil) and FreeContentStream then
+      FreeAndNil(FContentStream);
     FContentStream:=AValue;
     FContentStream:=AValue;
     If (FContentStream<>Nil) then
     If (FContentStream<>Nil) then
       ContentLength:=FContentStream.Size
       ContentLength:=FContentStream.Size