mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 17:09:16 +02:00
* Implemented RedirectOnError
git-svn-id: trunk@9354 -
This commit is contained in:
parent
6c536dab3e
commit
cc014d6a65
@ -116,6 +116,8 @@ Type
|
|||||||
FAdministrator : String;
|
FAdministrator : String;
|
||||||
FOutput : TStream;
|
FOutput : TStream;
|
||||||
FHandleGetOnPost : Boolean;
|
FHandleGetOnPost : Boolean;
|
||||||
|
FRedirectOnError : Boolean;
|
||||||
|
FRedirectOnErrorURL : String;
|
||||||
Procedure InitRequestVars;
|
Procedure InitRequestVars;
|
||||||
Function GetEmail : String;
|
Function GetEmail : String;
|
||||||
Function GetAdministrator : String;
|
Function GetAdministrator : String;
|
||||||
@ -144,6 +146,8 @@ Type
|
|||||||
Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
|
Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
|
||||||
Property RequestVariables[VarName : String] : String Read GetRequestVariable;
|
Property RequestVariables[VarName : String] : String Read GetRequestVariable;
|
||||||
Property RequestVariableCount : Integer Read GetRequestVariableCount;
|
Property RequestVariableCount : Integer Read GetRequestVariableCount;
|
||||||
|
Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
|
||||||
|
Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
ResourceString
|
ResourceString
|
||||||
@ -285,6 +289,13 @@ Var
|
|||||||
S : TStrings;
|
S : TStrings;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
If RedirectOnError and not FResponse.HeadersSent then
|
||||||
|
begin
|
||||||
|
FResponse.Location := RedirectOnErrorURL;
|
||||||
|
FResponse.Code := 301;
|
||||||
|
FResponse.SendContent;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
If not FResponse.HeadersSent then
|
If not FResponse.HeadersSent then
|
||||||
FResponse.ContentType:='text/html';
|
FResponse.ContentType:='text/html';
|
||||||
If (FResponse.ContentType='text/html') then
|
If (FResponse.ContentType='text/html') then
|
||||||
@ -483,6 +494,8 @@ constructor TCustomCGIApplication.Create(AOwner: TComponent);
|
|||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
FHandleGetOnPost := True;
|
FHandleGetOnPost := True;
|
||||||
|
FRedirectOnError := False;
|
||||||
|
FRedirectOnErrorURL := '';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Procedure TCustomCGIApplication.AddResponse(Const S : String);
|
Procedure TCustomCGIApplication.AddResponse(Const S : String);
|
||||||
|
Loading…
Reference in New Issue
Block a user