Internet explorer 我可以在ActiveX中使用IHTMLDocument2访问HttpOnly cookie吗？

我是否可以通过Internet Explorer 11中运行的ActiveX中的IHTMLDocument2:：cookie访问标记为HttpOnly的会话cookie？以下是源于以下内容的代码示例：

CComPtr pDoc//从事件中获取文档，如示例所示。
//读饼干
CComBSTR饼干；
hr=pDoc->get_cookie（&cookie）；

---

如果无法通过IHTMLDocument2访问在IE内部ActiveX中打开的网站的所有Cookie，是否有其他方法？

无法使用文档对象读取Cookie。因此，您需要在浏览器上下文之外读取cookie。有一个SO线程解释了如何做同样的事情

下面是答案中的VBA代码供参考

Option Explicit

Sub GetIECookies()

    Dim sCookiesPath As String
    Dim oCookies As Object
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile
    Dim sContent As String
    Dim a() As String
    Dim i As Long
    Dim aItems
    Dim aCookies()

    ' read IE cookie files
    sCookiesPath = CreateObject("shell.application").Namespace("shell:Cookies").self.Path
    Set oCookies = CreateObject("Scripting.Dictionary")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sCookiesPath)
    For Each oFile In oFolder.Files
        If LCase(oFSO.GetExtensionName(oFile.Name)) = "txt" Then
            With oFile.OpenAsTextStream(1, 0) ' read-only, ascii
                sContent = .ReadAll
                .Close
            End With
            sContent = Replace(sContent, vbCr, "")
            ' split cookies within file
            a = Split(sContent, vbLf & "*" & vbLf)
            For i = 0 To UBound(a) - 1
                oCookies.Add oCookies.Count, a(i)
            Next
        End If
    Next
    ' parse data, repack to 2d array
    aItems = oCookies.Items()
    If UBound(aItems) = -1 Then
        MsgBox "No cookies found"
    Else
        ReDim aCookies(1 To UBound(aItems) + 1, 1 To 6)
        For i = 1 To UBound(aItems) + 1
            a = Split(aItems(i - 1), vbLf)
            aCookies(i, 1) = a(0)
            aCookies(i, 2) = a(1)
            aCookies(i, 3) = a(2)
            aCookies(i, 4) = GetInetCookieFlags(a(3))
            aCookies(i, 5) = ConvDT(a(4), a(5))
            aCookies(i, 6) = ConvDT(a(6), a(7))
        Next
        ' output
        With ThisWorkbook.Sheets(1)
            .Cells.Delete
            .Range("A1:F1") = Array("Name", "Value", "Host/Path", "Flags", "Expiration", "Created")
            Output .Range("A2"), aCookies
        End With
    End If

End Sub

Function ConvDT(sLowNTFmt As String, sHighNTFmt As String) As Date

    Dim dNTFmt As Double
    Dim dUnixFmt As Double

    ' FILETIME format is the number of 100 nanosecond ticks since 00:00 1 Jan, 1601 (UTC).
    dNTFmt = sHighNTFmt * 4294967296# + sLowNTFmt
    ' Unix time format is the number of seconds since 00:00 1 Jan 1970
    dUnixFmt = 0.0000001 * dNTFmt - 11644473600#
    ' VB time format is the number of days since 00:00 1 Jan 1900
    ConvDT = CDate(dUnixFmt / 86400 + 25569)

End Function

Function GetInetCookieFlags(sFlags As String) As String

    Dim lFlags As Long
    Dim aFlag

    ' reset bit 32 to avoid overflow
    If sFlags >= 2147483648# Then lFlags = CLng(sFlags - 2147483648#) Else lFlags = CLng(sFlags)
    ' convert flags bits to string representation
    With CreateObject("Scripting.Dictionary")
        For Each aFlag In Array( _
            Array(&H1, "IS SECURE"), _
            Array(&H2, "IS SESSION"), _
            Array(&H10, "THIRD PARTY"), _
            Array(&H20, "PROMPT REQUIRED"), _
            Array(&H40, "EVALUATE P3P"), _
            Array(&H80, "APPLY P3P"), _
            Array(&H100, "P3P ENABLED"), _
            Array(&H200, "IS RESTRICTED"), _
            Array(&H400, "IE6"), _
            Array(&H800, "IS LEGACY"), _
            Array(&H1000, "NON SCRIPT"), _
            Array(&H2000, "HTTPONLY"), _
            Array(&H4000, "HOST ONLY"), _
            Array(&H8000, "APPLY HOST ONLY"), _
            Array(&H20000, "RESTRICTED ZONE"), _
            Array(&H20000000, "ALL COOKIES"), _
            Array(&H40000000, "NO CALLBACK"), _
            Array(&H80000000, "ECTX 3RDPARTY") _
        )
            If lFlags And aFlag(0) Then .Add .Count, aFlag(1)
        Next
        GetInetCookieFlags = Join(.Items(), vbCrLf)
    End With

End Function

Sub Output(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
            UBound(aCells, 1) - LBound(aCells, 1) + 1, _
            UBound(aCells, 2) - LBound(aCells, 2) + 1 _
        )
            .NumberFormat = "@"
            .Value = aCells
            .Columns.AutoFit
        End With
    End With

