经典 Asp cookie 过期日期并不总是得到设置
Classic Asp cookie expires date does not always get set
我正在尝试使用经典 Asp 中的 addheader 方法设置 cookie,这是向 cookie 添加 HttpOnly 和 Secure 标志等的唯一方法。全部使用以下代码 - 但有一个例外,它是过期 date/time.
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & dateAdd("d", 365, Now()) & ";samesite=Strict;HostOnly"
%>
不过,这似乎是与浏览器相关的问题。在 firefox 中,我可以在开发人员工具的存储选项卡中看到设置了过期时间。但在 Chrome 中,它始终保持为默认值,即会话结束时到期。 Edge 也存在同样的问题。
有人遇到过这个问题吗?
预期的日期格式已记录 here。您需要以这种方式生成到期日期。
在经典 ASP 中,您可以使用服务器端 JavaScript 轻松生成此类日期。
<!--#include file="HTTPDate.asp"-->
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & HTTPDate(DateAdd("d", 365, Now())) & ";samesite=Strict;HostOnly"
%>
HTTPDate.asp
<script language="javascript" runat="server">
function HTTPDate(vbsDate){
return (new Date(vbsDate)).toGMTString().replace(/UTC/, "GMT");
}
</script>
编辑:添加了纯 VBScript 解决方案。
<%
Function CurrentTZO()
With CreateObject("WScript.Shell")
CurrentTZO = .RegRead( _
"HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
End With
End Function
Function Pad(text)
Pad = Right("00" & text, 2)
End Function
Function HTTPDate(ByVal localDate)
localDate = DateAdd("n", CurrentTZO(), localDate)
' WeekdayName and MonthName functions relies on locale
' need to produce day and month name abbreviations in en-US locale
Dim locale : locale = SetLocale("en-US")
Dim out(5)
out(0) = WeekdayName(Weekday(localDate), True) & ","
out(1) = Pad(Day(localDate))
out(2) = MonthName(Month(localDate), True)
out(3) = Year(localDate)
out(4) = Join(Array(Pad(Hour(localDate)), Pad(Minute(localDate)), Pad(Second(localDate))), ":")
out(5) = "GMT"
SetLocale locale ' set original locale back
HTTPDate = Join(out, " ")
End Function
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & HTTPDate(DateAdd("d", 365, Now())) & ";samesite=Strict;HostOnly"
%>
除了公认的 Kul-Tigin 解决方案之外,我还想为那些也缺少该解决方案的人添加一个 vbscript 解决方案。
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & (New UTC).toUTCString(500,"d") & ";samesite=Strict;HostOnly;"
Class UTC
Public Function toUTCString(ByVal offSet, ByVal offsetType)
' ***********************************
' Converts vbScript datetime format to
' Universal datetime string format:
' Tue, 16 Feb 2021 13:39:24 GMT
'************************************
Dim dt: dt = dateAdd(offsetType, offSet, UTCDate(Now()))
Dim tdParts: tdParts = Split(dt, " ")
Dim tPart: tPart = CDate(tdParts(1) & " " & tdParts(2))
Dim dPart: dPart = CDate(tdParts(0))
Dim timeTo24: timeTo24 = _
Right("0" & Hour(tPart), 2) & ":" & _
Right("0" & Minute(tPart), 2) & ":" & _
Right("0" & Second(tPart), 2)
toUTCString = WeekdayName(Weekday(dPart), True) & ", " & _
Day(dPart) & " " & _
MonthName(Month(dPart), True) & " " & _
Year(dPart) & " " & _
timeTo24 & " GMT"
End Function
Public Function UTCDate(ByVal dtDate)
If Not IsDate(dtDate) Then Err.Raise 5
dtDate = CDate(dtDate)
Dim ZoneBias: ZoneBias = TimeZoneBias()
If IsPDT(Now) <> IsPDT(dtDate) Then
ZoneBias = ZoneBias - 60
End If
UTCDate = DateAdd("n", ZoneBias, dtDate)
End Function
Private Function IsPDT(ByVal dtDate)
If Not IsDate(dtDate) Then Err.Raise 5
dtDate = CDate(dtDate)
Dim pdtLow, pdtUpr, nDaysBack
pdtLow = DateSerial(Year(dtDate), 3, 31)
pdtUpr = DateSerial(Year(dtDate), 10, 31)
pdtLow = DateAdd("h", 2, pdtLow)
pdtUpr = DateAdd("h", 2, pdtUpr)
nDaysBack = Weekday(pdtLow) - 1
If nDaysBack <> 0 Then
pdtLow = DateAdd("d", -nDaysBack, pdtLow)
End If
nDaysBack = Weekday(pdtUpr) - 1
If nDaysBack <> 0 Then
pdtUpr = DateAdd("d", -nDaysBack, pdtUpr)
End If
IsPDT = (dtDate >= pdtLow And dtDate <= pdtUpr)
End Function
Private Function TimeZoneBias()
Dim LTZone
With GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\.\root\cimv2")
For Each LTZone In .ExecQuery(_
"Select * From Win32_ComputerSystem")
TimeZoneBias = LTZone.CurrentTimeZone
Next
End With
TimeZoneBias = TimeZoneBias * -1
End Function
End Class
%>
我正在尝试使用经典 Asp 中的 addheader 方法设置 cookie,这是向 cookie 添加 HttpOnly 和 Secure 标志等的唯一方法。全部使用以下代码 - 但有一个例外,它是过期 date/time.
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & dateAdd("d", 365, Now()) & ";samesite=Strict;HostOnly"
%>
不过,这似乎是与浏览器相关的问题。在 firefox 中,我可以在开发人员工具的存储选项卡中看到设置了过期时间。但在 Chrome 中,它始终保持为默认值,即会话结束时到期。 Edge 也存在同样的问题。
有人遇到过这个问题吗?
预期的日期格式已记录 here。您需要以这种方式生成到期日期。
在经典 ASP 中,您可以使用服务器端 JavaScript 轻松生成此类日期。
<!--#include file="HTTPDate.asp"-->
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & HTTPDate(DateAdd("d", 365, Now())) & ";samesite=Strict;HostOnly"
%>
HTTPDate.asp
<script language="javascript" runat="server">
function HTTPDate(vbsDate){
return (new Date(vbsDate)).toGMTString().replace(/UTC/, "GMT");
}
</script>
编辑:添加了纯 VBScript 解决方案。
<%
Function CurrentTZO()
With CreateObject("WScript.Shell")
CurrentTZO = .RegRead( _
"HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
End With
End Function
Function Pad(text)
Pad = Right("00" & text, 2)
End Function
Function HTTPDate(ByVal localDate)
localDate = DateAdd("n", CurrentTZO(), localDate)
' WeekdayName and MonthName functions relies on locale
' need to produce day and month name abbreviations in en-US locale
Dim locale : locale = SetLocale("en-US")
Dim out(5)
out(0) = WeekdayName(Weekday(localDate), True) & ","
out(1) = Pad(Day(localDate))
out(2) = MonthName(Month(localDate), True)
out(3) = Year(localDate)
out(4) = Join(Array(Pad(Hour(localDate)), Pad(Minute(localDate)), Pad(Second(localDate))), ":")
out(5) = "GMT"
SetLocale locale ' set original locale back
HTTPDate = Join(out, " ")
End Function
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & HTTPDate(DateAdd("d", 365, Now())) & ";samesite=Strict;HostOnly"
%>
除了公认的 Kul-Tigin 解决方案之外,我还想为那些也缺少该解决方案的人添加一个 vbscript 解决方案。
<%
Response.AddHeader "Set-Cookie", "testCookie=2000; path=/;HttpOnly;Secure;expires=" & (New UTC).toUTCString(500,"d") & ";samesite=Strict;HostOnly;"
Class UTC
Public Function toUTCString(ByVal offSet, ByVal offsetType)
' ***********************************
' Converts vbScript datetime format to
' Universal datetime string format:
' Tue, 16 Feb 2021 13:39:24 GMT
'************************************
Dim dt: dt = dateAdd(offsetType, offSet, UTCDate(Now()))
Dim tdParts: tdParts = Split(dt, " ")
Dim tPart: tPart = CDate(tdParts(1) & " " & tdParts(2))
Dim dPart: dPart = CDate(tdParts(0))
Dim timeTo24: timeTo24 = _
Right("0" & Hour(tPart), 2) & ":" & _
Right("0" & Minute(tPart), 2) & ":" & _
Right("0" & Second(tPart), 2)
toUTCString = WeekdayName(Weekday(dPart), True) & ", " & _
Day(dPart) & " " & _
MonthName(Month(dPart), True) & " " & _
Year(dPart) & " " & _
timeTo24 & " GMT"
End Function
Public Function UTCDate(ByVal dtDate)
If Not IsDate(dtDate) Then Err.Raise 5
dtDate = CDate(dtDate)
Dim ZoneBias: ZoneBias = TimeZoneBias()
If IsPDT(Now) <> IsPDT(dtDate) Then
ZoneBias = ZoneBias - 60
End If
UTCDate = DateAdd("n", ZoneBias, dtDate)
End Function
Private Function IsPDT(ByVal dtDate)
If Not IsDate(dtDate) Then Err.Raise 5
dtDate = CDate(dtDate)
Dim pdtLow, pdtUpr, nDaysBack
pdtLow = DateSerial(Year(dtDate), 3, 31)
pdtUpr = DateSerial(Year(dtDate), 10, 31)
pdtLow = DateAdd("h", 2, pdtLow)
pdtUpr = DateAdd("h", 2, pdtUpr)
nDaysBack = Weekday(pdtLow) - 1
If nDaysBack <> 0 Then
pdtLow = DateAdd("d", -nDaysBack, pdtLow)
End If
nDaysBack = Weekday(pdtUpr) - 1
If nDaysBack <> 0 Then
pdtUpr = DateAdd("d", -nDaysBack, pdtUpr)
End If
IsPDT = (dtDate >= pdtLow And dtDate <= pdtUpr)
End Function
Private Function TimeZoneBias()
Dim LTZone
With GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\.\root\cimv2")
For Each LTZone In .ExecQuery(_
"Select * From Win32_ComputerSystem")
TimeZoneBias = LTZone.CurrentTimeZone
Next
End With
TimeZoneBias = TimeZoneBias * -1
End Function
End Class
%>