globalInputHook component

[.paul.]

here's a system wide mouse + keyboard hook component...

[bergerkiller]

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:

Attempted to read or write protected memory. This is often an indication that other memory is corrupt.

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.
I only use the mouse hooking part. I added a callback variable for the mouse and changed the structure:

    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

[FredFrothen]

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 )

In the select case statement of the "HookProc" function you need to change:

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))

to

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))

Red parts are what i've changed.

[bergerkiller]

A few IMPORTANT additions:

- Store the callback of the mouse (garbage collection issue)

    <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

- Improved mouse event handling

    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

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.

EDIT

Also, for some reason hooking fails while input occurs. It will respond to a few calls, but will eventually stop working.

[coolcurrent4u]

hello, can this be used to record mouse and keyboard events?

[.paul.]

hello, can this be used to record mouse and keyboard events?

yes.

[NTV7]

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".

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

After pressing bHook button message shoes that hooking process is successful for mouse and keyboard. But after pressing first key on keyboard, below error occurs

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.

[.paul.]

try setting target cpu to x86:

Project-->Properties-->Compile-->Advanced Compile Options-->Target CPU

[NTV7]

Hi, Thanks for your replay. but target cpu already set to x86, and problem still exists.

[.paul.]

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.
start a new thread in the main vb.net forum + someone might have experienced the same error + be able to help you.