FC2ブログ

Webスクレイピング準備 ウインドウやコントロールハンドルの列挙

ExcelのVBAで職場のInternet Explorerベースの業務システムを自動運転しようという試みに対し、Alertやpromptの応答待ちが邪魔になっていた件について
ネットを検索すると「#32770をFindWindowしてSendKeysで応答せよ」といった的外れな(いや、失礼)回答しかなかったのでしばらく放置していた
というのも、σ(゚∀゚)ワタシがさがしていたのは(今や多くのブラウザで禁じてとなった)ShowModalだったことと、Alertボックスのトップである#32770にSendKeysって誤爆の可能性が高く、この完全なる対策が求められていたからである


〇まえがき
以下の記事の内容には
1.AlertやPromptで表示されるクラス#32770、タイトルWeb ページからのメッセージを料理する方法
2.元になるIEからJavaScriptのShowModalで表示されるウインドウを捕まえて料理する方法
以上が混在して書かれているのでわかりにくいかもしれない

なぜ混在して書かれているのかというと
クラスAlternate Modal Top Mostの存在が重要かつ共通の鍵だからである

〇クラス#32770が表示される構造
Handle列挙
図は、後述するツールソフトで取得したAlertダイヤログの構造である
実はこのソフトにバグ?があり、このおかげで今回の解決策を思いついた(笑)

・ポイント
VBAのWebスクレイピングで基本となるのが
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
だと思いますが
このobjIEのプロパティhWndくん、実は図中のIEFrameのハンドル自身なんです
なので、図に書かれた「関係性」に注意してAPIを駆使すれば、誤爆のない完全な操作が可能なはず
1.IE本体
2.IEで複数タブが開かれていると、別ハンドル、同じプロセス、同じスレッドで複数存在
 ただし、本件お題にあるAlternate Modal Top Mostを所有できるタブは必ず一つのはず
 (IEで複数タブを開き、Alertさせてみてください、別のタブには切り替えできませんから)
3.こいつ、なんで別プロセスなのにIEの子供なの?
4.#32770クラスってトップレベルウインドウなのに親ハンドルがあるじゃん!
9えっ?#32770の親ってあんたかよ!
しかも、IEにしがみついているInternetToolbarHostと同じプロセス、スレッドだ

つまり
objIE.hWndさえわかっていれば
1.IEFrameのハンドルから手繰ってInternetToolbarHostを見つけプロセス、スレッドをメモ
2.トップレベルウインドウAlternate Modal Top Mostのうち、メモのプロセス、スレッドを持つものが
 今制御しようとしているIEに所属するダイヤログの元(親)として特定できたことにまります

このようにして相手ハンドルを特定できるのであれば
操作対象ウインドウを最前面にしないと有効でない、だれに向けてぶっ放しているかわからないSendKeysなんて使わないで
PostMessageなりSendMessageなりで、確実に「ね・ら・い・う・ち」(リンダこまっちゃう(謎))だ

〇ShowModalで表示されるウインドウの構造
概要は以前の記事
EXCELのVBAでIEをコントロールその1
http://hymandr1200st.blog.fc2.com/blog-entry-1161.html
EXCELのVBAでIEをコントロールその2
http://hymandr1200st.blog.fc2.com/blog-entry-1162.html
で書きました
Alternate Modal Top Mostを捕まえる方法は今書いた方法に改良してください

こちらの料理はInternet Explorer_Serverを取り出して通常のIEのDocumentとして処理するところが
先ほどのAlertボックスへの対応と違うところです

〇さいごに
うれしいバグのおまけつきエクセルVBAをアップしておきます
職場の64ビットExcelで作成したものを自宅32ビットExcelに投入して動作させました
任意のエクセルを起動し、拡張子xlsm(マクロ含みエクセル)で保存
出力結果はシート名EnumList固定なので、この名前のシートを用意してください

