用vb做全局鼠标键盘钩子。。。求助。。

2024-12-30 23:39:41
推荐回答(4个)
回答1:

下面是我的《记录鼠标》Form1.frm ,其中也用到了键盘快捷键

VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "记录鼠标"
ClientHeight = 4500
ClientLeft = 45
ClientTop = 435
ClientWidth = 7620
FillColor = &H000000FF&
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4500
ScaleWidth = 7620
StartUpPosition = 3 '窗口缺省
Begin VB.CheckBox Check1
Caption = "操作时是否可以看到本软件"
Height = 255
Left = 4560
TabIndex = 14
Top = 240
Value = 1 'Checked
Width = 3015
End
Begin VB.TextBox Tttex
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 3480
Locked = -1 'True
TabIndex = 13
Text = "0<*>0"
Top = 570
Width = 1815
End
Begin VB.CommandButton Command6
Caption = "退出 (&E)"
Height = 375
Left = 6120
TabIndex = 12
Top = 3960
Width = 1335
End
Begin VB.Timer Timer3
Enabled = 0 'False
Interval = 1000
Left = 3600
Top = 4320
End
Begin VB.TextBox Text2
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 3480
TabIndex = 7
Text = "20"
Top = 240
Width = 615
End
Begin VB.CommandButton Command5
Caption = "清空录制 (&Z)"
Height = 375
Left = 3000
TabIndex = 6
Top = 3480
Width = 1335
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 270
Left = 3480
TabIndex = 5
Text = "D:\鼠标记录.text"
Top = 900
Width = 3975
End
Begin VB.CommandButton Command4
Caption = "打开录制 (&V)"
Height = 375
Left = 3000
TabIndex = 4
Top = 3960
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "保存录制 (&B)"
Height = 375
Left = 4560
TabIndex = 3
Top = 3960
Width = 1335
End
Begin VB.ListBox List1
Height = 4200
ItemData = "Form1.frx":324A
Left = 120
List = "Form1.frx":324C
TabIndex = 2
Top = 120
Width = 2295
End
Begin VB.CommandButton Command2
Caption = "回放录制 (&C)"
Height = 375
Left = 6120
TabIndex = 1
Top = 3480
Width = 1335
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 20
Left = 3000
Top = 4320
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 20
Left = 2400
Top = 4320
End
Begin VB.CommandButton Command1
Caption = "开始录制 (&X)"
Height = 375
Left = 4560
TabIndex = 0
Top = 3480
Width = 1335
End
Begin VB.Label Label5
Caption = "用法"
Height = 1935
Left = 2520
TabIndex = 11
Top = 1440
Width = 4935
End
Begin VB.Label Label4
Caption = "保存地址:"
Height = 255
Left = 2520
TabIndex = 10
Top = 960
Width = 1575
End
Begin VB.Label Label3
Caption = "当前位置:"
Height = 255
Left = 2520
TabIndex = 9
Top = 600
Width = 1455
End
Begin VB.Label Label2
Caption = "回放速度:"
Height = 255
Left = 2520
TabIndex = 8
Top = 300
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'获得鼠标点
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'移到鼠标点
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'按下键盘
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'鼠标键 - 要求按下
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 Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
'锁定,鼠标和键盘
Private Declare Function BlockInput Lib "user32" (ByVal fEnable As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'定义

Dim xxx, yyy
Dim SSSDDD As String
Dim CC
'鼠标点类型
Private Type POINTAPI
x As Long
y As Long
End Type
'获得键盘按下
Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode))
End Function
'获得鼠标键按下
Private Function MyKey(vbKeyLButton) As Boolean
MyKey = GetAsyncKeyState(vbKeyLButton)
End Function

Private Sub Form_Load()
CC = "记录鼠标"
SSSDDD = "0"
Timer1.Enabled = True
Timer2.Enabled = False
Timer3.Enabled = False
Label5.Caption = "用法:1 开始录制时按下 A 键停止录制;" & vbCrLf & _
" 2 本软件还可以按下 S 锁定鼠标和键盘,不可移动;" & vbCrLf & _
" 3 本软件还可以按下 D 锁定鼠标和键盘,可移动;" & vbCrLf & _
" 4 每个控制都有一个快捷键,就是每个按钮后括号内。" & vbCrLf & _
vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
" " & App.Title + "( 版本 " & App.Major & "." & App.Minor & "." & App.Revision & " )" '当前版本号是
End Sub

'速度
Private Sub Text2_KeyPress(KeyAscii As Integer)
'文本中只能输入( 0123456789. )数字
If InStr(1, "0123456789", UCase(Chr(KeyAscii)), 1) <= 0 Then KeyAscii = 0
End Sub
Private Sub Text2_Change()
If Text2.Text > 0 Then Timer2.Interval = Text2.Text
End Sub

