vb 全局钩子的问题

yiluhangxing 2010-06-03 03:42:30
是我写的一个小程序。我的目的:是在启动我的程序后,我在启动其他的程序,比如打开记事本,我在记事本里输入字母A同时我也希望通过A键来触发我编写的那个程序的按钮事件。我再网上查的说需要安装全局钩子来时截取键盘信息。来实现这个功能。但是我一直做不出来,希望各位答谢给看一下。如果给写个例子就再好不过了,在这先谢谢了
窗体代码
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
Public hHook As Long


Private Sub Command1_Click()
Label1.Caption = "全局钩子测试"
End Sub

Private Sub Form_Load()
hHook = SetWindowsHookEx(13, AddressOf MyKBHook, 0, App.ThreadID)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub


模块代码
Public a As Long
Public Function MyKBHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If wParam = vbKeyA Then
Form1.Command1_Click
End If
Call CallNextHookEx(hHook, iCode, wParam, lParam)
End Function
...全文
127 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
贝隆 2010-06-03
  • 打赏
  • 举报
回复
lovezhufei517 2010-06-03
  • 打赏
  • 举报
回复
还有,没有注册热键,hotkey
a1875566250 2010-06-03
  • 打赏
  • 举报
回复
以及,低级键盘钩子的虚拟键码不是wp参数,而是lp参数指向一个KBDLLHOOKSTRUCT结构的指针,你需要使用RtlMoveMemory复制lp参数的值,这是指向结构体的指针,或者直接把钩子回调函数的lp参数改为lParam As KBDLLHOOKSTRUCT

在KBDLLHOOKSTRUCT结构体中的keycode值才是判断键码。
a1875566250 2010-06-03
  • 打赏
  • 举报
回复
LZ你错在Form的Load那里
应该改成:SetWindowsHookEx(13,AddressOf MyKBHook,App.hInstance,0)
倒大霉的上帝 2010-06-03
  • 打赏
  • 举报
回复
[Quote=引用 2 楼 zhao4zhong1 的回复:]
参考AutoHotKey源代码http://www.autohotkey.com
[/Quote]
赵4老师 2010-06-03
  • 打赏
  • 举报
回复
参考AutoHotKey源代码http://www.autohotkey.com
bodybo 2010-06-03
  • 打赏
  • 举报
回复
给你个列子

Public 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
Public Declare Function UnhookWindowsHookEx Lib "USER32" (ByVal hHook As Long) As Long
Public Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Integer
Public Declare Function CallNextHookEx Lib "USER32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Type KEYMSGS
vKey As Long '虚拟码 (and &HFF)
sKey As Long '扫描码
flag As Long '键按下:128 抬起:0
time As Long 'Window运行时间
End Type
Public Type MOUSEMSGS
x As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type
Public Type POINTAPI
x As Long
Y As Long
End Type
Public Const WH_KEYBOARD_LL = 13
Public Const WH_MOUSE_LL = 14
Public Const Alt_Down = &H20
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
'键盘消息
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
'鼠标消息
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSELAST = &H209
Public Const WM_MOUSEWHEEL = &H20A
Public Declare Function GetKeyNameText Lib "USER32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public strKeyName As String * 255
Public Declare Function GetActiveWindow Lib "USER32" () As Long
Public keyMsg As KEYMSGS
Public MouseMsg As MOUSEMSGS

Private lKeyHook As Long
Private lMouseHook As Long

'----------------------------------------
'模拟鼠标
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Declare Sub mouse_event Lib "USER32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ClientToScreen Lib "USER32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'--------------------------------------
'模拟按键
Private Declare Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)


Public keyUpDown As Integer
Public blflag As Boolean
Public specFlag As Boolean


'鼠标钩子
Public Function CallMouseHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pt As POINTAPI

If code = HC_ACTION Then
CopyMemory MouseMsg, lParam, LenB(MouseMsg)

Select Case wParam
Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MOUSEWHEEL

End Select


' If wParam = WM_MBUTTONDOWN Then '把中键改为左键
'' mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
'' CallMouseHookProc = 1
' End If
'
' If wParam = WM_MBUTTONUP Then
'' mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'' CallMouseHookProc = 1
' End If

End If

If code <> 0 Then
CallMouseHookProc = CallNextHookEx(lMouseHook, code, wParam, lParam)
End If

End Function

'键盘钩子
Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lKey As Long
Dim vKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
Dim strTemp As String
Dim continue As Boolean

continue = True
If code = HC_ACTION Then

CopyMemory keyMsg, lParam, LenB(keyMsg)
vKey = keyMsg.vKey And &HFF

Select Case wParam
' Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_KEYUP:
Case WM_KEYDOWN, WM_SYSKEYDOWN:

If vKey = vbKeyF11 Then
End If

If vKey = vbKeyUp And blflag Then '侦测 有没有按到向上键

ElseIf vKey = vbKeyDown And blflag Then '侦测 有没有按到向下键

Else

End If

If (keyMsg.flag And Alt_Down) <> 0 And vKey = vbKeyD Then

End If


If (GetKeyState(vbKeyShift) And &H8000) Then
'按下shift键
End If

If (GetKeyState(vbKeyControl) And &H8000) Then
'按下ctrl键
End If

Case WM_KEYUP
End Select
End If


If continue Then
CallKeyHookProc = CallNextHookEx(lKeyHook, code, wParam, lParam)
End If
End Function

'安装钩子
Public Sub AddHook()
blflag = False
'键盘钩子
lKeyHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)

'鼠标钩子
lMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub

'卸钩子
Public Sub DelHook()
UnhookWindowsHookEx lKeyHook
UnhookWindowsHookEx lMouseHook
End Sub




1,485

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