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实现鼠标点击
URL分享：http://scjbc.cn/article/dodisdi.html