質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Win32 API

Win32 APIはMicrosoft Windowsの32bitプロセッサのOSで動作するAPIです。

Q&A

解決済

1回答

1843閲覧

VBAでWinHttpAPIを使用しWebSocketにアップグレードができない

0240

総合スコア11

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Win32 API

Win32 APIはMicrosoft Windowsの32bitプロセッサのOSで動作するAPIです。

0グッド

0クリップ

投稿2022/05/14 19:48

【実現したいこと】
VBAでWinHttp関連のAPIを使用して、HTTP通信→WebSocket通信にアップグレードしたい。

【行き詰まっている箇所】
下記の順序・・・
①WinHttpOpen→②WinHttpConnect→③WinHttpOpenRequest
→④WinHttpSetOption→⑤WinHttpSendRequest
→⑥WinHttpReceiveResponse→⑦WinHttpQueryHeaders
・・・でAPIを呼び出し。
⑦WinHttpQueryHeadersで、レスポンスのステータスコードを確認するが
200で返ってくる。
(この後、WebSocketへアップグレードするためには101であることが必要)
MSDNを調べたりしてAPI宣言やコードをいじるも、101が返ってこず、解決策がみつけられない。

【ソース】

VBA

1'API宣言============================ 2Public Const ERROR_SUCCESS = 0 3 4Public Declare PtrSafe Function WinHttpOpen Lib "WinHttp" ( _ 5 ByVal pszAgentW As LongPtr, _ 6 ByVal dwAccessType As Long, _ 7 ByVal pszProxyW As LongPtr, _ 8 ByVal pszProxyBypassW As LongPtr, _ 9 ByVal dwFlags As Long _ 10 ) As LongPtr 11Public Const WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0 12Public Const WINHTTP_FLAG_SYNC = &H0 13 14 15Public Declare PtrSafe Function WinHttpConnect Lib "WinHttp" ( _ 16 ByVal hSession As LongPtr, _ 17 ByVal pswzServerName As LongPtr, _ 18 ByVal nServerPort As Long, _ 19 ByVal dwReserved As Long _ 20 ) As LongPtr 21Public Const INTERNET_DEFAULT_HTTP_PORT = 80 22Public Const INTERNET_DEFAULT_HTTPS_PORT = 443 23 24 25Public Declare PtrSafe Function WinHttpOpenRequest Lib "WinHttp" ( _ 26 ByVal hConnect As LongPtr, _ 27 ByVal pwszVerb As LongPtr, _ 28 ByVal pwszObjectName As LongPtr, _ 29 ByVal pwszVersion As LongPtr, _ 30 ByVal pwszReferrer As LongPtr, _ 31 ByVal ppwszAcceptTypes As LongPtr, _ 32 ByVal dwFlags As Long _ 33 ) As LongPtr 34 35 36Public Declare PtrSafe Function WinHttpSetOption Lib "WinHttp" ( _ 37 ByVal HINTERNET As LongPtr, _ 38 ByVal dwOption As Long, _ 39 ByVal lpBuffer As LongPtr, _ 40 ByVal dwBufferLength As Long _ 41 ) As Long 42Public Const WINHTTP_OPTION_UPGRADE_TO_WEB_SOCKET = 114 43 44 45Public Declare PtrSafe Function WinHttpAddRequestHeaders Lib "WinHttp" ( _ 46 hRequest As LongPtr, _ 47 lpszHeaders As LongPtr, _ 48 dwHeadersLength As Long, _ 49 dwModifiers As Long _ 50) As Boolean 51Public Const WINHTTP_ADDREQ_FLAG_ADD = &H20000000 52Public Const WINHTTP_ADDREQ_FLAG_REPLACE = &H80000000 53Public Const WINHTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000 54 55 56Public Declare PtrSafe Function WinHttpSendRequest Lib "WinHttp" ( _ 57 ByVal hRequest As LongPtr, _ 58 ByVal lpszHeaders As LongPtr, _ 59 ByVal dwHeadersLength As Long, _ 60 ByVal lpOptional As LongPtr, _ 61 ByVal dwOptionalLength As Long, _ 62 ByVal dwTotalLength As Long, _ 63 ByVal dwContext As Long _ 64 ) As Long 65Public Const WINHTTP_NO_ADDITIONAL_HEADERS = 0 66 67 68Public Declare PtrSafe Function WinHttpReceiveResponse Lib "WinHttp" ( _ 69 ByVal hRequest As LongPtr, _ 70 ByVal lpReserved As LongPtr _ 71 ) As Long 72 73 74Public Declare PtrSafe Function WinHttpQueryHeaders Lib "WinHttp" ( _ 75 ByVal hRequest As LongPtr, _ 76 ByVal dwInfoLevel As Long, _ 77 ByVal pwszName As LongPtr, _ 78 ByRef lpBuffer As Long, _ 79 ByRef lpdwBufferLength As Long, _ 80 ByRef lpdwIndex As Long _ 81 ) As Long 82Public Const WINHTTP_QUERY_STATUS_CODE = 19 83Public Const WINHTTP_QUERY_FLAG_NUMBER = &H20000000 84Public Const WINHTTP_HEADER_NAME_BY_INDEX = 0 85Public Const WINHTTP_NO_HEADER_INDEX = 0 86Public Const WINHTTP_NO_REQUEST_DATA = 0 87 88 89Public Declare PtrSafe Function WinHttpWebSocketCompleteUpgrade Lib "WinHttp" ( _ 90 ByVal hRequest As LongPtr, _ 91 ByVal pContext As LongPtr _ 92 ) As LongPtr 93 94 95Public Declare PtrSafe Function WinHttpCloseHandle Lib "WinHttp" ( _ 96 ByVal hRequest As LongPtr _ 97 ) As Long

