web-dev-qa-db-ja.com

VBAでJSESSIONIDCookieを設定および取得する方法は？

Tomcat8.5.5でホストされているWebサービスのJava REST WebサービスにMSXML2.XMLHTTP60を使用してExcel2010でVBAWebサービスクライアントを作成しています。

VBAで、応答から文字列JSESSIONID=E4E7666024C56427645D65BEB49ADC11を取得し、後続の要求で設定したいと思います。
（Excelがクラッシュした場合、このCookieは失われ、ユーザーは再度認証する必要があるようです。ユーザーの最後に保存されたセッションIDを設定したいので、セッションがサーバー上でまだ存続している場合は、 Excelクライアントで再認証する必要はありません。）

以下がJSESSIONIDcookieをプルするオンラインリソースをいくつか見ましたが、最後の行は常に空で出力されます。

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を保持するヘッダーが表示されません。

同じリソースで、以下は目的のCookieを設定する必要がありますが、設定されません（サーバーで着信要求のヘッダーを出力し、試みがJSESSIONID値をオーバーライドしなかったことを確認します）。

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

JSESSIONEDが送信される方法、およびVBAがそれをプルして設定する方法とタイミングのメカニズムが欠落している可能性があります。

vbaweb-servicescookiessession-cookiesjsessionid
6
Tamara Aviv

Omegastripesは素晴らしいソリューションを投稿しましたが、私は最終的に使用したソリューションを共有したいと思いました。

私が使用した元のMSXML2.XMLHTTP60オブジェクトはCookieをサポートしていません。代わりにWinHttp.WinHttpRequestを使用しました。

これには、コードへの参照を追加する必要があります。VBAIDE [ツール]-> [参照]に移動し、Microsoft WinHTPP.Services version xxxが選択されていることを確認します。

クッキーを引っ掛ける：

Cookieを取得して保存するコード（タイプWinHttp.WinHttpRequestのオブジェクトhttpObjを想定）：

' 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

プロシージャ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

クッキーの設定：

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

ここで、CCacheUtilsは、JSESSIONIDCookieなどのキャッシュされた値を格納および取得するために実装したクラスです。

4
Tamara Aviv

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

ブレークポイントの[ローカル]ウィンドウでCookieの解析結果を確認できます。最初の要素には、JSESSIONIDを表すネストされた配列が含まれています。

locals

一般に、上記の例では、プロジェクト名を http://energy.ehawaii.gov/epd/public/energy-projects-list.html （ question ）から取得します。

screenshot_projects

もう1つの例は、 https://netforum.avectra.com/eweb/ （ question ）です。以下のサブを追加するだけです。

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

[ローカル]ウィンドウにも、JSESSIONIDではなく、メソッドを示す他のCookieが表示されます。

locals

簡略化された方法であることに注意してください。パス、ドメイン、セキュア、またはHttpOnlyオプションに関係なく、すべてのCookieを解析します。

9
omegastripes

その場で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
3
robots.txt