如何在vba中用api回调函数EnumWindowsProc遍历顶层窗口?

一个没有父窗口,或者父窗口是桌面窗口的窗口称为顶层窗口。

遍历顶层窗口可以使用api函数EnumWindows函数和EnumWindowsProc回调函数。

其中EnumWindows函数可以通过依次轮流的将所有顶层窗口的句柄传递给回调函数的方式遍历所有顶层窗口,直到遍历到最后一个顶层窗口或者回调函数返回False。它的语法如下:

BOOL WINAPI EnumWindows(
  _In_ WNDENUMPROC lpEnumFunc,
  _In_ LPARAM      lParam
);

其中参数lpEnumFunc [in] 表示的是指向回调函数的指针,参数lParam [in]表示的是任意一个可以传递给回调函数的值。它的返回值是个逻辑值,如果运行成功,返回是非0值。
EnumWindowsProc 回调函数的语法如下

BOOL CALLBACK EnumWindowsProc(
  _In_ HWND   hwnd,
  _In_ LPARAM lParam
);

它的参数hwnd [in]表示每一个顶层窗口的句柄,lParam [in] 表示的是由EnumWindows的第2参数传递过来的值。如果要让回调函数不断地运行,它的返回值必须是True,否则就返回Flase中断运行。另外EnumWindowsProc只是回调函数的占位符,可以改成任何自己想要的函数名称。

以下是一个示例代码获取所有顶层窗口的类名、标题名称、句柄,并且可以按照标题关键字模糊查询的代码:

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public oDic
Const SW_SHOWMAXIMIZED = 3
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
    Dim oWK As Worksheet
    Set oWK = ActiveSheet
    '定义一个变量存储类名
    Dim sCN As String
    '定义一个变量存储窗口的标题名字
    Dim sTitle As String
    '先填充空格
    sCN = Space(1024)
    sTitle = Space(1024)
    Dim iLen1, iLen2
    '获得实际的类名和标题名称的字符长度,如果是中文,则是字节数
    iLen1 = GetClassName(hwnd, sCN, 1024)
    iLen2 = GetWindowText(hwnd, sTitle, 1024)
'    If iLen2 <> 0 Then Stop
    '提取实际的类名和标题名
    sCN = Replace(Trim(Left(sCN, iLen1)), Chr(0), "")
    sTitle = Replace(Trim(Left(sTitle, iLen2)), Chr(0), "")
'    Debug.Print Asc(Right(sTitle, 1))
    With oWK
        .Range("a1:c1") = Array("类名", "标题名称", "句柄")
        iRow = .Range("a65536").End(xlUp).Row + 1
        .Cells(iRow, 1) = sCN
        .Cells(iRow, 2) = sTitle
        .Cells(iRow, 3) = hwnd
        sValue = sTitle & "!" & hwnd & "!" & sCN
        oDic.Add sValue, ""
    End With
    '继续调用
    EnumWindowsProc = True
End Function
Sub QQ1722187970()
    Dim oWK As Worksheet
     Set oWK = ActiveSheet
    Set oDic = CreateObject("Scripting.Dictionary")
    '开始遍历
    EnumWindows AddressOf EnumWindowsProc, 0
    arrKey = oDic.keys
    arr = Filter(arrKey, "同花顺(v")
    If UBound(arr) = 0 Then
        sResult = arr(0)
        sTitle = Split(sResult, "!")(0)
        lHwnd = Split(sResult, "!")(1)
        sClassName = Split(sResult, "!")(2)
        ShowWindow lHwnd, SW_SHOWMAXIMIZED
    End If
End Sub

 

       

发表评论