'读保文件
Private Sub Command3_Click() 'List1 保存 *.txt
Dim fn As Integer, i As Integer
fn = FreeFile
Open Text1.Text For Output As #1
For i = 0 To List1.ListCount - 1
Print #1, List1.List(i)
Next
Close #1
MsgBox "成功保存到: " & Text1.Text
End Sub
Private Sub Command4_Click() 'List1 读取 *.txt
List1.Clear '清空
Open Text1.Text For Input As #1
Do While Not EOF(1)
Line Input #1, Temp
List1.AddItem Temp
Loop
Close #1
End Sub

'清空List1
Private Sub Command5_Click()
List1.Clear
End Sub

'回放录制
Private Sub Command2_Click()
ShFu
If List1.ListCount > 0 Then
List1.ListIndex = 1
Form1.Caption = "记录鼠标 - 正在回放"
Timer2.Enabled = True
End If
End Sub
Private Sub Timer2_Timer()
Dim x
List1.ListIndex = List1.ListIndex - 0 + 1
x = Split(List1.Text, "<*>")
SetCursorPos x(0), x(1) '你所需要点的位置
If x(2) = "左" Then ZuoDanJi
If x(2) = "中" Then ZongDanJi
If x(2) = "右" Then YouDanJi
If List1.ListIndex >= List1.ListCount - 1 Then Form1.Caption = "记录鼠标": CC = "停锁记录鼠标": YhFu: Timer2.Enabled = False
End Sub

'鼠标左键点击
Private Sub ZuoDanJi()
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0& '模拟鼠标点击
End Sub
'鼠标中键点击
Private Sub ZongDanJi()
mouse_event MOUSEEVENTF_MIDDLEDOWN Or MOUSEEVENTF_MIDDLEUP, 0&, 0&, 0&, 0& '模拟鼠标点击
End Sub
'鼠标右键点击
Private Sub YouDanJi()
mouse_event MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0&, 0&, 0&, 0& '模拟鼠标点击
End Sub
'开始录制
Private Sub Command1_Click()
ShFu
Form1.Caption = "记录鼠标 - 正在录制(按下A键停止)"
End Sub
'录制
Private Sub Tttex_Change()
If Form1.Caption = "记录鼠标 - 正在录制(按下A键停止)" Then List1.AddItem Tttex.Text
End Sub

Private Sub Timer1_Timer()
Dim MousG
If MyKey(vbKeyLButton) Then MousG = "左"
If MyKey(vbKeyMButton) Then MousG = "中"
If MyKey(vbKeyRButton) Then MousG = "右"

Dim P1 As POINTAPI
GetCursorPos P1
Tttex.Text = P1.x & "<*>" & P1.y & "<*>" & MousG
MousG = "0"

'快捷键
If MyHotKey(vbKeyA) Then Form1.Caption = "记录鼠标": CC = "停锁记录鼠标": YhFu 'A键盘按下
If MyHotKey(vbKeyX) Then Command1_Click: ShFu
If MyHotKey(vbKeyC) Then Command2_Click: ShFu
If MyHotKey(vbKeyB) Then Command3_Click
If MyHotKey(vbKeyV) Then Command4_Click
If MyHotKey(vbKeyZ) Then Command5_Click
If MyHotKey(vbKeyE) Then Command6_Click
If MyHotKey(vbKeyS) Then SSS: ShFu
If MyHotKey(vbKeyD) Then DDD: ShFu
End Sub

'锁定,鼠标和键盘
Private Sub Timer3_Timer()
If SSSDDD > 0 Then SSSDDD = SSSDDD - 1
If CC = "不可移动" Then Form1.Caption = "记录鼠标 - 锁定鼠标和键盘不可移动 " & SSSDDD & "秒后解锁"
If CC = "可移动" Then Form1.Caption = "记录鼠标 - 锁定鼠标和键盘可移动 " & SSSDDD & "秒后解锁"
If SSSDDD < 1 Then
BlockInput (0)
Form1.Caption = "记录鼠标"
CC = "停锁记录鼠标"
Timer3.Enabled = False
YhFu
End If '恢复
End Sub
Private Sub SSS()
Form1.Caption = "记录鼠标 - 锁定鼠标和键盘,不可移动"
SSSDDD = InputBox("提示", "请问你想锁定多少秒?", "10")
CC = "不可移动"
Timer3.Enabled = True
BlockInput (5) '锁定,不可移动
End Sub
Private Sub DDD()
Form1.Caption = "记录鼠标 - 锁定鼠标和键盘,可移动"
SSSDDD = InputBox("提示", "请问你想锁定多少秒?", "10")
CC = "可移动"
Timer3.Enabled = True
Call Sleep(SSSDDD) '锁定,可移动
End Sub

'操作时是否可以看到本软件
Private Sub ShFu() '
If Check1.Value = 0 Then Form1.Hide '隐藏
End Sub
Private Sub YhFu() '
If CC = "停锁记录鼠标" Then
Form1.Show '显示
CC = "鼠标记录"
End If
End Sub