End Sub

---

当然，如果您想在那里使用它，您需要将它移植到VC++代码中

，因此您已经测试了代码，但它没有为您提供仅HTTP的cookie，或者您还没有进行测试仔细阅读这篇文章。这可能适用于较低版本的浏览器。我认为这应该可以帮助您解决问题。我想这段代码是在2017年及更早版本的Windows上测试的。2018年，Windows收到一个更新，其中重新设计了Cookie存储，特别是为了避免将其存储在文件中。在最新的Windows版本中无法使用此方法。

Option Explicit

Sub GetIECookies()

    Dim sCookiesPath As String
    Dim oCookies As Object
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile
    Dim sContent As String
    Dim a() As String
    Dim i As Long
    Dim aItems
    Dim aCookies()

    ' read IE cookie files
    sCookiesPath = CreateObject("shell.application").Namespace("shell:Cookies").self.Path
    Set oCookies = CreateObject("Scripting.Dictionary")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sCookiesPath)
    For Each oFile In oFolder.Files
        If LCase(oFSO.GetExtensionName(oFile.Name)) = "txt" Then
            With oFile.OpenAsTextStream(1, 0) ' read-only, ascii
                sContent = .ReadAll
                .Close
            End With
            sContent = Replace(sContent, vbCr, "")
            ' split cookies within file
            a = Split(sContent, vbLf & "*" & vbLf)
            For i = 0 To UBound(a) - 1
                oCookies.Add oCookies.Count, a(i)
            Next
        End If
    Next
    ' parse data, repack to 2d array
    aItems = oCookies.Items()
    If UBound(aItems) = -1 Then
        MsgBox "No cookies found"
    Else
        ReDim aCookies(1 To UBound(aItems) + 1, 1 To 6)
        For i = 1 To UBound(aItems) + 1
            a = Split(aItems(i - 1), vbLf)
            aCookies(i, 1) = a(0)
            aCookies(i, 2) = a(1)
            aCookies(i, 3) = a(2)
            aCookies(i, 4) = GetInetCookieFlags(a(3))
            aCookies(i, 5) = ConvDT(a(4), a(5))
            aCookies(i, 6) = ConvDT(a(6), a(7))
        Next
        ' output
        With ThisWorkbook.Sheets(1)
            .Cells.Delete
            .Range("A1:F1") = Array("Name", "Value", "Host/Path", "Flags", "Expiration", "Created")
            Output .Range("A2"), aCookies
        End With
    End If

End Sub

Function ConvDT(sLowNTFmt As String, sHighNTFmt As String) As Date

    Dim dNTFmt As Double
    Dim dUnixFmt As Double

    ' FILETIME format is the number of 100 nanosecond ticks since 00:00 1 Jan, 1601 (UTC).
    dNTFmt = sHighNTFmt * 4294967296# + sLowNTFmt
    ' Unix time format is the number of seconds since 00:00 1 Jan 1970
    dUnixFmt = 0.0000001 * dNTFmt - 11644473600#
    ' VB time format is the number of days since 00:00 1 Jan 1900
    ConvDT = CDate(dUnixFmt / 86400 + 25569)

End Function

Function GetInetCookieFlags(sFlags As String) As String

    Dim lFlags As Long
    Dim aFlag

    ' reset bit 32 to avoid overflow
    If sFlags >= 2147483648# Then lFlags = CLng(sFlags - 2147483648#) Else lFlags = CLng(sFlags)
    ' convert flags bits to string representation
    With CreateObject("Scripting.Dictionary")
        For Each aFlag In Array( _
            Array(&H1, "IS SECURE"), _
            Array(&H2, "IS SESSION"), _
            Array(&H10, "THIRD PARTY"), _
            Array(&H20, "PROMPT REQUIRED"), _
            Array(&H40, "EVALUATE P3P"), _
            Array(&H80, "APPLY P3P"), _
            Array(&H100, "P3P ENABLED"), _
            Array(&H200, "IS RESTRICTED"), _
            Array(&H400, "IE6"), _
            Array(&H800, "IS LEGACY"), _
            Array(&H1000, "NON SCRIPT"), _
            Array(&H2000, "HTTPONLY"), _
            Array(&H4000, "HOST ONLY"), _
            Array(&H8000, "APPLY HOST ONLY"), _
            Array(&H20000, "RESTRICTED ZONE"), _
            Array(&H20000000, "ALL COOKIES"), _
            Array(&H40000000, "NO CALLBACK"), _
            Array(&H80000000, "ECTX 3RDPARTY") _
        )
            If lFlags And aFlag(0) Then .Add .Count, aFlag(1)
        Next
        GetInetCookieFlags = Join(.Items(), vbCrLf)
    End With

End Function

Sub Output(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
            UBound(aCells, 1) - LBound(aCells, 1) + 1, _
            UBound(aCells, 2) - LBound(aCells, 2) + 1 _
        )
            .NumberFormat = "@"
            .Value = aCells
            .Columns.AutoFit
        End With
    End With

End Sub