Option Explicit
'-------------------------------------
' 各種方法でウィンドウを取得
'-------------------------------------
Private Declare PtrSafe Function GetWindow Lib "user32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Const GW_HWNDFIRST As Long = 0 '最前面のウィンドウを検索する
Private Const GW_HWNDLAST As Long = 1 '最背面のウィンドウを検索する
Private Const GW_HWNDNEXT As Long = 2 '基準となるウィンドウの次のウィンドウを検索する
Private Const GW_HWNDPREV As Long = 3 '基準となるウィンドウの前のウィンドウを検索する
Private Const GW_OWNER As Long = 4 '基準となるウィンドウのオーナーウィンドウを検索する
Private Const GW_CHILD As Long = 5 '基準となるウィンドウの子ウィンドウのうちトップレベルのウィンドウを検索する

'-------------------------------------
'ウィンドウの位置情報を取得
'-------------------------------------
Private Declare PtrSafe Function GetWindowRect Lib "user32" _
(ByVal hWnd As LongPtr, lpRect As RECT) As Long
' 長方形の左上隅と右下隅の座標を定義する構造体
Private Type RECT
rect_Left As Long
rect_Top As Long
rect_right As Long
rect_bottom As Long
End Type

'-------------------------------------
' 親ハンドルの取得
'-------------------------------------
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr

'-------------------------------------
' ウィンドウのクラス名を取得
'-------------------------------------
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

'-------------------------------------
' ウィンドウのタイトルバーのテキストを取得
'-------------------------------------
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As Long) As Long
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

'-------------------------------------
' ウィンドウのプロセスIDとスレッドIDを取得
'-------------------------------------
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As LongPtr, ByRef lpdwProcessId As Long) As Long

'-------------------------------------
' トップレベルウィンドウを列挙
'-------------------------------------
' トップレベルウィンドウを列挙する関数の宣言
Private Declare PtrSafe Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As LongPtr, ByRef lParam() As LongPtr) As Long

'-------------------------------------
' 指定された親ウィンドウに属する子ウィンドウを列挙する関数の宣言
'-------------------------------------
Private Declare PtrSafe Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _
ByRef lParam() As LongPtr) As Long

'------------------------------------------------------------------------------
' Main
'------------------------------------------------------------------------------
Sub EnumList()
Dim hWndList() As LongPtr 'ウィンドウハンドル格納域
Dim i As Long

ReDim hWndList(0) 'とりあえず領域確保

Worksheets("EnumList").Range("A:k").ClearContents ' リストクリア

Worksheets("EnumList").Cells(1, 1).Value = "親ハンドル"
Worksheets("EnumList").Cells(1, 2).Value = "自ハンドル"
Worksheets("EnumList").Cells(1, 3).Value = "プロセスID"
Worksheets("EnumList").Cells(1, 4).Value = "スレッドID"
Worksheets("EnumList").Cells(1, 5).Value = "Window_Left"
Worksheets("EnumList").Cells(1, 6).Value = "Window_Top"
Worksheets("EnumList").Cells(1, 7).Value = "Window_right"
Worksheets("EnumList").Cells(1, 8).Value = "Window_bottom"
Worksheets("EnumList").Cells(1, 9).Value = "クラス名"
Worksheets("EnumList").Cells(1, 10).Value = "ウィンドウタイトル"

' すべてのウィンドウハンドルを配列に取得
Call EnumWindows(AddressOf EnumWindowsProc, hWndList)

For i = 1 To UBound(hWndList) '配列の0番目は使っていません
Call SetList(i + 1, hWndList(i)) 'タイトル分+1してシートに列挙
Next

MsgBox "End"
End Sub

'-------------------------------------
' コールバック関数 - トップレベルウィンドウを列挙
'-------------------------------------
Private Function EnumWindowsProc(ByVal hWnd As Long, ByRef lParam() As LongPtr) As Long

'参照形式で受け取ったポインター配列に見つかったハンドルを追加
ReDim Preserve lParam(UBound(lParam) + 1) '領域拡張
lParam(UBound(lParam)) = hWnd 'ウィンドウハンドルセット

'取得したトップレベルハンドルの子に対する処理
'実行結果から推測するに、垂直方向に検索したのち水平方向に処理される
'子、孫、ひ孫 ひ孫がいなければ孫の兄弟 孫関係が終わったら子の兄弟
Call EnumChildWindows(hWnd, AddressOf EnumChildProc, lParam)

'コールバック関数の戻り値は、何等かの検索条件に一致し
'検索を終了する場合にFalseを返して処理を終了するためにある
EnumWindowsProc = True '列挙を継続