VBA

1'以下コード============================ 2Sub Main() 3 Dim dwError As Long 4 dwError = ERROR_SUCCESS 5 6 ' Http初期化、Httpセッションハンドル取得 7 Dim AgentHeader As String: AgentHeader = "WebsocketTest" 8 Dim hSessionHandle As LongPtr 9 hSessionHandle = WinHttpOpen(StrPtr(AgentHeader), _ 10 WINHTTP_ACCESS_TYPE_DEFAULT_PROXY, 0, 0, 0) 11 If hSessionHandle = 0 Then 12 dwError = Err.LastDllError 13 GoTo quit 14 End If 15 16 ' Http接続、Httpコネクションハンドル取得 17 Dim ServerName As String: ServerName = "echo.websocket.org" 18 Dim Port As Long: Port = INTERNET_DEFAULT_HTTP_PORT ' 80 19 Dim hConnectionHandle As LongPtr 20 hConnectionHandle = WinHttpConnect(hSessionHandle, StrPtr(ServerName), Port, 0) 21 If hConnectionHandle = 0 Then 22 dwError = Err.LastDllError 23 GoTo quit 24 End If 25 26 'Httpリクエストハンドル取得 27 Dim method As String: method = "GET" 28 Dim Path As String: Path = "/" 29 Dim hRequestHandle As LongPtr 30 hRequestHandle = WinHttpOpenRequest(hConnectionHandle, StrPtr(method), StrPtr(Path), 0, 0, 0, 0) 31 If hRequestHandle = 0 Then 32 dwError = Err.LastDllError 33 GoTo quit 34 End If 35 36 'リクエストハンドルに、http→websocketにアップグレードするオプション設定。 37 Dim result As Long 38 result = False 39 result = WinHttpSetOption(hRequestHandle, WINHTTP_OPTION_UPGRADE_TO_WEB_SOCKET, 0, 0) 40 If (result = 0) Then 41 dwError = Err.LastDllError 42 GoTo quit 43 End If 44 45 'サーバーにアップグレードリクエストを送信 46 result = WinHttpSendRequest(hRequestHandle, WINHTTP_NO_ADDITIONAL_HEADERS, _ 47 0, WINHTTP_NO_REQUEST_DATA, 0, 0, 0) 48 If (result = 0) Then 49 dwError = Err.LastDllError 50 GoTo quit 51 End If 52 53 'サーバーからのレスポンス受信 54 result = WinHttpReceiveResponse(hRequestHandle, 0) 55 If (result = 0) Then 56 dwError = Err.LastDllError 57 GoTo quit 58 End If 59 60 ' HTTPレスポンスのステータスコードを確認。101=アップグレード。 61 Dim dwStatusCode As Long 'ステータスコード用バッファ 62 Dim sizeStatusCode As Long: sizeStatusCode = 4 '4 バイト 63 result = WinHttpQueryHeaders(hRequestHandle, _ 64 (WINHTTP_QUERY_STATUS_CODE Or WINHTTP_QUERY_FLAG_NUMBER), _ 65 WINHTTP_HEADER_NAME_BY_INDEX, _ 66 dwStatusCode, sizeStatusCode, WINHTTP_NO_HEADER_INDEX) 67 If (result = 0) Then 68 dwError = Err.LastDllError 69 GoTo quit 70 End If 71 If dwStatusCode <> 101 Then 72 Debug.Print "ステータス" & dwStatusCode & ":101以外終了" 73 GoTo quit 74 End If 75 76 ' websocketへのハンドルを取得。 77 Dim hWebSocketHandle As LongPtr 78 hWebSocketHandle = WinHttpWebSocketCompleteUpgrade(hRequestHandle, 0) 79 If hWebSocketHandle = 0 Then 80 dwError = Err.LastDllError 81 GoTo quit 82 End If 83 84 ' リクエストハンドル不要なため閉じる。今後ウェブソケットハンドルを使用。 85 WinHttpCloseHandle (hRequestHandle) 86 hRequestHandle = 0 87 Debug.Print "Upgrade成功: " & ServerName & ":" & Port & Path 88exit sub 89 90quit: 91 If (hWebSocketHandle <> 0) Then 92 WinHttpCloseHandle (hWebSocketHandle) 93 hWebSocketHandle = 0 94 End If 95 If (hRequestHandle <> 0) Then 96 WinHttpCloseHandle (hRequestHandle) 97 hRequestHandle = 0 98 End If 99 If (hConnectionHandle <> 0) Then 100 WinHttpCloseHandle (hConnectionHandle) 101 hConnectionHandle = 0 102 End If 103 If (hSessionHandle <> 0) Then 104 WinHttpCloseHandle (hSessionHandle) 105 hSessionHandle = 0 106 End If 107 If (dwError <> ERROR_SUCCESS) Then 108 Debug.Print "error: " & dwError 109 End If 110 111End Sub 112

