HTTPリクエストを投げて、レスポンスを受け取る vbscript

Excel郵便番号住所変換のHTTPリクエストをVBScriptで書いてみた

関連
ExcelのVBAでYahoo!路線情報からHTMLを取得して運賃を取得してみる
Excel 郵便番号→住所変換　MSXML2.XML HTTP.3.0

VBSCriptだけで書いてみる

BASP21を使った処理は書いた事があるが、標準機能だけで書いてみる。

サンプルはこれを使わせてもらいました。

改造は２点
１．一時ファイル名UUID化する。
２．バイナリ→テキスト変換はFunctionで完結する

UUIDの取得

VBSCriptの一時ファイル名取得(GetTempName)は重複が発生して、痛い思い出がある。その時の解決策は別であったが、今回はUUIDを使ってみた。これでも完全ではないらしい
UUID v4って規格？があるようで、同じ内容のサンプルが幾つかみつかったが今回はこちらを参考にした。

バイナリ→テキスト変換はFunctionで完結する

バイナリ情報を一時ファイルに書き込み、読み出しでテキスト変換するそうです。
この一時ファイル名を固定にしたくなかったので、UUIDを使ってみました。

'************************************************************
'関数ID ：binReadTextAll
'説明   ：バイナリデータをテキストで返す
'           responseText は、euc か utf-8 のページの場合 unicode として変換されます
'           Shift_Jis は、responseBody でいったんバイナリ保存してから、読み込む
'戻り値 ：バイナリデータのテキスト
'************************************************************
Function binReadTextAll(binData)
    Dim objFSO                                              'ファイルシステムオブジェクト
    Dim oStream                                             'ADODB.Streamオブジェクト
    Dim strTempFolder                                       '一時フォルダ名
    Dim strTempFile                                         '一時ファイル名
    Dim resStream                                           'テキストストリームオブジェクト

    Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

    strTempFile = objFSO.GetSpecialFolder(2)                '2:TemporaryFolder 特殊フォルダ 
    'strTempFile = strTempFile & "\"& objFSO.GetTempName()  '一時ファイル名 GetTempName では重複する場合がある
    strTempFile = strTempFile & "\"& UUID()             '一時ファイル名 

    Set oStream = CreateObject("ADODB.Stream")              '一時ファイルへバイナリデータを書き込む
    oStream.Open
    oStream.Type = 1                                        ' バイナリ
    oStream.Write binData
    oStream.SaveToFile strTempFile
    oStream.Close

    Set resStream = objFSO.OpenTextFile(strTempFile, 1)     '一時ファイルから読み出す
    binReadTextAll = resStream.ReadAll
    resStream.Close
    objFSO.DeleteFile strTempFile                           '一時ファイル削除

    Set resStream = Nothing
    Set oStream = Nothing
    Set objFSO = Nothing
End Function

HTTPリクエスト

HTTPリクエスト

' 参考先 https://necoyama3.hatenablog.com/entry/20090424/1240592349
'************************************************************
    Dim oXMLHTTP   ' MSXMLオブジェクト
    Dim resData    ' レスポンス

    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
    oXMLHTTP.Open "GET", URL, False                              ' FALSE:同期処理
    oXMLHTTP.Send                                                ' 受信

    If oXMLHTTP.Status = 200 Then
        resData = binReadTextAll(oXMLHTTP.responseBody)
        MsgBox resData
    Else
        resData = "Error returnCode:" & oXMLHTTP.Status
        MsgBox resData
    End If

    set oXMLHTTP = nothing

こんなテキストが取得できました。

物忘れ防止 VBScript MSXML2.XMLHTTP.3.0.vbs