小工具-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