小工具-VB枚举顶级窗窗口及子窗口句柄和类名!

' 窗体代码:

Option   Explicit

Private   Sub  Check1_Click()
     Dim  t  As   Long
     If  Me.Check1.Value  =   1   Then
        t  =  HWND_TOPMOST
     Else
        t  =  HWND_NOTOPMOST
     End   If
     Call  SetWindowPos(Me.hwnd, t, Me.Left, Me.Top, Me.Width, Me.Height,  3 )
End Sub

Private   Sub  cmdEnumAll_Click()
    Me.lvDetail.ListItems.Clear
     Call  EnumWindows(AddressOf EnumWindowProc,  & H0 & )
End Sub

Private   Sub  cmdEnumChild_Click()
     If  Me.lvDetail.SelectedItem  Is   Nothing   Then
         MsgBox   " 无子窗体可枚举 " , vbOKOnly  +  vbInformation,  " 提示 "
         Exit   Sub
     End   If
     Dim  lParam  As   Long
    lParam  =   0
     Call  EnumChildWindows(GetKey(Me.lvDetail.SelectedItem.Key), AddressOf EnumChildWindowProc, lParam)
     If  lParam  =   0   Then
         MsgBox   " 当前窗口无子窗口! " , vbOKOnly  +  vbInformation,  " 提示 "
     End   If
End Sub

Private   Sub  cmdEnumParent_Click()
     If  Me.lvDetail.SelectedItem  Is   Nothing   Then
         MsgBox   " 无上一级窗体可枚举 " , vbOKOnly  +  vbInformation,  " 提示 "
         Exit   Sub
     End   If
     If  GetParent(GetKey(Me.lvDetail.SelectedItem.Key))  =   0   Then
         MsgBox   " 当前窗体是顶级窗口! " , vbOKOnly  +  vbInformation,  " 提示 "
         Exit   Sub
     Else
         If  GetParent(GetParent(GetKey(Me.lvDetail.SelectedItem.Key)))  =   0   Then
             Call  cmdEnumAll_Click
         Else
             Dim  lParam  As   Long
            lParam  =   0
             Call  EnumChildWindows(GetParent(GetParent(GetKey(Me.lvDetail.SelectedItem.Key))), AddressOf EnumChildWindowProc, lParam)
         End   If
     End   If
End Sub

Public   Sub  cmdGetMouseWindow_Click()
    idHotKey  =   1
     If  Timer1.Enabled  =   False   Then
        Me.Timer1.Interval  =   1
        Me.Timer1.Enabled  =   True
        Me.cmdGetMouseWindow.Caption  =   " 停止鼠标获取(CTRL+S) "
        Modifiers  =  MOD_CONTROL
        idHotKey  =   1
         If  RegisterHotKey(Me.hwnd, idHotKey, Modifiers, vbKeyS)  =   False   Then
             MsgBox   " 注册Ctrl+S热键失败 " , vbOKOnly  +  vbYesNo,  " 提示 "
         End   If
        preWinProc  =  SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndProc)
     Else
        Me.Timer1.Enabled  =   False
        Me.cmdGetMouseWindow.Caption  =   " 鼠标获取 "
        SetWindowLong Me.hwnd, GWL_WNDPROC, preWinProc
         If  UnregisterHotKey(Me.hwnd, idHotKey)  =   False   Then
             MsgBox   " 取消热键Ctrl+S失败 " , vbOKOnly  +  vbInformation,  " 提示 "
         End   If
     End   If
End Sub

Private   Sub  cmdSendMessage_Click()
     On   Error   GoTo  errHandle:
     Call  SendMessage( CLng (Me.txthWnd.Text),  CLng (Me.txtMsg.Text),  CLng (Me.txtWparam.Text),  CLng (Me.txtlParam.Text))
     Exit   Sub
errHandle:
     MsgBox  Err.Description

End Sub

Private   Sub  Form_Load()
    Me.Check1.Value  =   0
    Me.Check1.Value  =   1
End Sub

