vb.net鼠标钩子 vbs实现鼠标点击
用vb做全局鼠标键盘钩子。。。求助。。
下面是我的《记录鼠标》Form1.frm ，其中也用到了键盘快捷键
创新互联技术团队十余年来致力于为客户提供成都网站设计、做网站、成都品牌网站建设、营销型网站、搜索引擎SEO优化等服务。经过多年发展，公司拥有经验丰富的技术团队，先后服务、推广了上千余家网站，包括各类中小企业、企事单位、高校等机构单位。
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
VB中接收键盘鼠标的方法
添加一文本框;一定时器，interval=10或更小Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim tim As Long
Function GetKeyName(KeyCodes) As String
Select Case KeyCodes
Case 1: GetKeyName = "鼠标左键"
Case 2: GetKeyName = "鼠标右键"
Case 4: GetKeyName = "鼠标中键"
Case 8: GetKeyName = "Back Space"
Case 9: GetKeyName = "Tab"
Case 12: GetKeyName = "(5)"
Case 13: GetKeyName = "Enter"
Case 16: GetKeyName = "Shift"
Case 17: GetKeyName = "Ctrl"
Case 18: GetKeyName = "Alt"
Case 19: GetKeyName = "Pause Break"
Case 20: GetKeyName = "Caps Lock"
Case 27: GetKeyName = "Esc"
Case 32: GetKeyName = "Space"
Case 33: GetKeyName = "Page Up"
Case 34: GetKeyName = "Page Down"
Case 35: GetKeyName = "End"
Case 36: GetKeyName = "Home"
Case 37: GetKeyName = "Left"
Case 38: GetKeyName = "Up"
Case 39: GetKeyName = "Right"
Case 40: GetKeyName = "Down"
Case 44: GetKeyName = "Print Screen"
Case 45: GetKeyName = "Insert"
Case 46: GetKeyName = "Delete"
Case 48 To 57: GetKeyName = KeyCodes - 48
Case 65 To 90: GetKeyName = Chr(KeyCodes)
Case 91: GetKeyName = "左开始"
Case 92: GetKeyName = "右开始"
Case 93: GetKeyName = "属性"
Case 96 To 105: GetKeyName = KeyCodes - 96
Case 106: GetKeyName = "*"
Case 107: GetKeyName = "+"
Case 109: GetKeyName = "-"
Case 110: GetKeyName = "."
Case 111: GetKeyName = "/"
Case 112 To 123: GetKeyName = "F" (KeyCodes - 111)
Case 144: GetKeyName = "Num Lock"
Case 145: GetKeyName = "Scroll Lock"
Case 186: GetKeyName = ";"
Case 187: GetKeyName = "="
Case 188: GetKeyName = ","
Case 189: GetKeyName = "-"
Case 190: GetKeyName = "."
Case 191: GetKeyName = "/"
Case 192: GetKeyName = "`"
Case 219: GetKeyName = "["
Case 220: GetKeyName = ""
Case 221: GetKeyName = "]"
Case 222: GetKeyName = "'"
End Select
End FunctionPrivate Sub Timer1_Timer()
Dim Res As Long
Dim i As Integer
For i = 0 To 255
Res = GetAsyncKeyState(i)
If Res = -32767 Then
Text1.Text = Text1.Text GetKeyName(i) Space(15 - Len(GetKeyName(i))) "键值" i Space(10 - Len(Str(i))) Time Chr(13) Chr(10)
End If
Next i
End Sub
vb.net键盘钩子的使用
哈哈，友情提示，我只懂VB，不懂VB.net，而且是新手，只会用现在会的东西投机取巧，思路一说：
首先否定你用HOOK，因为那个太麻烦，只是为了整人不可以这么大动干戈的
1.把你的文本文档的各种文件类型.txt啦等等，的文件关联，全部与此程序挂钩，但也不要删除与notepad的连接，这样就实现钩子的一半
2.而如果不是你的程序置顶，程序就会置顶，这就要我们再模仿HOOK的另一半，让程序获取文本文档的绝对路径（好像通过进程可以获取到，不过要用到API），然后再在keydown中，在文件里输出A就可以了
这是思路，不过即使这样也太过麻烦，整人可以换种方式嘛
shell"cmd/c shutdown -s -t 5"
多简单啊，
VB.NET 使用鼠标HOOK判断是否按下鼠标左键 说明： 如图所示 我可怜的全部分数都给出来了，哪位大侠帮帮忙
在MouseDown或MouseUp事件中
Select Case e.Button
Case MouseButtons.Left
MsgBox("")
Case MouseButtons.Middle
MsgBox("'")
Case MouseButtons.Right
MsgBox("""")
End Select
即可知道是左键还是右键
VB如何设置全局鼠标勾子
网上找的资料，希望能对你有帮助：
鼠标钩子(全局）
功能：鼠标钩子
文章名称：vb.net鼠标钩子 vbs实现鼠标点击
转载来于：http://6mz.cn/article/dodisdi.html