here's a system wide mouse + keyboard hook component...
Printable View
here's a system wide mouse + keyboard hook component...
Any possibility to hook into a certain thread ID? I managed to modify it to use a thread ID and use WH_MOUSE / WH_KEYBOARD but the program I try to hook closes as soon my mouse enters the screen. (As soon a first event is posted).
I made a small testing program to hook into. This program reports the following error:
The HookProc function is not called at any times (added a messagebox) so no error in here. It must have to do with how the message is sent from Windows through my hook.Quote:
Attempted to read or write protected memory. This is often an indication that other memory is corrupt.
I only use the mouse hooking part. I added a callback variable for the mouse and changed the structure:
Code:Private deleg As LowLevelMouseHookProc
Private Sub HookMouse(Optional ByVal ThreadID As Integer = 0)
Dim hInstance As IntPtr = LoadLibrary("User32")
deleg = New LowLevelMouseHookProc(AddressOf Me.HookProc)
hMouseHook = SetWindowsHookEx(API.WH.MOUSE, deleg, hInstance, ThreadID)
End Sub
'Private Structure MSLLHOOKSTRUCT
' Public pt As API_POINT
' Public mouseData As Integer
' Public flags As Integer
' Public time As Integer
' Public dwExtraInfo As IntPtr
'End Structure
<StructLayout(LayoutKind.Sequential)> Public Structure MSLLHOOKSTRUCT
Public pt As Point
Public hwnd As Integer
Public wHitTestCode As Integer
Public dwExtraInfo As Integer
End Structure
I found a small error in your code, If you are trying to trap the mouseup event. Your code will freeze if it's not a double click. To fix it you need to do the following: (great code though, saved me 1000000 hours trying to make my own :p )
In the select case statement of the "HookProc" function you need to change:
toCode:Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
Dim index As Integer = If(wParam = WM_LBUTTONUP, 0, If(wParam = WM_RBUTTONUP, 1, If(wParam = WM_MBUTTONUP, 2, -1)))
Static lastMouseUp(2) As Integer
If Environment.TickCount - lastMouseUp(index) < GetDoubleClickTime Then
Dim buttons() As MouseButtons = {MouseButtons.Left, MouseButtons.Right, MouseButtons.Middle}
RaiseEvent MouseDoubleclick(Nothing, Nothing)
End If
lastMouseUp(index) = Environment.TickCount
RaiseEvent MouseUp(Me, New MouseEventArgs(buttons(index), 0, lParam.pt.x, lParam.pt.y, 0))
Red parts are what i've changed.Code:Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
Dim index As Integer = If(wParam = WM_LBUTTONUP, 0, If(wParam = WM_RBUTTONUP, 1, If(wParam = WM_MBUTTONUP, 2, -1)))
Dim buttons() As MouseButtons = {MouseButtons.Left, MouseButtons.Right, MouseButtons.Middle}
Static lastMouseUp(2) As Integer
If Environment.TickCount - lastMouseUp(index) < GetDoubleClickTime Then
RaiseEvent MouseDoubleclick(Me, New MouseEventArgs(buttons(index), 0, lParam.pt.x, lParam.pt.y, 0))
End If
lastMouseUp(index) = Environment.TickCount
RaiseEvent MouseUp(Me, New MouseEventArgs(buttons(index), 0, lParam.pt.x, lParam.pt.y, 0))
A few IMPORTANT additions:
Quote:
- Store the callback of the mouse (garbage collection issue)
Code:<MarshalAs(UnmanagedType.FunctionPtr)> _
Private Shared mousecallback As LowLevelMouseHookProc
<MarshalAs(UnmanagedType.FunctionPtr)> _
Private Shared keyboardcallback As lowlevelKeyboardHookProc
Private Shared hKeyboardHook As IntPtr
Private Shared hMouseHook As IntPtr = IntPtr.Zero
Public Sub Hook()
Dim hInstance As IntPtr = LoadLibrary("User32")
mousecallback = New LowLevelMouseHookProc(AddressOf MouseHookProc)
hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, mousecallback, hInstance, 0)
keyboardcallback = New lowlevelKeyboardHookProc(AddressOf KeyboardHookProc)
hKeyboardHook = SetWindowsHookEx(WH_KEYBOARD_LL, keyboardcallback, hInstance, 0)
End Sub
Quote:
- Improved mouse event handling
Of the above code I changed all events into On* subroutines, you may have to change them accordingly. Also, the API.DWORD(int).Short2 returns the high-order WORD (Short) of the mousedata.Code:Private Shared Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As MSLLHOOKSTRUCT) As Integer
Try
If nCode >= 0 Then
Select Case wParam
Case WM_LBUTTONDOWN
OnMouseDown(New MouseEventArgs(MouseButtons.Left, 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_RBUTTONDOWN
OnMouseDown(New MouseEventArgs(MouseButtons.Right, 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_MBUTTONDOWN
OnMouseDown(New MouseEventArgs(MouseButtons.Middle, 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
Dim index As Integer = If(wParam = WM_LBUTTONUP, 0, If(wParam = WM_RBUTTONUP, 1, If(wParam = WM_MBUTTONUP, 2, -1)))
Dim buttons() As MouseButtons = {MouseButtons.Left, MouseButtons.Right, MouseButtons.Middle}
Static lastMouseUp(2) As Integer
If Environment.TickCount - lastMouseUp(index) < GetDoubleClickTime Then
OnMouseDoubleclick(New MouseEventArgs(buttons(index), 0, lParam.pt.X, lParam.pt.Y, 0))
End If
lastMouseUp(index) = Environment.TickCount
OnMouseUp(New MouseEventArgs(buttons(index), 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_MOUSEMOVE
OnMouseMove(New MouseEventArgs(MouseButtons.None, 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_MOUSEWHEEL, WM_MOUSEHWHEEL
Dim delta As Short = New API.DWORD(lParam.mouseData).Short2
OnMouseWheel(New MouseEventArgs(MouseButtons.None, 0, lParam.pt.X, lParam.pt.Y, delta))
Case WM_XBUTTONUP, WM_XBUTTONDOWN, WM_XBUTTONDBLCLK
Dim button As MouseButtons = MouseButtons.None
Select Case New API.DWORD(lParam.mouseData).Short2
Case 1
button = MouseButtons.XButton1
Case 2
button = MouseButtons.XButton2
End Select
Select Case wParam
Case WM_XBUTTONDOWN
OnMouseDown(New MouseEventArgs(button, 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_XBUTTONUP
OnMouseUp(New MouseEventArgs(button, 0, lParam.pt.X, lParam.pt.Y, 0))
Case WM_XBUTTONDBLCLK
OnMouseDoubleclick(New MouseEventArgs(button, 0, lParam.pt.X, lParam.pt.Y, 0))
End Select
Case Else
Debug.WriteLine(wParam)
End Select
End If
Return CallNextHookEx(hMouseHook, nCode, wParam, lParam)
Catch ex As Exception
Debug.Print(ex.Message)
End Try
End Function
EDIT
Also, for some reason hooking fails while input occurs. It will respond to a few calls, but will eventually stop working.
hello, can this be used to record mouse and keyboard events?
yes.Quote:
Originally Posted by coolcurrent4u
Hello .paul.
First of all, thanks for your "globalInputHook" component. it will be very useful in my project. but there is an error when touching keyboard.
to test the component I've create a Form and two buttons. one to fire "HookInput" and other to fire "UnHookInput".
After pressing bHook button message shoes that hooking process is successful for mouse and keyboard. But after pressing first key on keyboard, below error occursQuote:
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports WindowsApplication2.globalInputHook
Public Class Form1
Private Sub bHook_Click(sender As System.Object, e As System.EventArgs) Handles bHook.Click
Dim Hook As New globalInputHook
Hook.hookInput()
End Sub
Private Sub bUnHook_Click(sender As System.Object, e As System.EventArgs) Handles bUnHook.Click
Dim Hook As New globalInputHook
Hook.unhookInput()
End Sub
End Class
Quote:
PInvokeStackImbalance was detected
Message: A call to PInvoke function 'WindowsApplication2!WindowsApplication2.globalInputHook::CallNextHookEx' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature.
try setting target cpu to x86:
Project-->Properties-->Compile-->Advanced Compile Options-->Target CPU
Hi, Thanks for your replay. but target cpu already set to x86, and problem still exists.
i don't know why that would happen in that case.Quote:
Originally Posted by NTV7
start a new thread in the main vb.net forum + someone might have experienced the same error + be able to help you.