LoginSignup
5
3

More than 1 year has passed since last update.

@kabkabkab

【VBA】Seleniumなし、WebDriverなし、VBA-JSONなしでクローム操作にチャレンジしてみた④

Last updated at Posted at 2022-05-25

の続きです。

前回の記事で、以下実装概要の４をとりあげました。
今回は最後の実装概要５を取り上げます。

実装概要

  1. WSHオブジェクトを使用して、クローム起動
  2. XMLHttpオブジェクトを使用して「localhost:9222/json」Http通信(Get)を行う
    VBAの文字列操作関数を使用して、レスポンス（JSON）から必要情報取得
  3. WindowsAPI(WinHttp関連のAPI)を使用して「WebSocketDebuggerURL」にHttp通信を行う。
  4. WindowsAPI(WinHttp関連のAPI)を使用して、HTTP通信をWebSockt通信にUpGradeさせる。
  5. WindowsAPI(WebSocket関連のAPI)を使用して、CDPメソッドの送信、レスポンスの受信を行う。

※注意※

以下コードは本来、全てクラスで実装しますが、わかりやすさのため、以下のような記述をしています。

  • 該当箇所のみを標準モジュールに記述したような形式でコード例を記載

  • リテラルは本来は定数宣言しますが、そのままリテラルで記載

  • グローバル変数なんてもちろん本来は使用しませんが、コード例では使用。
    （クラス内でメンバ変数宣言、およびプロパティ設定するものとお考え下さい）

  • WinAPIのコメントでの説明内容はMSのレファレンスをDeepLで翻訳し、
    わかりづらいところは意訳し、全体的にかなり端折って抜粋したものです。
    あくまで大枠をつかむこと、および今回の実装に焦点をあてた説明です。
    そのため正確な情報はMSのレファレンスをご参照ください。


ここからが続き

＜実装5. WebSocket関連のAPIを使用して、CDPメソッドの送信、レスポンスの受信を行う＞

※今までと同じく、まず全体コードを掲載し、それに続けて個別箇所を説明します。
※各所でWinAPIを使用していますが、API宣言については個別箇所の説明時に掲載します。

