VBA ウィンドウの列挙 Win32 API

質問

http://d.hatena.ne.jp/cartooh/20090618
上記のページに記載されているVBAです。

動作は確認できたのですが、どのような処理の流れとなっているのかがわかりません。
どなたかコメントを付けていただけないでしょうか。
よろしくお願いいたします。

Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Const INDENT_KEY = "INDENT"

Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam)
End Function

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
EnumWindowsProc = True

If IsWindowVisible(hWnd) = 0 Then
Exit Function
End If

Dim strClassName As String ' * 255
Dim strCaption As String ' * 255
strClassName = String(255, vbNullChar)
strCaption = String(255, vbNullChar)

GetWindowText hWnd, strCaption, Len(strCaption)
GetClassName hWnd, strClassName, Len(strClassName)
strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1))
strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1))

ActiveCell.Cells(1, 1).Value = Hex(hWnd)
ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd)
ActiveCell.Cells(1, 3).Value = strCaption
ActiveCell.Cells(1, 4).Value = strClassName
ActiveCell.Cells(2, 2).Activate

Dim c As Collection
Set c = lParam

Dim indent As Long
indent = c(INDENT_KEY)
c.Add String(indent * 2, " ") & Hex(hWnd) & " " & strCaption & " " & strClassName, before:=c.Count

indent = indent + 1
c.Remove INDENT_KEY
c.Add indent, INDENT_KEY

Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c))

indent = c(INDENT_KEY) - 1
c.Remove INDENT_KEY
c.Add indent, INDENT_KEY

ActiveCell.Cells(1, 0).Activate

End Function

Sub hoge()
Application.ScreenUpdating = False

Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets(1)
sht.UsedRange.Clear
sht.Activate
sht.Range("A1").Activate

Dim c As Collection
Set c = New Collection
c.Add 0, INDENT_KEY

Dim ret As Long
ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c))

c.Remove INDENT_KEY

Set sht = ThisWorkbook.Worksheets(2)
sht.UsedRange.Clear
sht.Activate
sht.Range("A1").Activate

Dim o As Variant
For Each o In c
ActiveCell.Value = o
ActiveCell.Cells(2, 1).Activate
Next

Application.ScreenUpdating = True

End Sub

回答No.2

mitarashi

#1です。
このコードは、一番末の子孫から戻る時にダブルカウントが発生する様です。ちょっと考えてみましたが、何故発生するかは分かりませんでした。対象療法としては、Collectionを用いているので、Hex(ハンドル)をキーに重複カットすれば良いと思いますが．．．
また、会社で試したところNotesが起動されていると、ハングアップ様状態になります。途中で中断してみると、確かに非常に多数のウィンドウが存在する様ではありますが、数十分経っても終了しません。Breakキーが効くので暴走ではないのかもしれませんが、それにしても時間がかかりすぎです。ご参考まで。

お礼

mitarashi様

お世話になっております。kuharaです。

回答をいただきありがとうございます。
また、お礼が遅れ申し訳ございませんでした。

mitarashi様の回答を参考に解析を進めていますが、
なかなか難しい状況です。

今回ご回答いただいた内容もまだ理解できていませんが、
いつか理解できるようになりたいです。

回答No.1

mitarashi

これは解り難いですね（当方にとってもですが）。骨格は下記の通りと理解しました。コメントはもっとレベルの高い回答者様にお任せします。なお、関数名がAPIと似通っていて混乱を招くので、勝手に付け替えています。
なおインデントをつける部分も読み飛ばしています。

'======== procedureB ========
'EnumChildWindowsから、取得されたウィンドウのハンドルおよび、データを収納するCollectionオブジェクトのアドレスを渡して呼ばれる

Public Function procedureB(ByVal hWnd As Long, ByVal lParam As Object) As Long
'再帰的に、procedureAを呼ぶ事で、孫ウィンドウ以降も処理する
procedureB = procedureA(hWnd, lParam)
End Function

'======== procedureA ========
'EnumWindowsから、取得されたウィンドウのハンドルおよび、データを収納するCollectionオブジェクトのアドレスを渡して呼ばれる
'また同様にEnumChildWindowsからも呼ばれる

Public Function procedureA(ByVal hWnd As Long, ByVal lParam As Object) As Long
' EnumWindowss関数から戻された（またはprocedureBから渡された）ハンドルから得られる情報をワークシート1に出力
'Collectionにハンドルから得られた情報を追加

' 子ウィンドウを列挙して処理するコールバック関数を呼ぶ
'　親ウィンドウのハンドル、子ウィンドウが取得される都度実行される関数procedureBのアドレスと、
'データを収納するCollectionオブジェクトのアドレスを渡す
Call EnumChildWindows(hWnd, AddressOf procedureB, ObjPtr(c))
End Function

Sub hoge()
Dim c As Collection
' コールバック関数EnumWindowsに、ウィンドウが取得される都度実行される関数procedureAのアドレスと、データを収納するCollectionオブジェクトのアドレスを渡す
ret = EnumWindows(AddressOf procedureA, ObjPtr(c))
'得られたCollectionの中身をワークシート２に出力
For Each o In c
'...
Next
End Sub