【試した事】
MSDNをDeepLで翻訳しながら読み込み、リクエストヘッダーが足りないのだろうか?と考え
④WinHttpSetOptionと⑤WinHttpSendRequestの間に
以下コードを挿入するも
各WinHttpAddRequestHeaders呼出しで失敗。(エラー番号87)

VBA

1 Dim HeaderTextLength As Long 2 HeaderTextLength = -1 3 Dim HeaderText As String: HeaderText = "" 4 5 HeaderText = "Host: " & ServerName 6 result = WinHttpAddRequestHeaders(hRequestHandle, _ 7 StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) 8 Debug.Print Err.LastDllError 9 10 HeaderText = "Upgrade: websocket" 11 result = WinHttpAddRequestHeaders(hRequestHandle, _ 12 StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) 13 Debug.Print Err.LastDllError 14 15 HeaderText = "Connection: upgrade" 16 result = WinHttpAddRequestHeaders(hRequestHandle, _ 17 StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) 18 Debug.Print Err.LastDllError 19 20 HeaderText = "Sec-WebSocket-Version: 13" 21 result = WinHttpAddRequestHeaders(hRequestHandle, _ 22 StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) 23 Debug.Print Err.LastDllError 24 HeaderText = "Sec-Websocket-Protocol: echo-protocol" 25 result = WinHttpAddRequestHeaders(hRequestHandle, _ 26 StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) 27 Debug.Print Err.LastDllError 28 29 HeaderText = "Sec-Websocket-Protocol: echo-protocol" 30 result = WinHttpAddRequestHeaders(hRequestHandle, _ 31 StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) 32 Debug.Print Err.LastDllError

【環境】
Windows10
Excel2019

どこがまずいのか突き止めることができず、行き詰っておりまして、何かご存じの方いらっしゃいましたら、ご教示いただけないでしょうか?
よろしくお願いいたします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0240

2022/05/15 04:52

【試した事】で記載しました「各WinHttpAddRequestHeaders呼出しで失敗。(エラー番号87)」については、単純にAPI宣言の引数にByVal付け忘れが原因で、修正したらエラーはなくなりました。 ただ、返ってくるステータスコードは200で変わらず、まだ行き詰っている状況です・・・。
guest

回答1

0

自己解決

解決しました。
とても馬鹿らしい理由ですが、単純にテストで使用していた接続先が間違っていただけでした・・・。

投稿2022/05/15 14:11

0240

総合スコア11

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問