vba：実装5全体
Public Sub Navigate(URL As String)
    '1 CDPのメソッドをJSONのオブジェクト形式で用意
    Dim navigateMethod As String
    navigateMethod = "{""id"": " & 1 & ",""method"": ""Page.navigate"",""params"": {""url"": """ & URL & """}}"
    '2 CDPのメソッドをWebSocketで送信
    If WebSocketSend_CDPMethod(navigateMethod) = False Then GoTo quit
    '3 クロームからのメッセージ(JSON)をWebSocketで受信
    If WebSocketReceive_Message = False Then GoTo quit
    
quit:
    CloseHInternetHandles
    degug.Print "処理失敗"
    End
End Sub
vba：実装5全体（コメント２の箇所で呼ばれる関数）
Public Function WebSocketSend_CDPMethod(CDPMethod As String) As Boolean
    'UTF16→ANSIへ変換
    CDPMethod = StrConv(CDPMethod, vbFromUnicode)
    'WebSocketでCDPMethodを送信
    Dim result As Long '戻り値格納用
    result = WinHttpWebSocketSend(Http.websockethandle, _
                        WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE, _
                        StrPtr(CDPMethod), LenB(CDPMethod))
    If result <> NO_ERROR Then
        Debug.Print "送信失敗：" & CDPMethod & "：" & Err.LastDllError & ":" & result
        SendCDPMethod = False
        Exit Function
    End If
    
'    Debug.Print "送信: " & CDPMethod
    SendCDPMethod = True
End Function
vba：実装5全体（コメント３の箇所で呼ばれる関数）
'WinHttpWebSocketReceiveの引数に使用する変数をまとめた自作定義の構造体
'引数のために5つも変数をコード内で定義すると汚くて嫌なので構造体にまとめただけ。
Private Type RESPONSE　
    buffer  As String   '第二引数用(受信バッファ)
    bufferSize As Long '第三引数用(受信バッファのサイズ）
    receiveBytes As Long '第四引数(受信したバイト数を受け取る変数)
    receiveStatus As Long '第五引数(受信状況を示す定数を受け取るバッファ)
    result As Long '戻り値用
End Type

Public Function WebSocketReceive_Message() As String
    
    Dim res As RESPONSE 
　　'WinAPIにバッファとして渡すので固定長文字列&Null埋(いったんSizeは適当に4KB分)
    res.buffer = String(2048, vbNullChar)
    res.bufferSize = LenB(res.buffer)
    'レスポンス受信
    res.result = WinHttpWebSocketReceive(Http.websockethandle, _
                    StrPtr(res.buffer), res.bufferSize, _
                    res.receiveBytes, res.receiveStatus)
    If (res.result <> NO_ERROR) Then
        Debug.Print "エラー：" & res.result
        GoTo quit
    End If
        
    If res.receiveStatus <> WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE Then
        Debug.Print "レスポンス受信状況：" & res.receiveStatus
        GoTo quit
    End If
    
    '文字コード変換(ANSI→UTF16)
    res.buffer = StrConv(res.buffer, vbUnicode)
    '固定長→可変長へ変換およびNull除去
    Dim responseJSON As String
    responseJSON = Left(res.buffer, InStr(res.buffer, vbNullChar) - 1)

    'Debug.Print "受信: " & responseJSON
    If InStr(responseJSON, "error") Or responseJSON = "" Then GoTo quit
    
    WebSocketReceive_Message = True
quit:
WebSocketReceive_Message = False
End Function

概要
このコードでやっていることは(コメントに記載ある通りですが)以下１～３です。

1 CDPのメソッドをJSONのオブジェクト形式で用意
2 CDPのメソッドをWebSocketで送信
3 クロームからのレスポンス(JSON)をWebSocketで受信

※今回は呼出し元からNavigateメソッドとして呼び出される実装例としてコードを
記載しています。

＜以下、コード内容の個別箇所説明＞
ここからWinAPIの宣言も一緒に掲載します。
コメントで、そのAPI関数の機能、戻り値、引数の説明も記載します。

コメント箇所１：CDPのメソッドをJSONのオブジェクト形式で用意

※WinAPIなし※

vba：コメント箇所１
Public Sub Navigate(URL As String)
    '1 CDPのメソッドをJSONのオブジェクト形式で用意
    Dim navigateMethod As String
    navigateMethod = "{""id"": " & 1 & ",""method"": ""Page.navigate"",""params"": {""url"": """ & URL & """}}"

コメント箇所１の説明
ここでは、クロームに投げるCDPメソッドをJSONのオブジェクト形式で記述し、
変数に格納しているだけです。

今回はNavigateメソッドを例として記述しておりますが、
CDPメソッドの必要な基本項目としては、以下３点・・・

  • id（数値、何でもよい）
  • method（CDPのレファレンスに記載されてるMethod名称をコピペ）
  • params（CDPのレファレンスにMethodごと記載あり。それを参照し記述）

・・・となっております。

他のクローム操作を実装したい場合、CDPのレファレンスに記載されている
メソッドを調べて記述することで、実装を増やしていくことになります。
https://chromedevtools.github.io/devtools-protocol/

参考：以下、CDPレファレンスのNavigateメソッドのページ
※今回の私の実装例で、paramsについてはurl以外がOptionalなので
　記述しませんでしたが、他にもParamsに指定できる項目があることなどが
　見て取れると思います。
image.png

補足：idについて
idについては、レファレンスを見ても「○○のように指定しなければいけいない」
という記載はなかったと思います。
idの役割は、単純にレスポンスがどのリクエストについてのものなのかを
判別するためにつける識別子のようなものです。
※例えば、仮にidを１に設定したリクエストを投げると、
　Chromeからのレスポンスにも、idは１として設定され返ってきます。

そのため数値でダブったりしなければ、基本的には何でも構わないと思います。

コメント箇所２：CDPのメソッドをWebSocketで送信

vba：コメント箇所2で使用するWinAPI宣言
'説明:WebSocketでデータを送信します。
'戻り値:成功すれば NO_ERROR（０）。それ以外はエラーコード。
Public Const NO_ERROR As Long = 0

Public Declare PtrSafe Function WinHttpWebSocketSend Lib "WinHttp" ( _
   ByVal hWebSocket As LongPtr, _
   ByVal eBufferType As Long, _
   ByVal pvBuffer As LongPtr, _
   ByVal dwBufferLength As Long _
   ) As Long
'引数1：ウェブソケットのハンドル。
'引数2：バッファータイプ（以下※に記載の５つの定数の中から指定）
'→WebSocketの文字コードはUTF8,かつCDPメソッドをJSON化したもののサイズは大した大きさでない
' よってWINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE(2)を使用
'引数3：送信するデータを格納したバッファへのポインタ。
'引数4：引数3のバッファのサイズ。

'※
Public Const WINHTTP_WEB_SOCKET_BINARY_MESSAGE_BUFFER_TYPE = 0 
'バッファには、バイナリメッセージの全体または最後の部分が含まれています。
Public Const WINHTTP_WEB_SOCKET_BINARY_FRAGMENT_BUFFER_TYPE = 1 
'バッファにはバイナリーメッセージの一部のみが格納されています。
Public Const WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE = 2 
'バッファには、UTF-8メッセージの全体または最後の部分が含まれています。
Public Const WINHTTP_WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE = 3
'バッファにはUTF-8メッセージの一部のみが含まれています。
Public Const WINHTTP_WEB_SOCKET_CLOSE_BUFFER_TYPE = 4 'CloseFrame。
'サーバーがクローズフレームを送信した。
'※補足※
'これらの定数はレスポンス受信時に使用するAPI「WinHttpWebSocketReceive」
'でも使用されます。
vba：コメント箇所2
Public Sub Navigate(URL As String)

・・・
　　'2 CDPのメソッドをWebSocketで送信
    If WebSocketSend_CDPMethod(navigateMethod) = False Then GoTo quit
vba：コメント箇所2で呼ばれる関数
Public Function WebSocketSend_CDPMethod(CDPMethod As String) As Boolean
    'UTF16→ANSIへ変換
    CDPMethod = StrConv(CDPMethod, vbFromUnicode)
    'WebSocketでCDPMethodを送信
    Dim result As Long '戻り値格納用
    result = WinHttpWebSocketSend(Http.websockethandle, _
                        WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE, _
                        StrPtr(CDPMethod), LenB(CDPMethod))
    If result <> NO_ERROR Then
        Debug.Print "送信失敗：" & CDPMethod & "：" & Err.LastDllError & ":" & result
        SendCDPMethod = False
        Exit Function
    End If
    
'    Debug.Print "送信: " & CDPMethod
    SendCDPMethod = True
End Function

コメント箇所２の説明

ここでは、CDPメソッドをWebSokcetで投げるために
自作関数WebSocketSend_CDPMethodを呼び出して、
その中でWinAPIWinHttpWebSocketSend関数を呼び出しています。

ここで一番のポイントは自作関数一行目
「'UTF16→ANSIへ変更
CDPMethod = StrConv(CDPMethod, vbFromUnicode)」
の箇所です。

まず、なぜこのような変換をしているかというと、結果論になりますが、
こうしないと動かなかったというのが理由です。

そもそもWebSocketの文字コードは基本UTF8のはずです。
WinHttpWebSocketSendの第二引数にも、UTF8に関する定数を指定しています。

そのうえで最初は文字列の文字コードをUTF16→UTF8に変換して、
送信を試していたのですが、なぜかうまくいきませんでした。

次に、変換せずUTF16のまま送信を試みてもうまくいきませんでした。

これは本当に謎で、私はいままで
大村あつし著「大村あつしのExcelVBA Win64/32APIプログラミング」P66に

VBAは引数を受取るAPIの文字セットのことなど意識せずに、
まず文字セットをANSIに変換してしまいます。

と記載があり、そういうものなんだな、と思っていたので、
UTF8でもだめ、(UTF16から自動変換される）ANSIでもだめ・・・
ではどうしたらよいのだ・・・？とここでドツボにはまりました。

ただ、なんか不意にたまたまダメ元で試しに、明示的にANSIに直して送信したら、
偶然うまくいったという状況です。

※仮に本の内容が事実なら、UTF16で試したところで成功するはずですが、
失敗しているので、このAPIに関してはVBAが勝手にANSI変換して渡すということは
行われていないと思われます。

現状としては、ANSIで渡した場合だけ成功するという奇妙な状況ですが、
理由は理解できていません。

MSのWinHttpWebSocketSend関数のレファレンスにもこの点についての
情報は全くありませんでした。
（というかこの関数のレファレンスは「えっ？こんだけ！？と思うほど情報が少ないです）
ネットで情報を探しても見つけられず、もし何かご存じの方がいたら
教えていただけるとありがたいです。


他の点については、特にありません。
WinHttpWebSocketSendでCDPメソッドを送って、エラーチェックしているだけですね。


コメント箇所３：クロームからのメッセージ(JSON)をWebSocketで受信

vba：コメント箇所３で使用されるWinAPI宣言
'説明:WebSocket接続からデータを受信します。
'戻り値:成功すれば NO_ERROR(0)。それ以外はエラーコード。
Public Declare PtrSafe Function WinHttpWebSocketReceive Lib "WinHttp" ( _
   ByVal hWebSocket As LongPtr, _
   ByVal pvBuffer As LongPtr, _
   ByVal dwBufferLength As Long, _
   ByRef pdwBytesRead As Long, _
   ByRef peBufferType As Long _
   ) As Long
'引数１：ウェブソケットへのハンドル。
'引数２：データを受信するバッファへのポインタ。
'引数３：引数３に設定したバッファのサイズ（バイト）。
'引数４：受信したバイト数を受け取る変数。
'これは、この関数がNO_ERROR(0)を返し、かつハンドルが同期モードでオープンの場合にのみ設定される。
'→※今回は「実装3：WinHttp関連のAPIを使用して「WebSocketDebuggerURL」にHttp通信を行う」の
'  段階でWinHttpOpenを同期モード指定していたので、この関数が成功した場合は設定されます。
'引数５：引数２のデータ受信状況。
'これは、この関数が NO_ERROR を返し、かつハンドルが同期モードでオープンの場合にのみ設定される。
'→今回は引数４同様、この関数が成功すれば設定されます。
'設定される内容は、`WinHttpWebSocketSend`の第二引数でも紹介した以下定数値の中から設定されます。
'これを調べて、受信の状況を把握することになります。
'Public Const WINHTTP_WEB_SOCKET_BINARY_MESSAGE_BUFFER_TYPE = 0 
'Public Const WINHTTP_WEB_SOCKET_BINARY_FRAGMENT_BUFFER_TYPE = 1 
'Public Const WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE = 2 
'Public Const WINHTTP_WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE = 3
'Public Const WINHTTP_WEB_SOCKET_CLOSE_BUFFER_TYPE = 4 'CloseFrame。
vba：コメント箇所３
Public Sub Navigate(URL As String)

・・・
    '3 クロームからのメッセージ(JSON)をWebSocketで受信
    If WebSocketReceive_Message = False Then GoTo quit
vba：コメント箇所3で呼ばれる関数
'WinHttpWebSocketReceiveの引数に使用する変数をまとめた自作定義の構造体
'引数のために5つも変数をコード内で定義すると汚くて嫌なので構造体にまとめただけ。
Private Type RESPONSE　
    buffer  As String   '第二引数用(受信バッファ)
    bufferSize As Long '第三引数用(受信バッファのサイズ）
    receiveBytes As Long '第四引数(受信したバイト数を受け取る変数)
    receiveStatus As Long '第五引数(受信状況を示す定数を受け取るバッファ)
    result As Long '戻り値用
End Type

Public Function WebSocketReceive_Message() As String
    
    Dim res As RESPONSE 
　　'WinAPIにバッファとして渡すので固定長文字列&Null埋(いったんSizeは適当に4KB分)
    res.buffer = String(2048, vbNullChar)
    res.bufferSize = LenB(res.buffer)
    'レスポンス受信
    res.result = WinHttpWebSocketReceive(Http.websockethandle, _
                    StrPtr(res.buffer), res.bufferSize, _
                    res.receiveBytes, res.receiveStatus)
    If (res.result <> NO_ERROR) Then
        Debug.Print "エラー：" & res.result
        GoTo quit
    End If
        
    If res.receiveStatus <> WINHTTP_WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE Then
        Debug.Print "レスポンス受信状況：" & res.receiveStatus
        GoTo quit
    End If
    
    '文字コード変換(ANSI→UTF16)
    res.buffer = StrConv(res.buffer, vbUnicode)
    '固定長→可変長へ変換およびNull除去
    Dim responseJSON As String
    responseJSON = Left(res.buffer, InStr(res.buffer, vbNullChar) - 1)

    'Debug.Print "受信: " & responseJSON
    If InStr(responseJSON, "error") Or responseJSON = "" Then GoTo quit
    
    WebSocketReceive_Message = True
quit:
WebSocketReceive_Message = False
End Function

コメント箇所３の説明

ようやく、最後です。
ここでは、クロームからのレスポンスを受信するために
自作関数WebSocketReceive_Messageをよび、その中でWinAPIの
WinHttpWebSocketReceive関数を呼び出しています。

ちなみにこの関数は、引数のために宣言する変数が多いので、
必要な変数は自作構造体としてまとめています。

ここまで記事を読んでくださっている方には、説明不要だと思いますが、
APIに文字列バッファを引き渡す必要があるので、
まず構造体の文字列バッファ変数を固定長かつNull埋めしてから
WinHttpWebSocketReceive関数を呼び出しています。

その後、API自体が失敗していないかのチェック、
次に、戻ってきたメッセージが一括で戻ってきているかチェックしてから、
(Sendと同じく)なぜか文字コードはUTF8ではなくANSIで戻ってくるので
UTF16へ変換し、
さらにバッファに戻ってきた内容を固定長から可変長へ戻し、Null除去して
クロームからのレスポンスが"error"となっていないかチェックして
おしまいです。

※Navigateメソッドについては、クロームからのレスポンスで
何かすることはないので、エラーチェックしてるだけですね。



ただし・・・ この受信メソッドは以下の注意点があります。
  1. データが一括で戻らずフラグメントで戻ってきた場合に未対応
  2. 受信バッファサイズを適当に4KBに設定している
  3. クロームからのレスポンスについてエラーチェックしかしてない

現状としては、NavigateメソッドとCloseぐらいの実装なので、今は問題ありません。

ただ、そもそもWinHttpWebSocketReceive関数の第5引数に戻ってくる
定数にフラグメントを意味するような定数があるので、おそらく
DOM操作とか実装始めると、問題発生するのかなと思っています。

まだとりあえずテストで実装している段階なので、この受信メソッドは
作りこんでおらず、問題がでてきたら作り直そうと思っています。

皆様がもしご自身で実装チャレンジすることがある場合はご注意ください。

実装５はこれで以上です。

最後に

今回初めてQiitaで記事を書いたのですが、①～④に分ける必要があるほど
長くなるとは思っていませんでした。

現状、Chrome操作に関する情報は、Seleniumに関するものがほとんどで、
Selenium,WebDriverなしでの操作については情報がほとんど皆無のような状況なので
このような駄文、わかりづらい内容でも、何かしら情報があったら
だれかの役に立つんじゃないかと思い記事にしてみました。

ずいぶん長い記事になってしまいましたが、ここまで読んでいただいた方
本当にありがとうございました。

追記　2022/8/5

メソッドを他にもいろいろ実装して、ライブラリっぽいものを作ってみたので続きの記事です。
実際の実装についてGithabへのリンクを載せています。

5
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
5
3