中断 Mousehook，处理并创建新的 Mousehook？
Interrupt Mousehook, dispose and create new Mousehook?
我正在使用 Mousehook（我尝试了 2 个不同的钩子）但它崩溃了。我认为这样做的原因是在未完成的计算期间进行了鼠标点击。我不知道确切原因，但过了一段时间它停止工作了。
所以我尝试了另一件事，每次我完成计算时，我都会处理掉（旧的）Mousehook 并创建一个新的。
这很好用并且完成了工作...但是这次应用程序在一段时间后崩溃并出现 "garbage collection" 和 "Invoke" 错误。我认为这样做的原因是我不能像我一样摆脱钩子？但是这样的事情可能吗？
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.ComponentModel
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Diagnostics
#End Region
#Region " MouseHook "
''' <summary>
''' A low level mouse hook that processes mouse input events.
''' </summary>
Friend NotInheritable Class MouseHook : Implements IDisposable
#Region " P/Invoke "
Protected NotInheritable Class NativeMethods
#Region " Methods "
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function CallNextHookEx(
ByVal idHook As IntPtr,
ByVal nCode As Integer,
ByVal wParam As IntPtr,
ByVal lParam As IntPtr
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function SetWindowsHookEx(
ByVal idHook As HookType,
ByVal lpfn As LowLevelMouseProcDelegate,
ByVal hInstance As IntPtr,
ByVal threadId As UInteger
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function UnhookWindowsHookEx(
ByVal idHook As IntPtr
) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Public Shared Function GetDoubleClickTime() As Integer
End Function
#End Region
#Region " Enumerations "
Public Enum WindowsMessages As UInteger
WM_MOUSEMOVE = &H200UI
WM_LBUTTONDOWN = &H201UI
WM_LBUTTONUP = &H202UI
WM_RBUTTONDOWN = &H204UI
WM_RBUTTONUP = &H205UI
WM_MBUTTONDOWN = &H207UI
WM_MBUTTONUP = &H208UI
WM_MOUSEWHEEL = &H20AUI
End Enum
Public Enum HookType As UInteger
' **************************************
' This enumeration is partially defined.
' **************************************
''' <summary>
''' Installs a hook procedure that monitors low-level mouse input events.
''' For more information, see the LowLevelMouseProc hook procedure.
''' </summary>
WH_MOUSE_LL = 14UI
End Enum
<Flags()>
Public Enum MsllHookStructFlags As Integer
''' <summary>
''' Test the event-injected (from any process) flag.
''' </summary>
LLMHF_INJECTED = 1I
''' <summary>
''' Test the event-injected (from a process running at lower integrity level) flag.
''' </summary>
LLMHF_LOWER_IL_INJECTED = 2I
End Enum
#End Region
#Region " Structures "
''' <summary>
''' The POINT structure defines the x- and y- coordinates of a point.
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx
''' </summary>
<StructLayout(LayoutKind.Sequential)>
Public Structure Point
Public X As Integer
Public Y As Integer
End Structure
Public Structure MsllHookStruct
''' <summary>
''' The ptThe x- and y-coordinates of the cursor, in screen coordinates.
''' </summary>
Public Pt As NativeMethods.Point
''' <summary>
''' If the message is 'WM_MOUSEWHEEL', the high-order word of this member is the wheel delta.
''' The low-order word is reserved.
''' A positive value indicates that the wheel was rotated forward, away from the user;
''' a negative value indicates that the wheel was rotated backward, toward the user.
''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
''' </summary>
Public MouseData As Integer
''' <summary>
''' The event-injected flag.
''' </summary>
Public Flags As MsllHookStructFlags
''' <summary>
''' The time stamp for this message.
''' </summary>
Public Time As UInteger
''' <summary>
''' Additional information associated with the message.
''' </summary>
Public DwExtraInfo As IntPtr
End Structure
#End Region
#Region " Delegates "
''' <summary>
''' Delegate LowLevelMouseProc
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644986%28v=vs.85%29.aspx
''' </summary>
''' <returns>
''' If nCode is less than zero, the hook procedure must return the value returned by CallNextHookEx.
''' If nCode is greater than or equal to zero, and the hook procedure did not process the message,
''' it is highly recommended that you call CallNextHookEx and return the value it returns;
''' otherwise, other applications that have installed WH_MOUSE_LL hooks will not receive hook notifications
''' and may behave incorrectly as a result.
''' If the hook procedure processed the message,
''' it may return a nonzero value to prevent the system from passing the message to the rest of the hook chain or the target window procedure.
''' </returns>
Public Delegate Function LowLevelMouseProcDelegate(
ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr
) As Integer
#End Region
End Class
#End Region
#Region " Properties "
''' <summary>
''' Handle to the hook procedure.
''' </summary>
Private Property MouseHook As IntPtr
''' <summary>
''' The mouse hook delegate.
''' </summary>
Private Property MouseHookDelegate As NativeMethods.LowLevelMouseProcDelegate
''' <summary>
''' Determines whether the Hook is installed.
''' </summary>
Public Property IsInstalled As Boolean
''' <summary>
''' Determines whether the Hook is enabled.
''' </summary>
Public Property IsEnabled As Boolean = False
''' <summary>
''' ** ONLY FOR TESTING PURPOSES **
''' Gets or sets a value indicating whether to suppress the last MouseUp event of
''' the specified clicked button when a double-click fires.
'''
''' If this value is set to <c>true</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseDoubleClick
'''
''' If this value is set to <c>false</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseUp, MouseDoubleClick
'''
''' </summary>
''' <value><c>true</c> if MouseUp event is suppressed; otherwise <c>false</c>.</value>
Public Property SuppressMouseUpEventWhenDoubleClick As Boolean = False
''' <summary>
''' Gets or sets the screen's working area.
''' The events fired by this <see cref="MouseHook"/> instance will be restricted to the bounds of the specified rectangle.
''' </summary>
''' <value>The screen's working area.</value>
Public Property WorkingArea As Rectangle
Get
Return Me.workingarea1
End Get
Set(ByVal value As Rectangle)
Me.workingarea1 = value
'MsgBox(WorkingArea.Bottom.ToString)
End Set
End Property
''' <summary>
''' The screen's working area
''' </summary>
Private workingarea1 As Rectangle = SystemInformation.VirtualScreen
#End Region
#Region " Enumerations "
''' <summary>
''' Indicates the whell direction of the mouse.
''' </summary>
Public Enum WheelDirection As Integer
''' <summary>
''' The wheel is moved up.
''' </summary>
WheelUp = 1I
''' <summary>
''' The wheel is moved down.
''' </summary>
WheelDown = 2I
End Enum
#End Region
#Region " Events "
Public Event MouseMove(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseWheel(ByVal sender As Object,
ByVal mouseLocation As Point,
ByVal wheelDirection As WheelDirection)
#End Region
#Region " Exceptions "
''' <summary>
''' Exception that is thrown when trying to enable or uninstall a mouse hook that is not installed.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotInstalledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not installed.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to disable a mouse hook that is not enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to enable a mouse hook that is already enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is already enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
#End Region
#Region " Constructors "
'Private Sub New()
'End Sub
''' <summary>
''' Initializes a new instance of the <see cref="MouseHook"/> class.
''' </summary>
''' <param name="Install">
''' If set to <c>true</c>, the Hook starts initialized for this <see cref="MouseHook"/> instance.
''' </param>
Public Sub New(Optional ByVal install As Boolean = False)
If install Then
Me.Install()
End If
End Sub
#End Region
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
End Function
#Region " Public Methods "
''' <summary>
''' Installs the Mouse Hook, then start processing messages to fire events.
''' </summary>
Public Sub Install()
If Me.IsVisualStudioHostingProcessEnabled() Then
Throw New Exception("Visual Studio Hosting Process should be deactivated.")
Exit Sub
End If
Me.MouseHookDelegate = New NativeMethods.LowLevelMouseProcDelegate(AddressOf LowLevelMouseProc)
Try
Me.MouseHook = NativeMethods.SetWindowsHookEx(NativeMethods.HookType.WH_MOUSE_LL,
Me.MouseHookDelegate,
Getmodulehandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
Me.IsInstalled = True
Catch ex As Exception
Throw
End Try
End Sub
''' <summary>
''' Uninstalls the Mouse Hook and free all resources, then stop processing messages to fire events.
''' </summary>
Public Sub Uninstall()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
Else
Me.IsEnabled = False
Me.IsInstalled = False
Me.Finalize()
End If
End Sub
''' <summary>
''' Temporally disables the Mouse Hook events.
''' To Re-enable the events, call the <see cref="Enable"/> method.
''' </summary>
Public Sub Disable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Not Me.IsEnabled Then
Throw New MouseHookNotEnabledException
Else
Me.IsEnabled = False
End If
End Sub
''' <summary>
''' Re-enables the Mouse Hook events.
''' </summary>
Public Sub Enable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Me.IsEnabled Then
Throw New MouseHookEnabledException
Else
Me.IsEnabled = True
End If
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Determines whether the Visual Studio Hosting Process is enabled on the current application.
''' </summary>
''' <returns><c>true</c> if Visual Studio Hosting Process is enabled; otherwise, <c>false</c>.</returns>
Private Function IsVisualStudioHostingProcessEnabled() As Boolean
Return AppDomain.CurrentDomain.FriendlyName.EndsWith("vshost.exe", StringComparison.OrdinalIgnoreCase)
End Function
Private Function LowLevelMouseProc(ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr) As Integer
If Not Me.IsEnabled Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
Static leftClickTime As Integer = 0I ' Determines a left button double-click.
Static rightClickTime As Integer = 0I ' Determines a right button double-click.
Static middleClickTime As Integer = 0I ' Determines a middle button double-click.
If nCode = 0I Then
Dim x As Integer
Dim y As Integer
Dim mouseStruct As NativeMethods.MsllHookStruct
mouseStruct = CType(Marshal.PtrToStructure(lParam, mouseStruct.GetType()),
NativeMethods.MsllHookStruct)
' Fix X coordinate.
Select Case mouseStruct.Pt.X
Case Is <= 0I
If mouseStruct.Pt.X >= Me.WorkingArea.Location.X Then
x = mouseStruct.Pt.X
ElseIf mouseStruct.Pt.X <= Me.WorkingArea.Location.X Then
If mouseStruct.Pt.X <= (Me.WorkingArea.Location.X - Me.WorkingArea.Width) Then
x = (Me.WorkingArea.Location.X - Me.WorkingArea.Width)
Else
x = mouseStruct.Pt.X
End If
End If
Case Is >= Me.WorkingArea.Width
x = Me.WorkingArea.Width
Case Else
x = mouseStruct.Pt.X
End Select
' Fix Y coordinate.
Select Case mouseStruct.Pt.Y
Case Is >= Me.WorkingArea.Height
y = Me.WorkingArea.Height
Case Is <= 0I
y = 0I
Case Else
y = mouseStruct.Pt.Y
End Select
If x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X > Me.WorkingArea.Width Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X < Me.WorkingArea.X Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x = Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x - 1, y) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
ElseIf x < Me.WorkingArea.Width AndAlso
y = Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x, y - 1) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End If
Select Case wParam
Case NativeMethods.WindowsMessages.WM_MOUSEMOVE
RaiseEvent MouseMove(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONDOWN
RaiseEvent MouseLeftDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONUP
If leftClickTime <> 0 Then
leftClickTime = Environment.TickCount() - leftClickTime
End If
If (leftClickTime <> 0I) AndAlso (leftClickTime < NativeMethods.GetDoubleClickTime()) Then
leftClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
RaiseEvent MouseLeftDoubleClick(Me, New Point(x, y))
Else
leftClickTime = Environment.TickCount()
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_RBUTTONDOWN
RaiseEvent MouseRightDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_RBUTTONUP
If rightClickTime <> 0I Then
rightClickTime = Environment.TickCount() - rightClickTime
End If
If (rightClickTime <> 0I) AndAlso (rightClickTime < NativeMethods.GetDoubleClickTime()) Then
rightClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
RaiseEvent MouseRightDoubleClick(Me, New Point(x, y))
Else
rightClickTime = Environment.TickCount()
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MBUTTONDOWN
RaiseEvent MouseMiddleDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_MBUTTONUP
If middleClickTime <> 0I Then
middleClickTime = Environment.TickCount() - middleClickTime
End If
If (middleClickTime <> 0I) AndAlso (middleClickTime < NativeMethods.GetDoubleClickTime()) Then
middleClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
RaiseEvent MouseMiddleDoubleClick(Me, New Point(x, y))
Else
middleClickTime = Environment.TickCount()
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MOUSEWHEEL
RaiseEvent MouseWheel(Me, New Point(x, y), If(mouseStruct.MouseData < 0I,
WheelDirection.WheelDown,
WheelDirection.WheelUp))
Case Else
' Do Nothing
Exit Select
End Select
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf nCode < 0I Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
Else ' nCode > 0
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End Function
#End Region
#Region "IDisposable Support"
''' <summary>
''' Flag to detect redundant calls at <see cref="Dispose"/> method.
''' </summary>
Private disposedValue As Boolean
Protected Sub Dispose(ByVal disposing As Boolean)
Me.IsEnabled = False
If Not Me.disposedValue Then
If disposing Then ' Dispose managed state (managed objects).
Else ' Free unmanaged resources (unmanaged objects).
NativeMethods.UnhookWindowsHookEx(Me.MouseHook)
End If
End If
Me.disposedValue = True
End Sub
Protected Overrides Sub Finalize()
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=False)
MyBase.Finalize()
End Sub
Private Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=True)
GC.SuppressFinalize(obj:=Me)
End Sub
#End Region
End Class
#End Region
此 post 中的文档几乎不够。您应该能够 post 一个可重现的小例子。 "stops working" 之类的语句实际上没有传达任何信息。如果您遇到错误，请 post 例外。
话虽如此...
听起来你的回调正在被垃圾收集。您需要将委托保存在至少具有挂钩生命周期的变量中。 Shared class 成员是一个很好的候选人。
例如：
'BAD!
Class MyClass
Public Sub Run()
Dim Hook as MouseHook = New MouseHook()
'install, enable, etc...
End Sub
'Hook is not saved and will be collected after Run() ends
End Class
应该是：
'Better
Class MyClass
Private Shared Hook as MouseHook
Public Sub Run()
Hook = New MouseHook()
'install, enable, etc...
End Sub
'Now, Hook IS saved and will live on after Run() ends
End Class
这是非常基础的，您应该根据自己的需要进行调整。同样，这只是一个猜测，因为没有足够的信息可以进一步说明。
我正在使用 Mousehook（我尝试了 2 个不同的钩子）但它崩溃了。我认为这样做的原因是在未完成的计算期间进行了鼠标点击。我不知道确切原因，但过了一段时间它停止工作了。
所以我尝试了另一件事，每次我完成计算时，我都会处理掉（旧的）Mousehook 并创建一个新的。
这很好用并且完成了工作...但是这次应用程序在一段时间后崩溃并出现 "garbage collection" 和 "Invoke" 错误。我认为这样做的原因是我不能像我一样摆脱钩子？但是这样的事情可能吗？
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.ComponentModel
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Diagnostics
#End Region
#Region " MouseHook "
''' <summary>
''' A low level mouse hook that processes mouse input events.
''' </summary>
Friend NotInheritable Class MouseHook : Implements IDisposable
#Region " P/Invoke "
Protected NotInheritable Class NativeMethods
#Region " Methods "
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function CallNextHookEx(
ByVal idHook As IntPtr,
ByVal nCode As Integer,
ByVal wParam As IntPtr,
ByVal lParam As IntPtr
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function SetWindowsHookEx(
ByVal idHook As HookType,
ByVal lpfn As LowLevelMouseProcDelegate,
ByVal hInstance As IntPtr,
ByVal threadId As UInteger
) As IntPtr
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
Public Shared Function UnhookWindowsHookEx(
ByVal idHook As IntPtr
) As Boolean
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Public Shared Function GetDoubleClickTime() As Integer
End Function
#End Region
#Region " Enumerations "
Public Enum WindowsMessages As UInteger
WM_MOUSEMOVE = &H200UI
WM_LBUTTONDOWN = &H201UI
WM_LBUTTONUP = &H202UI
WM_RBUTTONDOWN = &H204UI
WM_RBUTTONUP = &H205UI
WM_MBUTTONDOWN = &H207UI
WM_MBUTTONUP = &H208UI
WM_MOUSEWHEEL = &H20AUI
End Enum
Public Enum HookType As UInteger
' **************************************
' This enumeration is partially defined.
' **************************************
''' <summary>
''' Installs a hook procedure that monitors low-level mouse input events.
''' For more information, see the LowLevelMouseProc hook procedure.
''' </summary>
WH_MOUSE_LL = 14UI
End Enum
<Flags()>
Public Enum MsllHookStructFlags As Integer
''' <summary>
''' Test the event-injected (from any process) flag.
''' </summary>
LLMHF_INJECTED = 1I
''' <summary>
''' Test the event-injected (from a process running at lower integrity level) flag.
''' </summary>
LLMHF_LOWER_IL_INJECTED = 2I
End Enum
#End Region
#Region " Structures "
''' <summary>
''' The POINT structure defines the x- and y- coordinates of a point.
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx
''' </summary>
<StructLayout(LayoutKind.Sequential)>
Public Structure Point
Public X As Integer
Public Y As Integer
End Structure
Public Structure MsllHookStruct
''' <summary>
''' The ptThe x- and y-coordinates of the cursor, in screen coordinates.
''' </summary>
Public Pt As NativeMethods.Point
''' <summary>
''' If the message is 'WM_MOUSEWHEEL', the high-order word of this member is the wheel delta.
''' The low-order word is reserved.
''' A positive value indicates that the wheel was rotated forward, away from the user;
''' a negative value indicates that the wheel was rotated backward, toward the user.
''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
''' </summary>
Public MouseData As Integer
''' <summary>
''' The event-injected flag.
''' </summary>
Public Flags As MsllHookStructFlags
''' <summary>
''' The time stamp for this message.
''' </summary>
Public Time As UInteger
''' <summary>
''' Additional information associated with the message.
''' </summary>
Public DwExtraInfo As IntPtr
End Structure
#End Region
#Region " Delegates "
''' <summary>
''' Delegate LowLevelMouseProc
''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644986%28v=vs.85%29.aspx
''' </summary>
''' <returns>
''' If nCode is less than zero, the hook procedure must return the value returned by CallNextHookEx.
''' If nCode is greater than or equal to zero, and the hook procedure did not process the message,
''' it is highly recommended that you call CallNextHookEx and return the value it returns;
''' otherwise, other applications that have installed WH_MOUSE_LL hooks will not receive hook notifications
''' and may behave incorrectly as a result.
''' If the hook procedure processed the message,
''' it may return a nonzero value to prevent the system from passing the message to the rest of the hook chain or the target window procedure.
''' </returns>
Public Delegate Function LowLevelMouseProcDelegate(
ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr
) As Integer
#End Region
End Class
#End Region
#Region " Properties "
''' <summary>
''' Handle to the hook procedure.
''' </summary>
Private Property MouseHook As IntPtr
''' <summary>
''' The mouse hook delegate.
''' </summary>
Private Property MouseHookDelegate As NativeMethods.LowLevelMouseProcDelegate
''' <summary>
''' Determines whether the Hook is installed.
''' </summary>
Public Property IsInstalled As Boolean
''' <summary>
''' Determines whether the Hook is enabled.
''' </summary>
Public Property IsEnabled As Boolean = False
''' <summary>
''' ** ONLY FOR TESTING PURPOSES **
''' Gets or sets a value indicating whether to suppress the last MouseUp event of
''' the specified clicked button when a double-click fires.
'''
''' If this value is set to <c>true</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseDoubleClick
'''
''' If this value is set to <c>false</c>, the application will send the events in this order for a Double-Click:
''' MouseDown, MouseUp, MouseDown, MouseUp, MouseDoubleClick
'''
''' </summary>
''' <value><c>true</c> if MouseUp event is suppressed; otherwise <c>false</c>.</value>
Public Property SuppressMouseUpEventWhenDoubleClick As Boolean = False
''' <summary>
''' Gets or sets the screen's working area.
''' The events fired by this <see cref="MouseHook"/> instance will be restricted to the bounds of the specified rectangle.
''' </summary>
''' <value>The screen's working area.</value>
Public Property WorkingArea As Rectangle
Get
Return Me.workingarea1
End Get
Set(ByVal value As Rectangle)
Me.workingarea1 = value
'MsgBox(WorkingArea.Bottom.ToString)
End Set
End Property
''' <summary>
''' The screen's working area
''' </summary>
Private workingarea1 As Rectangle = SystemInformation.VirtualScreen
#End Region
#Region " Enumerations "
''' <summary>
''' Indicates the whell direction of the mouse.
''' </summary>
Public Enum WheelDirection As Integer
''' <summary>
''' The wheel is moved up.
''' </summary>
WheelUp = 1I
''' <summary>
''' The wheel is moved down.
''' </summary>
WheelDown = 2I
End Enum
#End Region
#Region " Events "
Public Event MouseMove(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseLeftDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseRightDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDown(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleUp(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseMiddleDoubleClick(ByVal sender As Object,
ByVal mouseLocation As Point)
Public Event MouseWheel(ByVal sender As Object,
ByVal mouseLocation As Point,
ByVal wheelDirection As WheelDirection)
#End Region
#Region " Exceptions "
''' <summary>
''' Exception that is thrown when trying to enable or uninstall a mouse hook that is not installed.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotInstalledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not installed.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to disable a mouse hook that is not enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookNotEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is not enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
''' <summary>
''' Exception that is thrown when trying to enable a mouse hook that is already enabled.
''' </summary>
<Serializable()>
Friend NotInheritable Class MouseHookEnabledException : Inherits Exception
Friend Sub New()
MyBase.New("MouseHook is already enabled.")
End Sub
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
Friend Sub New(ByVal message As String, ByVal inner As Exception)
MyBase.New(message, inner)
End Sub
End Class
#End Region
#Region " Constructors "
'Private Sub New()
'End Sub
''' <summary>
''' Initializes a new instance of the <see cref="MouseHook"/> class.
''' </summary>
''' <param name="Install">
''' If set to <c>true</c>, the Hook starts initialized for this <see cref="MouseHook"/> instance.
''' </param>
Public Sub New(Optional ByVal install As Boolean = False)
If install Then
Me.Install()
End If
End Sub
#End Region
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
End Function
#Region " Public Methods "
''' <summary>
''' Installs the Mouse Hook, then start processing messages to fire events.
''' </summary>
Public Sub Install()
If Me.IsVisualStudioHostingProcessEnabled() Then
Throw New Exception("Visual Studio Hosting Process should be deactivated.")
Exit Sub
End If
Me.MouseHookDelegate = New NativeMethods.LowLevelMouseProcDelegate(AddressOf LowLevelMouseProc)
Try
Me.MouseHook = NativeMethods.SetWindowsHookEx(NativeMethods.HookType.WH_MOUSE_LL,
Me.MouseHookDelegate,
Getmodulehandle(Process.GetCurrentProcess().MainModule.ModuleName), 0)
Me.IsInstalled = True
Catch ex As Exception
Throw
End Try
End Sub
''' <summary>
''' Uninstalls the Mouse Hook and free all resources, then stop processing messages to fire events.
''' </summary>
Public Sub Uninstall()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
Else
Me.IsEnabled = False
Me.IsInstalled = False
Me.Finalize()
End If
End Sub
''' <summary>
''' Temporally disables the Mouse Hook events.
''' To Re-enable the events, call the <see cref="Enable"/> method.
''' </summary>
Public Sub Disable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Not Me.IsEnabled Then
Throw New MouseHookNotEnabledException
Else
Me.IsEnabled = False
End If
End Sub
''' <summary>
''' Re-enables the Mouse Hook events.
''' </summary>
Public Sub Enable()
If Not Me.IsInstalled Then
Throw New MouseHookNotInstalledException
ElseIf Me.IsEnabled Then
Throw New MouseHookEnabledException
Else
Me.IsEnabled = True
End If
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Determines whether the Visual Studio Hosting Process is enabled on the current application.
''' </summary>
''' <returns><c>true</c> if Visual Studio Hosting Process is enabled; otherwise, <c>false</c>.</returns>
Private Function IsVisualStudioHostingProcessEnabled() As Boolean
Return AppDomain.CurrentDomain.FriendlyName.EndsWith("vshost.exe", StringComparison.OrdinalIgnoreCase)
End Function
Private Function LowLevelMouseProc(ByVal nCode As Integer,
ByVal wParam As NativeMethods.WindowsMessages,
ByVal lParam As IntPtr) As Integer
If Not Me.IsEnabled Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
Static leftClickTime As Integer = 0I ' Determines a left button double-click.
Static rightClickTime As Integer = 0I ' Determines a right button double-click.
Static middleClickTime As Integer = 0I ' Determines a middle button double-click.
If nCode = 0I Then
Dim x As Integer
Dim y As Integer
Dim mouseStruct As NativeMethods.MsllHookStruct
mouseStruct = CType(Marshal.PtrToStructure(lParam, mouseStruct.GetType()),
NativeMethods.MsllHookStruct)
' Fix X coordinate.
Select Case mouseStruct.Pt.X
Case Is <= 0I
If mouseStruct.Pt.X >= Me.WorkingArea.Location.X Then
x = mouseStruct.Pt.X
ElseIf mouseStruct.Pt.X <= Me.WorkingArea.Location.X Then
If mouseStruct.Pt.X <= (Me.WorkingArea.Location.X - Me.WorkingArea.Width) Then
x = (Me.WorkingArea.Location.X - Me.WorkingArea.Width)
Else
x = mouseStruct.Pt.X
End If
End If
Case Is >= Me.WorkingArea.Width
x = Me.WorkingArea.Width
Case Else
x = mouseStruct.Pt.X
End Select
' Fix Y coordinate.
Select Case mouseStruct.Pt.Y
Case Is >= Me.WorkingArea.Height
y = Me.WorkingArea.Height
Case Is <= 0I
y = 0I
Case Else
y = mouseStruct.Pt.Y
End Select
If x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X > Me.WorkingArea.Width Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x <= Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height AndAlso
mouseStruct.Pt.X < Me.WorkingArea.X Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf x = Me.WorkingArea.Width AndAlso
y < Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x - 1, y) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
ElseIf x < Me.WorkingArea.Width AndAlso
y = Me.WorkingArea.Height Then
If Not Me.WorkingArea.Contains(x, y - 1) Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End If
Select Case wParam
Case NativeMethods.WindowsMessages.WM_MOUSEMOVE
RaiseEvent MouseMove(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONDOWN
RaiseEvent MouseLeftDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_LBUTTONUP
If leftClickTime <> 0 Then
leftClickTime = Environment.TickCount() - leftClickTime
End If
If (leftClickTime <> 0I) AndAlso (leftClickTime < NativeMethods.GetDoubleClickTime()) Then
leftClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
RaiseEvent MouseLeftDoubleClick(Me, New Point(x, y))
Else
leftClickTime = Environment.TickCount()
RaiseEvent MouseLeftUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_RBUTTONDOWN
RaiseEvent MouseRightDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_RBUTTONUP
If rightClickTime <> 0I Then
rightClickTime = Environment.TickCount() - rightClickTime
End If
If (rightClickTime <> 0I) AndAlso (rightClickTime < NativeMethods.GetDoubleClickTime()) Then
rightClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
RaiseEvent MouseRightDoubleClick(Me, New Point(x, y))
Else
rightClickTime = Environment.TickCount()
RaiseEvent MouseRightUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MBUTTONDOWN
RaiseEvent MouseMiddleDown(Me, New Point(x, y))
Case NativeMethods.WindowsMessages.WM_MBUTTONUP
If middleClickTime <> 0I Then
middleClickTime = Environment.TickCount() - middleClickTime
End If
If (middleClickTime <> 0I) AndAlso (middleClickTime < NativeMethods.GetDoubleClickTime()) Then
middleClickTime = 0I
If Not Me.SuppressMouseUpEventWhenDoubleClick Then
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
RaiseEvent MouseMiddleDoubleClick(Me, New Point(x, y))
Else
middleClickTime = Environment.TickCount()
RaiseEvent MouseMiddleUp(Me, New Point(x, y))
End If
Case NativeMethods.WindowsMessages.WM_MOUSEWHEEL
RaiseEvent MouseWheel(Me, New Point(x, y), If(mouseStruct.MouseData < 0I,
WheelDirection.WheelDown,
WheelDirection.WheelUp))
Case Else
' Do Nothing
Exit Select
End Select
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
ElseIf nCode < 0I Then
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
Else ' nCode > 0
Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam))
End If
End Function
#End Region
#Region "IDisposable Support"
''' <summary>
''' Flag to detect redundant calls at <see cref="Dispose"/> method.
''' </summary>
Private disposedValue As Boolean
Protected Sub Dispose(ByVal disposing As Boolean)
Me.IsEnabled = False
If Not Me.disposedValue Then
If disposing Then ' Dispose managed state (managed objects).
Else ' Free unmanaged resources (unmanaged objects).
NativeMethods.UnhookWindowsHookEx(Me.MouseHook)
End If
End If
Me.disposedValue = True
End Sub
Protected Overrides Sub Finalize()
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=False)
MyBase.Finalize()
End Sub
Private Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean)
Me.Dispose(disposing:=True)
GC.SuppressFinalize(obj:=Me)
End Sub
#End Region
End Class
#End Region
此 post 中的文档几乎不够。您应该能够 post 一个可重现的小例子。 "stops working" 之类的语句实际上没有传达任何信息。如果您遇到错误，请 post 例外。
话虽如此...
听起来你的回调正在被垃圾收集。您需要将委托保存在至少具有挂钩生命周期的变量中。 Shared class 成员是一个很好的候选人。
例如：
'BAD!
Class MyClass
Public Sub Run()
Dim Hook as MouseHook = New MouseHook()
'install, enable, etc...
End Sub
'Hook is not saved and will be collected after Run() ends
End Class
应该是：
'Better
Class MyClass
Private Shared Hook as MouseHook
Public Sub Run()
Hook = New MouseHook()
'install, enable, etc...
End Sub
'Now, Hook IS saved and will live on after Run() ends
End Class
这是非常基础的，您应该根据自己的需要进行调整。同样，这只是一个猜测，因为没有足够的信息可以进一步说明。