paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 03:30:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented TResponse.CustomHeaders, patch from Atilla Borka, part of bug #13254

Browse Source 
git-svn-id: trunk@13062 -
This commit is contained in:
joost 2009-04-30 14:43:54 +00:00
parent a5376cbdff
commit 6e72451e63
1 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
packages/fcl-web/src/httpdefs.pp
View File

@ -307,6 +307,7 @@ type
FContentSent: Boolean;
FRequest : TRequest;
FCookies : TCookies;
FCustomHeaders : TStringList;
function GetContent: String;
procedure SetContent(const AValue: String);
procedure SetContents(AValue: TStrings);
@ -334,6 +335,9 @@ type
Property HeadersSent : Boolean Read FHeadersSent;
Property ContentSent : Boolean Read FContentSent;
property Cookies: TCookies read FCookies;
Property CustomHeaders: TStringList read FCustomHeaders;
Function GetCustomHeader(const Name: String) : String;
Procedure SetCustomHeader(const Name, Value: String);
Procedure SendRedirect(const TargetURL:String);
end;
@ -1374,12 +1378,14 @@ begin
FContents:=TStringList.Create;
TStringList(FContents).OnChange:=@ContentsChanged;
FCookies:=TCookies.Create(TCookie);
FCustomHeaders:=TStringList.Create;
end;
destructor TResponse.destroy;
begin
FreeAndNil(FCookies);
FreeAndNil(FContents);
FreeAndNil(FCustomHeaders);
inherited destroy;
end;
@ -1420,6 +1426,19 @@ begin
SendContent;
end;
function TResponse.GetCustomHeader(const Name: String): String;
begin
Result := FCustomHeaders.Values[Name];
end;
procedure TResponse.SetCustomHeader(const Name, Value: String);
begin
if GetCustomHeader(Name) = '' then
FCustomHeaders.Add(Name + '=' + Value)
else
FCustomHeaders.Values[Name] := Value;
end;
procedure TResponse.SendRedirect(const TargetURL: String);
begin
Location := TargetURL;
@ -1518,6 +1537,8 @@ begin
Headers.Add('Set-Cookie: '+FCookies[i].AsString);
For I:=0 to FieldCount-1 do
Headers.Add(Fields[i]);
For I:=0 to FCustomHeaders.Count - 1 do if FCustomHeaders[I] <> '' then
Headers.Add(FCustomHeaders.Names[I] + ': ' + FCustomHeaders.ValueFromIndex[I]);
Headers.Add('');
{$ifdef cgidebug} SendMethodExit('Collectheaders');{$endif}
end;