2个回答
展开全部
’使用钩子函数可以实现,我网上找了一段代码测试了一下可以用,但你测试的时候注意2点:
1、关闭时软件时按软件的X,不要使用vb环境中的停止按钮,不然hook不能卸载(unload事件怎么会不触发?),我想编译后不会有这样的情况。
2、我的鼠标没有中建,模块中我已注释,按下中间然后获取中键的键码,然后再写个判断调用你的函数或过程,可以理解为你说的事件。模块中很多代码对你没有用自己修改一下,另可能有些杀毒软件直接把这个程序作为病毒处理的,这点注意一下。
‘--------------------
'form1
Option Explicit
Private Sub Form_Load()
EnableHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
FreeHook
End Sub
'-----------
'module
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
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
Private Const HC_ACTION = 0
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_MOUSEFIRST = &H200
Private Const WM_MOUSELAST = &H209
Private Const WM_MOUSEWHEEL = &H20A '以上是鼠标的各个值
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
Flags As Long
time As Long
dwExtraInfo As Long
End Type
Public hHook As Long
Public Sub EnableHook()
If hHook = 0 Then
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0)
End If
End Sub
Public Sub FreeHook()
If hHook <> 0 Then
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
End Sub
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim typMHS As MSLLHOOKSTRUCT, pt As POINTAPI
If wParam = WM_MOUSEMOVE Then
Call CopyMemory(typMHS, ByVal lparam, LenB(typMHS))
pt = typMHS.pt
Debug.Print "mouse Cursor at " + CStr(pt.x) + "," + CStr(pt.y)
End If
If wParam = WM_LBUTTONDOWN Then
Debug.Print "l"
End If
If wParam = WM_RBUTTONDOWN Then
Debug.Print "r"
End If
Debug.Print wParam '按下中间记下这个值,然后调用一个过程,我的鼠标没有中键,自己测试一下
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
End Function
1、关闭时软件时按软件的X,不要使用vb环境中的停止按钮,不然hook不能卸载(unload事件怎么会不触发?),我想编译后不会有这样的情况。
2、我的鼠标没有中建,模块中我已注释,按下中间然后获取中键的键码,然后再写个判断调用你的函数或过程,可以理解为你说的事件。模块中很多代码对你没有用自己修改一下,另可能有些杀毒软件直接把这个程序作为病毒处理的,这点注意一下。
‘--------------------
'form1
Option Explicit
Private Sub Form_Load()
EnableHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
FreeHook
End Sub
'-----------
'module
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
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
Private Const HC_ACTION = 0
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_MOUSEFIRST = &H200
Private Const WM_MOUSELAST = &H209
Private Const WM_MOUSEWHEEL = &H20A '以上是鼠标的各个值
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
Flags As Long
time As Long
dwExtraInfo As Long
End Type
Public hHook As Long
Public Sub EnableHook()
If hHook = 0 Then
hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0)
End If
End Sub
Public Sub FreeHook()
If hHook <> 0 Then
Call UnhookWindowsHookEx(hHook)
hHook = 0
End If
End Sub
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim typMHS As MSLLHOOKSTRUCT, pt As POINTAPI
If wParam = WM_MOUSEMOVE Then
Call CopyMemory(typMHS, ByVal lparam, LenB(typMHS))
pt = typMHS.pt
Debug.Print "mouse Cursor at " + CStr(pt.x) + "," + CStr(pt.y)
End If
If wParam = WM_LBUTTONDOWN Then
Debug.Print "l"
End If
If wParam = WM_RBUTTONDOWN Then
Debug.Print "r"
End If
Debug.Print wParam '按下中间记下这个值,然后调用一个过程,我的鼠标没有中键,自己测试一下
HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)
End Function
2012-03-20
展开全部
钩子了
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询