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

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

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

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

Win32 API

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

解決済

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

0240
0240

総合スコア11

VBA

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

Win32 API

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

1回答

0評価

0クリップ

168閲覧

投稿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

'API宣言============================ Public Const ERROR_SUCCESS = 0 Public Declare PtrSafe Function WinHttpOpen Lib "WinHttp" ( _ ByVal pszAgentW As LongPtr, _ ByVal dwAccessType As Long, _ ByVal pszProxyW As LongPtr, _ ByVal pszProxyBypassW As LongPtr, _ ByVal dwFlags As Long _ ) As LongPtr Public Const WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0 Public Const WINHTTP_FLAG_SYNC = &H0 Public Declare PtrSafe Function WinHttpConnect Lib "WinHttp" ( _ ByVal hSession As LongPtr, _ ByVal pswzServerName As LongPtr, _ ByVal nServerPort As Long, _ ByVal dwReserved As Long _ ) As LongPtr Public Const INTERNET_DEFAULT_HTTP_PORT = 80 Public Const INTERNET_DEFAULT_HTTPS_PORT = 443 Public Declare PtrSafe Function WinHttpOpenRequest Lib "WinHttp" ( _ ByVal hConnect As LongPtr, _ ByVal pwszVerb As LongPtr, _ ByVal pwszObjectName As LongPtr, _ ByVal pwszVersion As LongPtr, _ ByVal pwszReferrer As LongPtr, _ ByVal ppwszAcceptTypes As LongPtr, _ ByVal dwFlags As Long _ ) As LongPtr Public Declare PtrSafe Function WinHttpSetOption Lib "WinHttp" ( _ ByVal HINTERNET As LongPtr, _ ByVal dwOption As Long, _ ByVal lpBuffer As LongPtr, _ ByVal dwBufferLength As Long _ ) As Long Public Const WINHTTP_OPTION_UPGRADE_TO_WEB_SOCKET = 114 Public Declare PtrSafe Function WinHttpAddRequestHeaders Lib "WinHttp" ( _ hRequest As LongPtr, _ lpszHeaders As LongPtr, _ dwHeadersLength As Long, _ dwModifiers As Long _ ) As Boolean Public Const WINHTTP_ADDREQ_FLAG_ADD = &H20000000 Public Const WINHTTP_ADDREQ_FLAG_REPLACE = &H80000000 Public Const WINHTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000 Public Declare PtrSafe Function WinHttpSendRequest Lib "WinHttp" ( _ ByVal hRequest As LongPtr, _ ByVal lpszHeaders As LongPtr, _ ByVal dwHeadersLength As Long, _ ByVal lpOptional As LongPtr, _ ByVal dwOptionalLength As Long, _ ByVal dwTotalLength As Long, _ ByVal dwContext As Long _ ) As Long Public Const WINHTTP_NO_ADDITIONAL_HEADERS = 0 Public Declare PtrSafe Function WinHttpReceiveResponse Lib "WinHttp" ( _ ByVal hRequest As LongPtr, _ ByVal lpReserved As LongPtr _ ) As Long Public Declare PtrSafe Function WinHttpQueryHeaders Lib "WinHttp" ( _ ByVal hRequest As LongPtr, _ ByVal dwInfoLevel As Long, _ ByVal pwszName As LongPtr, _ ByRef lpBuffer As Long, _ ByRef lpdwBufferLength As Long, _ ByRef lpdwIndex As Long _ ) As Long Public Const WINHTTP_QUERY_STATUS_CODE = 19 Public Const WINHTTP_QUERY_FLAG_NUMBER = &H20000000 Public Const WINHTTP_HEADER_NAME_BY_INDEX = 0 Public Const WINHTTP_NO_HEADER_INDEX = 0 Public Const WINHTTP_NO_REQUEST_DATA = 0 Public Declare PtrSafe Function WinHttpWebSocketCompleteUpgrade Lib "WinHttp" ( _ ByVal hRequest As LongPtr, _ ByVal pContext As LongPtr _ ) As LongPtr Public Declare PtrSafe Function WinHttpCloseHandle Lib "WinHttp" ( _ ByVal hRequest As LongPtr _ ) As Long

VBA