End Function

'-------------------------------------
' コールバック関数 - 子ウィンドウを列挙
'-------------------------------------
Private Function EnumChildProc(ByVal hWnd As Long, ByRef lParam() As LongPtr) As Long

'参照形式で受け取ったポインター配列に見つかったハンドルを追加
ReDim Preserve lParam(UBound(lParam) + 1) '領域拡張
lParam(UBound(lParam)) = hWnd 'ウィンドウハンドルセット

'コールバック関数の戻り値は、何等かの検索条件に一致し
'検索を終了する場合にFalseを返して処理を終了するためにある
EnumChildProc = True '列挙を継続

End Function

'-------------------------------------
' ウィンドウハンドルから各種情報を取得し、エクセルシートに書き出し
'-------------------------------------
Private Sub SetList(lngRow As Long, hWnd As Long)

Dim Buffer As String * 512 'バッファ
Dim WinRect As RECT 'ウィンドウ位置情報

Dim lngPrs As Long 'プロセスID
Dim lngTrd As Long 'スレッドID

'親ハンドル取得が時々バグるのはなんなんだろう
'トップレベルウインドウに実行したときに0でなく値が戻るときがある
'実はこの動作のおかげでIEFrameとモダールの関係が分かったのではあるが(笑)
Worksheets("EnumList").Cells(lngRow, 1).Value = GetParent(hWnd) '親ハンドル
Worksheets("EnumList").Cells(lngRow, 2).Value = hWnd '自ハンドル

'プロセスIDとスレッドIDを取得する
lngTrd = GetWindowThreadProcessId(hWnd, lngPrs)
Worksheets("EnumList").Cells(lngRow, 3).Value = lngPrs 'プロセスID
Worksheets("EnumList").Cells(lngRow, 4).Value = lngTrd 'スレッドID

' ウィンドウ位置情報
Call GetWindowRect(hWnd, WinRect)
Worksheets("EnumList").Cells(lngRow, 5).Value = WinRect.rect_Left '左
Worksheets("EnumList").Cells(lngRow, 6).Value = WinRect.rect_Top '上
Worksheets("EnumList").Cells(lngRow, 7).Value = WinRect.rect_right '右
Worksheets("EnumList").Cells(lngRow, 8).Value = WinRect.rect_bottom '下

' クラス名
Dim strClassName As String
Call GetClassName(hWnd, Buffer, Len(Buffer))
strClassName = Left(Buffer, InStr(Buffer, vbNullChar) - 1)
Worksheets("EnumList").Cells(lngRow, 9).Value = strClassName ' クラス名


' ウィンドウタイトル
Call GetWindowText(hWnd, Buffer, Len(Buffer))
Worksheets("EnumList").Cells(lngRow, 10).Value = Left(Buffer, InStr(Buffer, vbNullChar) - 1) ' ウィンドウタイトル

End Sub

〇次回予告
自分がAlertボックス表示を含むJavaScriptを発砲させたら、制御が二度と戻ってこないことの対策はどうすればいいのか

( ̄ー ̄)/~~ジャ
関連記事
スポンサーサイト

コメントの投稿

非公開コメント

お久しぶりぶりです!

課長~♪ちょ~お久しぶりです(^-^)/

久しぶり過ぎてコメント書けません(笑)

Re: お久しぶりぶりです!

> 課長~♪ちょ~お久しぶりです(^-^)/
>
> 久しぶり過ぎてコメント書けません(笑)
やほー!
ごぶさたしております

最近は歳のせいか、ほとんど遠くに出かけられなくて
バイクといえば、最近買い替えた通勤用PCX150ばかりです

だがしかし!
PCX150にはETCがついとりまんねん(笑)
ラーメンごちそうしてくれるなら、いくらでもそっち行きます(爆)
おもちゃ箱
Count from 2010/01/14

にほんブログ村 バイクブログ ドゥカティへ


カレンダー
07 | 2019/08 | 09
- - - - 1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31
最新記事
最新コメント
カテゴリ
月別アーカイブ
リンク
検索フォーム
RSSリンクの表示
ブロとも申請フォーム

この人とブロともになる

全記事表示リンク

全ての記事を表示する