Private   Sub  Timer1_Timer()
     Dim  PT  As  POINTAPI
     Dim  strTitle  As   String
     Dim  strClassName  As   String
     Dim  myItem  As  ListItem
     Call  GetCursorPos(PT)
     Dim  hwnd  As   Long
    hwnd  =  WindowFromPoint(PT.x, PT.y)
     Call  GetTitleClass(hwnd, strTitle, strClassName)
    Me.lvDetail.ListItems.Clear
     Set  myItem  =  Me.lvDetail.ListItems.Add(, MakeKey( CStr (hwnd)))
    myItem.Text  =  strTitle
    myItem.SubItems( 1 )  =  strClassName
    myItem.SubItems( 2 )  =  hwnd
End Sub
' 模块代码:

Option   Explicit

Public   Const  LVIF_INDENT  As   Long   =   & H10
Public   Const  LVIF_TEXT  As   Long   =   & H1
Public   Const  LVM_FIRST  As   Long   =   & H1000
Public   Const  LVM_SETITEM  As   Long   =  (LVM_FIRST  +   6 )
Public   Const  HWND_TOPMOST  =   - 1
Public   Const  HWND_NOTOPMOST  =   - 2
Public   Const  SWP_SHOWWINDOW  =   & H40
Public   Const  WM_HOTKEY  =   & H312
Public   Const  MOD_ALT  =   & H1
Public   Const  MOD_CONTROL  =   & H2
Public   Const  MOD_SHIFT  =   & H4
Public   Const  GWL_WNDPROC  =  ( - 4 )

Public  preWinProc  As   Long
Public  Modifiers  As   Long , uVirtKey  As   Long , idHotKey  As   Long

Public  Type POINTAPI
        x  As   Long
        y  As   Long
End  Type

Public  Type LVITEM
   mask  As   Long
   iItem  As   Long
   iSubItem  As   Long
   state  As   Long
   stateMask  As   Long
   pszText  As   String
   cchTextMax  As   Long
   iImage  As   Long
   lParam  As   Long
   iIndent  As   Long
End  Type

Public  Declare  Function  WindowFromPoint Lib  " user32 "  (ByVal xPoint  As   Long , ByVal yPoint  As   Long )  As   Long
Public  Declare  Function  GetCursorPos Lib  " user32 "  (lpPoint  As  POINTAPI)  As   Long
Public  Declare  Function  RegisterHotKey Lib  " user32 "  (ByVal hwnd  As   Long , ByVal id  As   Long , ByVal fsModifiers  As   Long , ByVal vk  As   Long )  As   Boolean
Public  Declare  Function  UnregisterHotKey Lib  " user32 "  (ByVal hwnd  As   Long , ByVal id  As   Long )  As   Boolean
Public  Declare  Function  SetWindowLong Lib  " user32 "  Alias  " SetWindowLongA "  (ByVal hwnd  As   Long , ByVal nIndex  As   Long , ByVal dwNewLong  As   Long )  As   Long
Public  Declare  Function  GetWindowLong Lib  " user32 "  Alias  " GetWindowLongA "  (ByVal hwnd  As   Long , ByVal nIndex  As   Long )  As   Long
Public  Declare  Function  CallWindowProc Lib  " user32 "  Alias  " CallWindowProcA "  (ByVal lpPrevWndFunc  As   Long , ByVal hwnd  As   Long , ByVal msg  As   Long , ByVal wParam  As   Long , ByVal lParam  As   Long )  As   Long
Public  Declare  Function  SetWindowPos Lib  " user32 "  _
    (ByVal hwnd  As   Long , ByVal hWndInsertAfter  As   Long , _
    ByVal x  As   Long , ByVal y  As   Long , ByVal cx  As   Long , ByVal cy  As   Long , _
    ByVal wFlags  As   Long )  As   Long

Public  Declare  Function  EnumWindows Lib  " user32 "  _
  (ByVal lpEnumFunc  As   Long , _
   ByVal lParam  As   Long )  As   Long
  
Public  Declare  Function  EnumChildWindows Lib  " user32 "  _
  (ByVal hWndParent  As   Long , _
   ByVal lpEnumFunc  As   Long , _
   ByRef lParam  As   Long )  As   Long