'以下コード============================ Sub Main() Dim dwError As Long dwError = ERROR_SUCCESS ' Http初期化、Httpセッションハンドル取得 Dim AgentHeader As String: AgentHeader = "WebsocketTest" Dim hSessionHandle As LongPtr hSessionHandle = WinHttpOpen(StrPtr(AgentHeader), _ WINHTTP_ACCESS_TYPE_DEFAULT_PROXY, 0, 0, 0) If hSessionHandle = 0 Then dwError = Err.LastDllError GoTo quit End If ' Http接続、Httpコネクションハンドル取得 Dim ServerName As String: ServerName = "echo.websocket.org" Dim Port As Long: Port = INTERNET_DEFAULT_HTTP_PORT ' 80 Dim hConnectionHandle As LongPtr hConnectionHandle = WinHttpConnect(hSessionHandle, StrPtr(ServerName), Port, 0) If hConnectionHandle = 0 Then dwError = Err.LastDllError GoTo quit End If 'Httpリクエストハンドル取得 Dim method As String: method = "GET" Dim Path As String: Path = "/" Dim hRequestHandle As LongPtr hRequestHandle = WinHttpOpenRequest(hConnectionHandle, StrPtr(method), StrPtr(Path), 0, 0, 0, 0) If hRequestHandle = 0 Then dwError = Err.LastDllError GoTo quit End If 'リクエストハンドルに、http→websocketにアップグレードするオプション設定。 Dim result As Long result = False result = WinHttpSetOption(hRequestHandle, WINHTTP_OPTION_UPGRADE_TO_WEB_SOCKET, 0, 0) If (result = 0) Then dwError = Err.LastDllError GoTo quit End If 'サーバーにアップグレードリクエストを送信 result = WinHttpSendRequest(hRequestHandle, WINHTTP_NO_ADDITIONAL_HEADERS, _ 0, WINHTTP_NO_REQUEST_DATA, 0, 0, 0) If (result = 0) Then dwError = Err.LastDllError GoTo quit End If 'サーバーからのレスポンス受信 result = WinHttpReceiveResponse(hRequestHandle, 0) If (result = 0) Then dwError = Err.LastDllError GoTo quit End If ' HTTPレスポンスのステータスコードを確認。101=アップグレード。 Dim dwStatusCode As Long 'ステータスコード用バッファ Dim sizeStatusCode As Long: sizeStatusCode = 4 '4 バイト result = WinHttpQueryHeaders(hRequestHandle, _ (WINHTTP_QUERY_STATUS_CODE Or WINHTTP_QUERY_FLAG_NUMBER), _ WINHTTP_HEADER_NAME_BY_INDEX, _ dwStatusCode, sizeStatusCode, WINHTTP_NO_HEADER_INDEX) If (result = 0) Then dwError = Err.LastDllError GoTo quit End If If dwStatusCode <> 101 Then Debug.Print "ステータス" & dwStatusCode & ":101以外終了" GoTo quit End If ' websocketへのハンドルを取得。 Dim hWebSocketHandle As LongPtr hWebSocketHandle = WinHttpWebSocketCompleteUpgrade(hRequestHandle, 0) If hWebSocketHandle = 0 Then dwError = Err.LastDllError GoTo quit End If ' リクエストハンドル不要なため閉じる。今後ウェブソケットハンドルを使用。 WinHttpCloseHandle (hRequestHandle) hRequestHandle = 0 Debug.Print "Upgrade成功: " & ServerName & ":" & Port & Path exit sub quit: If (hWebSocketHandle <> 0) Then WinHttpCloseHandle (hWebSocketHandle) hWebSocketHandle = 0 End If If (hRequestHandle <> 0) Then WinHttpCloseHandle (hRequestHandle) hRequestHandle = 0 End If If (hConnectionHandle <> 0) Then WinHttpCloseHandle (hConnectionHandle) hConnectionHandle = 0 End If If (hSessionHandle <> 0) Then WinHttpCloseHandle (hSessionHandle) hSessionHandle = 0 End If If (dwError <> ERROR_SUCCESS) Then Debug.Print "error: " & dwError End If End Sub

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

VBA

Dim HeaderTextLength As Long HeaderTextLength = -1 Dim HeaderText As String: HeaderText = "" HeaderText = "Host: " & ServerName result = WinHttpAddRequestHeaders(hRequestHandle, _ StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) Debug.Print Err.LastDllError HeaderText = "Upgrade: websocket" result = WinHttpAddRequestHeaders(hRequestHandle, _ StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) Debug.Print Err.LastDllError HeaderText = "Connection: upgrade" result = WinHttpAddRequestHeaders(hRequestHandle, _ StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) Debug.Print Err.LastDllError HeaderText = "Sec-WebSocket-Version: 13" result = WinHttpAddRequestHeaders(hRequestHandle, _ StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) Debug.Print Err.LastDllError HeaderText = "Sec-Websocket-Protocol: echo-protocol" result = WinHttpAddRequestHeaders(hRequestHandle, _ StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) Debug.Print Err.LastDllError HeaderText = "Sec-Websocket-Protocol: echo-protocol" result = WinHttpAddRequestHeaders(hRequestHandle, _ StrPtr(HeaderText), HeaderTextLength, WINHTTP_ADDREQ_FLAG_ADD_IF_NEW) Debug.Print Err.LastDllError

【環境】
Windows10
Excel2019

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

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

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

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

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

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

0240

2022/05/15 04:52

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

まだ回答がついていません

会員登録して回答してみよう

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

ただいまの回答率
87.20%

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

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

質問する

関連した質問

同じタグがついた質問を見る

VBA

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

Win32 API

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