* Implemented TResponse.SendTemporaryRedirect (part of bug #13254)

git-svn-id: trunk@12987 -

packages/fcl-web/src/custweb.pp

@@ -155,8 +155,7 @@ begin
   if R.ContentSent then exit;
   If RedirectOnError and not R.HeadersSent then
     begin
-    R.Location := format(RedirectOnErrorURL,[HTTPEncode(E.Message)]);
-    R.Code := 301;
+    R.SendTemporaryRedirect(format(RedirectOnErrorURL,[HTTPEncode(E.Message)]));
     R.SendContent;
     Exit;
     end;

packages/fcl-web/src/httpdefs.pp

@@ -253,6 +253,7 @@ type
     Property CookieFields : TStrings Read FCookieFields Write SetCookieFields;
     Property ContentFields: TStrings read FContentFields;
     property QueryFields : TStrings read FQueryFields;
+    Procedure SendTemporaryRedirect(const TargetURL:String);
   end;
 
 
@@ -734,6 +735,21 @@ begin
     end;
 end;
 
+procedure THTTPHeader.SendTemporaryRedirect(const TargetURL: String);
+begin
+  Location := TargetURL;
+  if FHttpVersion = '1.1' then
+    begin
+    Code := 307;// HTTP/1.1 307 HTTP_TEMPORARY_REDIRECT -> 'Temporary Redirect'
+    CodeText := 'Temporary Redirect';
+    end
+  else
+    begin
+    Code := 302;// HTTP/1.0 302 HTTP_MOVED_TEMPORARILY -> 'Found'
+    CodeText := 'Moved Temporarily';
+    end;
+end;
+
 procedure THttpHeader.SetFieldByName(const AName, AValue: String);
 var
   i: Integer;