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