如何在 VBA 中设置和获取 JSESSIONID cookie？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/39709562/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to set and get JSESSIONID cookie in VBA?
提问by Tamara Aviv
I'm writing a VBA web service client in Excel 2010 using MSXML2.XMLHTTP60 for my Java REST web services hosted on Tomcat 8.5.5.
我正在使用 MSXML2.XMLHTTP60 在 Excel 2010 中为托管在 Tomcat 8.5.5 上的 Java REST Web 服务编写 VBA Web 服务客户端。
In VBA, I want to snag the string JSESSIONID=E4E7666024C56427645D65BEB49ADC11from a response and set it in a subsequent request.
(if Excel crashes, it seems that this cookie is lost and the user has to authenticate again. I want to set the last stored session ID for the user, so if the session is still alive on the server, they don't have to re-authenticate in the Excel client.)
在 VBA 中，我想JSESSIONID=E4E7666024C56427645D65BEB49ADC11从响应中获取字符串并将其设置在后续请求中。
（如果 Excel 崩溃，似乎这个 cookie 丢失了，用户必须再次进行身份验证。我想为用户设置最后存储的会话 ID，所以如果会话在服务器上仍然存在，他们不必在 Excel 客户端中重新进行身份验证。）
I saw some online resources according to which the following will pull the JSESSIONID cookie, but the last line always prints empty:
我在网上看到一些资源，根据下面的内容会拉取 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
When I print httpObj.GetAllResponseHeadersI do not see any headers that hold JSESSIONID.
当我打印时，httpObj.GetAllResponseHeaders我没有看到任何包含 JSESSIONID 的标题。
In the same resources, the following should set the desired cookie, but it doesn't (I print out the headers of the incoming request on the server and see that my attempt did not override the JSESSIONID value).
在相同的资源中，以下应该设置所需的 cookie，但它没有（我在服务器上打印出传入请求的标头，并看到我的尝试没有覆盖 JSESSIONID 值）。
httpObj.SetRequestHeader "Cookie", "JSESSIONID=blahblah"
I may be missing the mechanism for how JSESSIONED is transmitted, and how and when VBA pulls it and sets it.
我可能缺少 JSESSIONED 如何传输的机制，以及 VBA 如何以及何时提取和设置它。
采纳答案by Tamara Aviv
While omegastripes posted a great solution, I wanted to share the solution I ended up using.
虽然 omegastripes 发布了一个很好的解决方案，但我想分享我最终使用的解决方案。
The original MSXML2.XMLHTTP60 object I used does not support cookies. So instead I used WinHttp.WinHttpRequest.
我使用的原始 MSXML2.XMLHTTP60 对象不支持 cookie。所以我改用WinHttp.WinHttpRequest.
This requires adding a reference to your code: In VBA IDE go to Tools-->References and make sure that Microsoft WinHTPP.Services version xxxis selected.
这需要添加对您的代码的引用：在 VBA IDE 中，转到工具--> 引用并确保Microsoft WinHTPP.Services version xxx选中该引用。
Snagging the cookie:
抓住饼干：
Code that grabs the cookie and stores it (assuming an object httpObjof type WinHttp.WinHttpRequest):
获取 cookie 并存储它的代码（假设一个httpObj类型为 的对象WinHttp.WinHttpRequest）：
' Get the JESSIONID cookie
Dim strCookie As String
Dim jsessionidCookie As String
strCookie = httpObj.GetResponseHeader("Set-Cookie") ' --> "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly"
jsessionidCookie = GetJsessionIdCookie(strCookie) ' Strips to "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E"
'Store JSESSIONID cookie in the cache sheet
Where the procedure GetJsessionIdCookie is:
过程 GetJsessionIdCookie 在哪里：
' Takes a string of the form "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly"
' and returns only the portion "JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E"
Public Function GetJsessionIdCookie(setCookieStr As String) As String
'JSESSIONID=40DD2DFCAF24A2D64544F55194FCE04E;path=/pamsservices;HttpOnly
Dim jsessionidCookie As String
Dim words() As String
Dim word As Variant
words = Split(setCookieStr, ";")
For Each word In words
If InStr(1, word, "JSESSIONID") > 0 Then
jsessionidCookie = word
End If
Next word
GetJsessionIdCookie = jsessionidCookie
End Function
Setting the cookie:
设置cookie：
Here's the method that creates an WinHttp.WinHttpRequest object and sets the cookie that was previously stored:
这是创建 WinHttp.WinHttpRequest 对象并设置先前存储的 cookie 的方法：
Public Function GetHttpObj(httpMethod As String, uri As String, Optional async As Boolean = False, _
Optional setJessionId As Boolean = True, _
Optional contentType As String = "application/xml") As WinHttp.WinHttpRequest
Dim cacheUtils As New CCacheUtils
Dim httpObj As New WinHttp.WinHttpRequest
With httpObj
.Open httpMethod, uri, async
.SetRequestHeader "origin", "pamsXL"
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
.SetRequestHeader "Connection", "keep-alive"
.SetRequestHeader "Content-type", contentType
.SetRequestHeader "cache-control", "no-cache"
End With
' --- Pull stored cookie and attach to request ---
If setJessionId Then
httpObj.SetRequestHeader "Cookie", cacheUtils.GetCachedValue(wsJsessionidAddr)
End If
Set GetHttpObj = httpObj
End Function
Where CCacheUtilsis a class I implemented for storing and retrieving cached values such as the JSESSIONID cookie.
CCacheUtils我为存储和检索缓存值（例如 JSESSIONID cookie）而实现的类在哪里。
回答by omegastripes
Try to use MSXML2.ServerXMLHTTPto get control over cookies. The code below shows how to retrieve and parse cookies, and make request using that cookies:
尝试使用MSXML2.ServerXMLHTTP来控制 cookie。下面的代码显示了如何检索和解析 cookie，并使用该 cookie 发出请求：
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
You can see the result of cookies parsing in Locals window on breakpoint, first element contain nested array, representing JSESSIONID:
可以在断点的Locals窗口看到cookies解析的结果，第一个元素包含嵌套数组，代表JSESSIONID：
Generally the above example scrapes project names from http://energy.ehawaii.gov/epd/public/energy-projects-list.html(question):
通常，上面的示例从http://energy.ehawaii.gov/epd/public/energy-projects-list.html（问题）中抓取项目名称：
Another one example is for https://netforum.avectra.com/eweb/(question). Just add the below Sub:
另一个例子是https://netforum.avectra.com/eweb/（问题）。只需添加以下子：
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
You can also see the cookies in Locals window, either not JSESSIONID, but others showing the method:
您还可以在 Locals 窗口中看到 cookie，不是 JSESSIONID，而是显示方法的其他人：
Note it's simplified method, it parses all cookies regardless path, domain, Secure or HttpOnly options.
请注意，这是一种简化方法，它会解析所有 cookie，而不管路径、域、安全或 HttpOnly 选项。
回答by robots.txt
To get and set cookies on the fly, there is an easiest approach I've discovered lately. Here is how the implementation may be:
要即时获取和设置 cookie，我最近发现了一种最简单的方法。以下是实现方式：
Sub GetRequestHeaders()
Const URL$ = "https://finance.yahoo.com/quote/AAPL?p=AAPL"
Dim Http As New ServerXMLHTTP60, Html As New HTMLDocument, strCookie$
With Http
.Open "GET", URL, False
.send
strCookie = .getAllResponseHeaders
strCookie = Split(Split(strCookie, "Cookie:")(1), ";")(0)
.Open "GET", URL, False
.setRequestHeader "Cookie", Trim(strCookie)
.send
Html.body.innerHTML = .responseText
End With
MsgBox Html.querySelector("#quote-market-notice span").innerText
End Sub