'删除List1中的一行
Private Sub List1_DblClick() '
List1.RemoveItem List1.ListIndex
End Sub

'退出
Private Sub Command6_Click()
End
End Sub

回答2:

首先,你的问题需要实现热键+鼠标钩子。
下面我贴的代码都是我的模块,你自己组合下就可以了。
'====================鼠标钩子(全局)===========================
'============================================
'功能:鼠标钩子
'===========================================
'窗体
'Text1 -- 显示鼠标左键按下的次数
'Text2 -- 显示鼠标中键按下的次数
'Text3 -- 显示鼠标右键按下的次数
'Text4 -- 显示鼠标按下的总次数
Private Sub AddHook() '安装鼠标钩子
lHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf CallMouseHookProc, App.hInstance, 0)
End Sub
Private Sub DelHook() '卸除鼠标钩子
UnhookWindowsHookEx lHook
End Sub
Private Sub Form_Load() '窗体载入的时候,安装鼠标钩子
AddHook
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载的时候,卸除鼠标钩子
DelHook
End Sub
'============================================
'模块

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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Type MOUSEMSGS
X As Long 'x座标
Y As Long 'y座标
a As Long
b As Long
time As Long 'Window运行时间
End Type

Public Const WH_MOUSE_LL = 14
'-----------------------------------------
'消息
Public Const HC_ACTION = 0

'鼠标消息
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 MouseMsg As MOUSEMSGS
Public lHook As Long '记录Hook的值,以便退出程序的时候销毁Hook
Public lClick As Long, mClick As Long, rClick As Long, tClick As Long '用来统计鼠标各个键的按下次数

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

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

Form1.Caption = "X=" + Str(MouseMsg.X) + " Y=" + Str(MouseMsg.Y) '在主窗口上显示鼠标的当前位置

Select Case wParam '根据不同鼠标动作进行处理,在这里只处理了鼠标按下的动作
Case WM_LBUTTONDOWN '左键按下
lClick = lClick + 1 '进行统计,并显示在住窗体的文本框上
tClick = tClick + 1
Form1.Text1.Text = lClick '左键统计
Form1.Text4.Text = tClick '总数
Form1.Text6 = Val(Form1.Text6) + 1
CallMouseHookProc = 0 '这里把返回值设定为0,保证鼠标动作正常完成
Case WM_MBUTTONDOWN '中键按下
mClick = mClick + 1
tClick = tClick + 1
Form1.Text2.Text = mClick '中键统计
Form1.Text4.Text = tClick '总数
CallMouseHookProc = 0
Case WM_RBUTTONDOWN '右键按下
rClick = rClick + 1
tClick = tClick + 1
Form1.Text3.Text = rClick '右键统计
Form1.Text4.Text = tClick '总数
CallMouseHookProc = 0
End Select
End If

If code <> 0 Then
CallMouseHookProc = CallNextHookEx(0, code, wParam, lParam) '使用CallNextHookEx,来保证鼠标钩子能够被其它程序使用
End If

End Function

'=========================热键================================
'窗体
Private Sub Form_Load()
RegisterHotKey Me.hWnd, &HB003, 0, 115 '定义F4为热键
RegisterHotKey Me.hWnd, &HB004, 0, 116 '定义F5为热键
RegisterHotKey Me.hWnd, &HB005, 0, 117 '定义F6为热键
p = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf wnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnregisterHotKey(Me.hWnd, &HB015)
Call UnregisterHotKey(Me.hWnd, &HB016)
Call UnregisterHotKey(Me.hWnd, &HB017)
SetWindowLong Me.hWnd, GWL_WNDPROC, p
End Sub

'====================================模块
Option Explicit
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer '大小写
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = (-4)
Public p&
Public Function wnd(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
Dim allkey As String
If Msg = WM_HOTKEY Then
Select Case wp
Case &HB003
allkey = "F4键" '要发生的事件,这里写安装/卸载鼠标钩子
Case &HB004
allkey = "F5键"
Case &HB005
allkey = "F6键"
Case &HB006
End Select
End If
wnd = CallWindowProc(p, hWnd, Msg, wp, lp)
End Function

回答3:

其实都是大同小异的事情 申请一个全局钩子不久完啦;SETWINDOWSHOOKEX用这个函数申请一个全局钩子;
HHOOK SetWindowsHookEx(
int idHook, // hook type
HOOKPROC lpfn, // hook procedure
HINSTANCE hMod, // handle to application instance
DWORD dwThreadId // thread identifier
);
这是MSDN的定义;第二项是一个回调函数;到时候自己写个自定义函数就行啦;在自定义函数里面处理键盘钩子消息;忘记告诉你啦 第一项是钩子的类型;钩子的类型设置成WH_KEYBOARD;键盘钩子;OK;这毕竟只是一些分;我不可能给你写个程序让你照搬;上面的已经很详细啦;如果你看不懂 那你最好还是继续学习吧 即使别人给你源码 你也是玩玩 看不懂

回答4:

当心被当作病毒