Option Explicit
'Functions, constants and types for the hook
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long _
) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long _
) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any _
) As Long
Public Const WH_MOUSE_LL = 14
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private hHook As Long
Public IsHooked As Boolean
'functions for getting windows properties
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long _
) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long _
) As Long
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long _
) As Long
Sub GetWindowData(x As Long, y As Long)
Dim hWndFrm As Long
Dim lpClassName As String, lpString As String
lpClassName = Space(100)
lpString = Space(100)
'get handle to window
hWndFrm = WindowFromPoint(CLng(x), CLng(y))
If hWndFrm = 0 Then Exit Sub
'get window text (caption)
Call GetWindowText(hWndFrm, lpString, Len(lpString))
'get window class name
Call GetClassName(hWndFrm, lpClassName, Len(lpClassName))
With Form1
.txthandle = Hex(hWndFrm)
.txtCaption = lpString
.txtClassName = lpClassName
End With
End Sub
Public Sub SetMouseHook()
If IsHooked Then
MsgBox "Don't hook the MOUSE_LL hook twice or you'll be sorry."
Else
'This has to be set up as a system-wide hook
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)
IsHooked = True
End If
End Sub
Public Sub RemoveMouseHook()
Dim temp As Long
temp = UnhookWindowsHookEx(hHook)
IsHooked = False
End Sub
Public Function MouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
If uCode >= 0 Then
Call GetWindowData(lParam.pt.x, lParam.pt.y)
End If
MouseProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function