Public  Declare  Function  GetWindowTextLength Lib  " user32 "  _
    Alias  " GetWindowTextLengthA "  _
   (ByVal hwnd  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  GetClassName Lib  " user32 "  _
    Alias  " GetClassNameA "  _
   (ByVal hwnd  As   Long , _
    ByVal lpClassName  As   String , _
    ByVal nMaxCount  As   Long )  As   Long

Public  Declare  Function  IsWindowVisible Lib  " user32 "  _
   (ByVal hwnd  As   Long )  As   Long
  
Public  Declare  Function  GetParent Lib  " user32 "  _
   (ByVal hwnd  As   Long )  As   Long

Public  Declare  Function  SendMessage Lib  " user32 "  _
   Alias  " SendMessageA "  _
  (ByVal hwnd  As   Long , _
   ByVal wMsg  As   Long , _
   ByVal wParam  As   Long , _
   lParam  As  Any)  As   Long
Public   Function  wndProc(ByVal hwnd  As   Long , ByVal msg  As   Long , ByVal wParam  As   Long , ByVal lParam  As   Long )  As   Long
     If  msg  =  WM_HOTKEY  Then
         If  wParam  =  idHotKey  Then
             Call  frmLookWindow.cmdGetMouseWindow_Click
         End   If
     End   If
    wndProc  =  CallWindowProc(preWinProc, hwnd, msg, wParam, lParam)
End Function

' EnumWindows函数所需要的回调函数
Public   Function  EnumWindowProc(ByVal hwnd  As   Long , _
                               ByVal lParam  As   Long )  As   Long
     Dim  myItem  As  ListItem
     Dim  nSize  As   Long
     Dim  strTitle  As   String
     Dim  strClassName  As   String
     If  GetParent(hwnd)  =   0   And  IsWindowVisible(hwnd)  Then
         Call  GetTitleClass(hwnd, strTitle, strClassName)
         Set  myItem  =  frmLookWindow.lvDetail.ListItems.Add(, MakeKey( CStr (hwnd)))
        myItem.Text  =  strTitle
        myItem.SubItems( 1 )  =  strClassName
        myItem.SubItems( 2 )  =  hwnd
     End   If
    EnumWindowProc  =   1
End Function
' EnumChildWindows函数所需要的回调函数
Public   Function  EnumChildWindowProc(ByVal hwnd  As   Long , _
                                    ByRef lParam  As   Long )  As   Long
     Dim  myItem  As  ListItem
     Dim  nSize  As   Long
     Dim  strTitle  As   String
     Dim  strClassName  As   String
     If  lParam  =   0   Then
        frmLookWindow.lvDetail.ListItems.Clear
     End   If
    lParam  =   1
     Call  GetTitleClass(hwnd, strTitle, strClassName)
     Set  myItem  =  frmLookWindow.lvDetail.ListItems.Add(,  " A "   &  hwnd)
    myItem.Text  =  strTitle
    myItem.SubItems( 1 )  =  strClassName
    myItem.SubItems( 2 )  =  hwnd
    EnumChildWindowProc  =   1
End Function
' 获得标题和类名
Public   Sub  GetTitleClass(ByVal hwnd  As   Long , Title  As   String , ClassName  As   String )
     Dim  nSize  As   Long
     Dim  strTitle  As   String
     Dim  strClassName  As   String
    nSize  =  GetWindowTextLength(hwnd)
     If  nSize  >   0   Then
        strTitle  =   Space ( 255 )
         Call  GetWindowText(hwnd, strTitle,  Len (strTitle))
        strTitle  =   Trim (strTitle)
     Else
        strTitle  =   " No Title "
     End   If
    strClassName  =   Space ( 255 )
     Call  GetClassName(hwnd, strClassName,  Len (strClassName))
    strClassName  =   Trim (strClassName)
    Title  =  strTitle
    ClassName  =  strClassName
End Sub
Public   Function  GetKey(str  As   String )  As   String
    GetKey  =   Right (str,  Len (str)  -   1 )
End Function
Public   Function  MakeKey(str  As   String )  As   String
    MakeKey  =   " A "   &  str
End Function

转载于:https://www.cnblogs.com/fxwdl/archive/2006/08/08/471285.html