如果您在 HttpApp.pas 中谈论 TCookie,则没有内置属性来支持 HttpOnly。
您可以查看 httpApp.pas 的TCookie.GetHeaderValue: string;实现来验证。
然而,Cookie 只是在标头中设置的内容,而 TWebResponse 有一个 CustomHeaders 属性。哪里可以打电话Response.CustomHeaders.Add(MyCookieValue);
以下类是 TCookie 的修改版本,用于支持 HttpOnly,您可以使用它来正确生成 cookie。
unit CookieGen;
interface
uses
Sysutils,Classes,HttpApp;
type
TCookieGenerator = class(TObject)
private
FName: string;
FValue: string;
FPath: string;
FDomain: string;
FExpires: TDateTime;
FSecure: Boolean;
FHttpOnly: Boolean;
protected
function GetHeaderValue: string;
public
property Name: string read FName write FName;
property Value: string read FValue write FValue;
property Domain: string read FDomain write FDomain;
property Path: string read FPath write FPath;
property Expires: TDateTime read FExpires write FExpires;
property Secure: Boolean read FSecure write FSecure;
property HttpOnly : Boolean read FHttpOnly write FHttpOnly;
property HeaderValue: string read GetHeaderValue;
end;
implementation
{ TCookieGenerator }
function TCookieGenerator.GetHeaderValue: string;
begin
Result := Format('%s=%s; ', [HTTPEncode(FName), HTTPEncode(FValue)]);
if Domain <> '' then
Result := Result + Format('domain=%s; ', [Domain]); { do not localize }
if Path <> '' then
Result := Result + Format('path=%s; ', [Path]); { do not localize }
if Expires > -1 then
Result := Result +
Format(FormatDateTime('"expires="' + sDateFormat + ' "GMT; "', Expires), { do not localize }
[DayOfWeekStr(Expires), MonthStr(Expires)]);
if Secure then Result := Result + 'secure; '; { do not localize }
if HttpOnly then Result := Result + 'HttpOnly'; { do not localize }
if Copy(Result, Length(Result) - 1, MaxInt) = '; ' then
SetLength(Result, Length(Result) - 2);
end;
end.
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
2183 次 |
| 最近记录: |