如何在VBA中设置和获取JSESSIONID cookie？

Question

在VBA中，我希望从响应中截取字符串jsessionid=e4e7666024c56427645d65beb49adc11，并在随后的请求中设置它。
（如果Excel崩溃，这个cookie似乎丢失了，用户必须再次进行身份验证。我希望为用户设置最后存储的会话ID，这样如果会话在服务器上仍然有效，他们就不必在Excel客户机中重新进行身份验证。）

我看到了一些在线资源，根据这些资源，下面将拉出JSESSIONID cookie，但最后一行总是打印为空：

Dim httpObj As New MSXML2.XMLHTTP60
With httpObj
    .Open "POST", URL, False
    .SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    .SetRequestHeader "Connection", "keep-alive"
    .Send
End With
Debug.Print "Response header Cookie: " & httpObj.GetResponseHeader("Cookie")  'This should pull the JSESSIONID cookie but is empty

当我打印httpobj.getAllResponseHeaders时，我看不到任何包含JSessionID的头。

httpObj.SetRequestHeader "Cookie", "JSESSIONID=blahblah"

我可能缺少JSESSIONED如何传输的机制，以及VBA如何以及何时提取和设置它。

Answer 1

尝试使用msxml2.serverxmlhttp来控制cookie。下面的代码显示了如何检索和解析cookie，以及如何使用该cookies发出请求：

Option Explicit

Sub Test_ehawaii_gov()

    Dim sUrl, sRespHeaders, sRespText, aSetHeaders, aList

    ' example for https://energy.ehawaii.gov/epd/public/energy-projects-map.html
    ' get cookies
    sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-map.html"
    XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
    ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders
    ' get projects list
    sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-list.json?sEcho=2&iColumns=5&sColumns=&iDisplayStart=1&iDisplayLength=0&mDataProp_0=0&mDataProp_1=1&mDataProp_2=2&mDataProp_3=3&mDataProp_4=4&sSearch=&bRegex=false&sSearch_0=&bRegex_0=false&bSearchable_0=true&sSearch_1=&bRegex_1=false&bSearchable_1=true&sSearch_2=&bRegex_2=false&bSearchable_2=true&sSearch_3=&bRegex_3=false&bSearchable_3=true&sSearch_4=&bRegex_4=false&bSearchable_4=true&iSortCol_0=0&sSortDir_0=asc&iSortingCols=1&bSortable_0=true&bSortable_1=true&bSortable_2=true&bSortable_3=true&bSortable_4=true"
    XmlHttpRequest "GET", sUrl, aSetHeaders, "", "", sRespText
    ' parse project names
    ParseResponse "\[""([\s\S]*?)""", sRespText, aList
    Debug.Print Join(aList, vbCrLf)

End Sub

Sub XmlHttpRequest(sMethod, sUrl, aSetHeaders, sPayload, sRespHeaders, sRespText)
    Dim aHeader
    With CreateObject("MSXML2.ServerXMLHTTP")
        .SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
        .Open sMethod, sUrl, False
        For Each aHeader In aSetHeaders
            .SetRequestHeader aHeader(0), aHeader(1)
        Next
        .Send (sPayload)
        sRespHeaders = .GetAllResponseHeaders
        sRespText = .ResponseText
    End With
End Sub

Sub ParseResponse(sPattern, sResponse, aData)
    Dim oMatch, aTmp, sSubMatch
    aData = Array()
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = sPattern
        For Each oMatch In .Execute(sResponse)
            If oMatch.SubMatches.Count = 1 Then
                PushItem aData, oMatch.SubMatches(0)
            Else
                aTmp = Array()
                For Each sSubMatch In oMatch.SubMatches
                    PushItem aTmp, sSubMatch
                Next
                PushItem aData, aTmp
            End If
        Next
    End With
End Sub

Sub PushItem(aList, vItem)
    ReDim Preserve aList(UBound(aList) + 1)
    aList(UBound(aList)) = vItem
End Sub

您可以在断点的局部变量窗口中看到Cookie解析的结果，第一个元素包含嵌套数组，表示JSessionID：

通常，上面的示例从http://energy.ehawaii.gov/epd/public/energy-projects-list.html中删除项目名称（问题）：

Sub Test_avectra_com()

    Dim sUrl, sRespHeaders, sRespText, aSetHeaders

    ' example for https://netforum.avectra.com/eweb/
    sUrl = "https://netforum.avectra.com/eweb/DynamicPage.aspx?Site=NEFAR&WebCode=IndResult&FromSearchControl=Yes"
    XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
    ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders

End Sub