vb中 如何监控 键盘和鼠标!

如何在其他程序中,当按下键盘或者鼠标时,都能获得比如程序有textbox,在一个网叶,当单击左键是textbox为左键,单击右键是为右键,按下键盘回车键是textbox为... 如何在其他程序中,当按下键盘 或者鼠标时,都能获得
比如程序有textbox ,在一个网叶,当单击左键是 textbox为左键,单击右键是为右键,按下键盘回车键是 textbox为回车!!
想监控键盘和鼠标的所有过程!
展开
 我来答
若以下回答无法解决问题,邀请你更新回答
远风的梦想家
2010-07-28 · TA获得超过2550个赞
知道大有可为答主
回答量:1389
采纳率:0%
帮助的人:0
展开全部
窗体代码:

Option Explicit

Private Sub form_Load()
KeyPreview = 1
ScaleMode = 3
AutoRedraw = 1
Caption = "键盘记录"
Module1.ints '初始化数据
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0) '挂钩
'加载
If hHook = 0 Then End
hHook2 = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MyNSEHook, App.hInstance, 0) '挂钩
'加载
If hHook2 = 0 Then End

End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook) '程序退出时
Call UnhookWindowsHookEx(hHook2) '程序退出时
End Sub

==========================
模块代码
Option Explicit

Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type

Public Type MSLLHOOKSTRUCT
X As Long
Y As Long
flag As Long
time As Long
extraInfo As Long
End Type

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public Const WH_MOUSE_LL = 14

Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOUSEWHEEL = &H20A
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
'全局变量
Public hHook&, hHook2&, i%, appStr$, s1$, s2$, pos1$(), pos2$()
Sub ints() '加载ascii码与对应的键盘内容
s1 = "96 97 98 99 100 101 102 103 104 105 106 107 109 110 111 13 " + "144 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 " + "85 86 87 88 89 90 48 49 50 51 52 53 54 55 56 57 192 189 187 220 8 " + "44 45 46 145 36 35 19 33 34 38 40 37 39 27 112 113 114 115 116 117 " + "118 119 120 121 122 123 9 20 160 162 91 13 161 92 93"
s2 = "小0 小1 小2 小3 小4 小5 小6 小7 小8 小9 小* 小+ 小- 小. 小/ " + "小Enter 小NumLock A B C D E F G H I G K L M N O P Q R S T U V W X Y Z " + "0 1 2 3 4 5 6 7 8 9 ` - = \ BackSpace " + "PrintScreen Insert Delete ScrollLock Home End PauseBreak PageUp PageDown " + "上 下 左 右 ESC F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 " + "TAB CapsLock 左Shift 左Ctrl 左Win Enter 右Shift 右Win 右List 右Ctrl"
pos1 = Split(s1, " "): pos2 = Split(s2, " ") '将内容数组化
End Sub
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then '当按键后
If wParam = WM_KEYDOWN Then
CopyMemory mymsg, ByVal lParam, Len(mymsg)
For i = 0 To UBound(pos1) - 1
If mymsg.vKey = Val(pos1(i)) Then '寻找按键对应ascii码的位置,再找到对应的键盘内容
Form1.Text1.Text = pos2(i)
Exit For '准备写入的内容
End If
Next
End If
End If

MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function

Public Function MyNSEHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim msehk As MSLLHOOKSTRUCT
CopyMemory msehk, ByVal lParam, Len(msehk)

If ncode = 0 Then
Select Case wParam
Case WM_LBUTTONDOWN
Form1.Text1.Text = "左键按下"
Case WM_LBUTTONUP
Form1.Text1.Text = "左键弹起"
Case WM_MOUSEMOVE
Form1.Text1.Text = "鼠标移动"
Case WM_MOUSEWHEEL
Form1.Text1.Text = "鼠标中键滚动"
Case WM_MBUTTONDOWN
Form1.Text1.Text = "中键按下"
Case WM_MBUTTONUP
Form1.Text1.Text = "中键弹起"
Case WM_RBUTTONDOWN
Form1.Text1.Text = "右键按下"
Case WM_RBUTTONUP
Form1.Text1.Text = "右键弹起"
End Select
Form1.Text1.Text = Form1.Text1.Text & ",坐标" & msehk.X & "," & msehk.Y
End If

MyNSEHook = CallNextHookEx(hHook2, ncode, wParam, lParam)
End Function
本回答被提问者采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
恋红2010
2010-07-28 · TA获得超过1961个赞
知道大有可为答主
回答量:1469
采纳率:50%
帮助的人:570万
展开全部
应该用Hook方法去实现吧,常规方法是做不到的.
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 2条折叠回答
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式