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

下面是我的《记录鼠标》Form1frm ，其中也用到了键盘快捷键

VERSION 500

Begin VBForm Form1

BorderStyle = 1 'Fixed Single

Caption = "记录鼠标"

ClientHeight = 4500

ClientLeft = 45

ClientTop = 435

ClientWidth = 7620

FillColor = &H000000FF&

Icon = "Form1frx":0000

LinkTopic = "Form1"

MaxButton = 0 'False

MinButton = 0 'False

ScaleHeight = 4500

ScaleWidth = 7620

StartUpPosition = 3 '窗口缺省

Begin VBCheckBox Check1

Caption = " *** 作时是否可以看到本软件"

Height = 255

Left = 4560

TabIndex = 14

Top = 240

Value = 1 'Checked

Width = 3015

End

Begin VBTextBox 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 VBCommandButton Command6

Caption = "退出 (&E)"

Height = 375

Left = 6120

TabIndex = 12

Top = 3960

Width = 1335

End

Begin VBTimer Timer3

Enabled = 0 'False

Interval = 1000

Left = 3600

Top = 4320

End

Begin VBTextBox Text2

Alignment = 2 'Center

Appearance = 0 'Flat

Height = 270

Left = 3480

TabIndex = 7

Text = "20"

Top = 240

Width = 615

End

Begin VBCommandButton Command5

Caption = "清空录制 (&Z)"

Height = 375

Left = 3000

TabIndex = 6

Top = 3480

Width = 1335

End

Begin VBTextBox Text1

Appearance = 0 'Flat

Height = 270

Left = 3480

TabIndex = 5

Text = "D:\鼠标记录text"

Top = 900

Width = 3975

End

Begin VBCommandButton Command4

Caption = "打开录制 (&V)"

Height = 375

Left = 3000

TabIndex = 4

Top = 3960

Width = 1335

End

Begin VBCommandButton Command3

Caption = "保存录制 (&B)"

Height = 375

Left = 4560

TabIndex = 3

Top = 3960

Width = 1335

End

Begin VBListBox List1

Height = 4200

ItemData = "Form1frx":324A

Left = 120

List = "Form1frx":324C

TabIndex = 2

Top = 120

Width = 2295

End

Begin VBCommandButton Command2

Caption = "回放录制 (&C)"

Height = 375

Left = 6120

TabIndex = 1

Top = 3480

Width = 1335

End

Begin VBTimer Timer2

Enabled = 0 'False

Interval = 20

Left = 3000

Top = 4320

End

Begin VBTimer Timer1

Enabled = 0 'False

Interval = 20

Left = 2400

Top = 4320

End

Begin VBCommandButton Command1

Caption = "开始录制 (&X)"

Height = 375

Left = 4560

TabIndex = 0

Top = 3480

Width = 1335

End

Begin VBLabel Label5

Caption = "用法"

Height = 1935

Left = 2520

TabIndex = 11

Top = 1440

Width = 4935

End

Begin VBLabel Label4

Caption = "保存地址："

Height = 255

Left = 2520

TabIndex = 10

Top = 960

Width = 1575

End

Begin VBLabel Label3

Caption = "当前位置："

Height = 255

Left = 2520

TabIndex = 9

Top = 600

Width = 1455

End

Begin VBLabel 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"

Timer1Enabled = True

Timer2Enabled = False

Timer3Enabled = False

Label5Caption = "用法：1 开始录制时按下 A 键停止录制；" & vbCrLf & _

" 2 本软件还可以按下 S 锁定鼠标和键盘，不可移动；" & vbCrLf & _

" 3 本软件还可以按下 D 锁定鼠标和键盘，可移动；" & vbCrLf & _

" 4 每个控制都有一个快捷键，就是每个按钮后括号内。" & vbCrLf & _

vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _

" " & AppTitle + "( 版本 " & AppMajor & "" & AppMinor & "" & AppRevision & " )" '当前版本号是

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 Text2Text > 0 Then Timer2Interval = Text2Text

End Sub

'读保文件

Private Sub Command3_Click() 'List1 保存 txt

Dim fn As Integer, i As Integer

fn = FreeFile

Open Text1Text For Output As #1

For i = 0 To List1ListCount - 1

Print #1, List1List(i)

Next

Close #1

MsgBox "成功保存到: " & Text1Text

End Sub

Private Sub Command4_Click() 'List1 读取 txt

List1Clear '清空

Open Text1Text For Input As #1

Do While Not EOF(1)

Line Input #1, Temp

List1AddItem Temp

Loop

Close #1

End Sub

'清空List1

Private Sub Command5_Click()

List1Clear

End Sub

'回放录制

Private Sub Command2_Click()

ShFu

If List1ListCount > 0 Then

List1ListIndex = 1

Form1Caption = "记录鼠标 - 正在回放"

Timer2Enabled = True

End If

End Sub

Private Sub Timer2_Timer()

Dim x

List1ListIndex = List1ListIndex - 0 + 1

x = Split(List1Text, "<>")

SetCursorPos x(0), x(1) '你所需要点的位置

If x(2) = "左" Then ZuoDanJi

If x(2) = "中" Then ZongDanJi

If x(2) = "右" Then YouDanJi

If List1ListIndex >= List1ListCount - 1 Then Form1Caption = "记录鼠标": CC = "停锁记录鼠标": YhFu: Timer2Enabled = 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

Form1Caption = "记录鼠标 - 正在录制（按下A键停止）"

End Sub

'录制

Private Sub Tttex_Change()

If Form1Caption = "记录鼠标 - 正在录制（按下A键停止）" Then List1AddItem TttexText

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

TttexText = P1x & "<>" & P1y & "<>" & MousG

MousG = "0"

'快捷键

If MyHotKey(vbKeyA) Then Form1Caption = "记录鼠标": 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 Form1Caption = "记录鼠标 - 锁定鼠标和键盘不可移动 " & SSSDDD & "秒后解锁"

If CC = "可移动" Then Form1Caption = "记录鼠标 - 锁定鼠标和键盘可移动 " & SSSDDD & "秒后解锁"

If SSSDDD < 1 Then

BlockInput (0)

Form1Caption = "记录鼠标"

CC = "停锁记录鼠标"

Timer3Enabled = False

YhFu

End If '恢复

End Sub

Private Sub SSS()

Form1Caption = "记录鼠标 - 锁定鼠标和键盘，不可移动"

SSSDDD = InputBox("提示", "请问你想锁定多少秒？", "10")

CC = "不可移动"

Timer3Enabled = True

BlockInput (5) '锁定，不可移动

End Sub

Private Sub DDD()

Form1Caption = "记录鼠标 - 锁定鼠标和键盘，可移动"

SSSDDD = InputBox("提示", "请问你想锁定多少秒？", "10")

CC = "可移动"

Timer3Enabled = True

Call Sleep(SSSDDD) '锁定，可移动

End Sub

' *** 作时是否可以看到本软件

Private Sub ShFu() '

If Check1Value = 0 Then Form1Hide '隐藏

End Sub

Private Sub YhFu() '

If CC = "停锁记录鼠标" Then

Form1Show '显示

CC = "鼠标记录"

End If

End Sub

'删除List1中的一行

Private Sub List1_DblClick() '

List1RemoveItem List1ListIndex

End Sub

'退出

Private Sub Command6_Click()

End

End Sub

版本 2

DLL命令 api_设置系统钩子, 整数型, "user32dll", "SetWindowsHookExA", , , SetWindowsHookEx

参数 钩子类型, 整数型, , idHook

参数 回调函数地址, 整数型, , lpfn

参数 实例句柄, 整数型, , hmod

参数 线程ID, 整数型, , dwThreadId

DLL命令 api_呼叫下一钩子, 整数型, "user32dll", "CallNextHookEx", , , CallNextHookEx

参数 钩子句柄, 整数型, , hHook

参数 回调函数参数1, 整数型, , ncode

参数 回调函数参数2, 整数型, , wParam

参数 回调函数参数3, 整数型, , lParam

DLL命令 api_释放系统钩子, 整数型, "user32dll", "UnhookWindowsHookEx", , , UnhookWindowsHookEx

参数 钩子句柄, 整数型, , hHook

DLL命令 api_取实例句柄, 整数型, , "GetModuleHandleA", , ,

参数 程序名, 整数型

DLL命令 api_拷贝内存, 整数型, "kernel32", "RtlMoveMemory", , , RtlMoveMemory

参数 回调结构, 鼠标结构, , lpvDest

参数 钩子回调函数参数3, 整数型, , lpvSource

参数 尺寸, 整数型, , cbCopy

版本 2

数据类型 鼠标结构, 公开

成员 成员1, 整数型

成员 成员2, 坐标结构

成员 成员3, 整数型

数据类型 坐标结构

成员 x, 整数型

成员 y, 整数型

版本 2

支持库 spec

程序集 窗口程序集1

程序集变量 钩子句柄, 整数型

子程序 _按钮1_被单击

钩子句柄 ＝ api_设置系统钩子 (14, 取子程序地址 (&鼠标钩子回调函数), api_取实例句柄 (0), 0)

子程序 鼠标钩子回调函数, 整数型

参数 参数1

参数 参数2

参数 参数3

局部变量 鼠标信息, 鼠标结构

局部变量 坐标z, 坐标结构

判断开始 (参数2 ＝ 513)

_启动窗口标题 ＝ “你按下了鼠标左键”

默认

判断结束

判断开始 (参数2 ＝ 514)

_启动窗口标题 ＝ “你放开了鼠标左键”

默认

判断结束

判断开始 (参数2 ＝ 516)

_启动窗口标题 ＝ “你按下了鼠标右键”

默认

判断结束

判断开始 (参数2 ＝ 517)

_启动窗口标题 ＝ “你放开了鼠标右键”

默认

判断结束

如果真 (参数2 ＝ 512)

api_拷贝内存 (鼠标信息, 参数3, 10)

坐标z ＝ 鼠标信息成员2

输出调试文本 (“x=” ＋ 到文本 (坐标zx))

输出调试文本 (“y=” ＋ 到文本 (坐标zx))

如果真结束

返回 (api_呼叫下一钩子 (钩子句柄, 参数1, 参数2, 参数3))

子程序 _按钮2_被单击

api_释放系统钩子 (钩子句柄)

'哇好难!!! 竟然没人会  会的都不是人

'那些用"全局鼠标钩子"的是外星人 妖怪

'写以下代码的(用API的)是神是上帝:

'以下代码用上了 传说中的 "时钟控件" (高科技啊 一般人不会用的) 状态显示在了"窗口标题"(般人我不告诉他)

'注意 变量t 是 程序集变量

版本 2

程序集 窗口程序集1

程序集变量 t

子程序 __启动窗口_创建完毕

t ＝ 取启动时间 ()

时钟1时钟周期 ＝ 1

子程序 _时钟1_周期事件

如果 (测试虚拟键_ (1) ≠ 0)

  _启动窗口标题 ＝ “左键按下 ” ＋ 到文本 (取鼠标水平位置 ()) ＋ “,” ＋ 到文本 (取鼠标垂直位置 ())

  判断循环首 (测试虚拟键_ (1) ≠ 0)

  判断循环尾 ()

  _启动窗口标题 ＝ “左键d起 坐标 ” ＋ 到文本 (取鼠标水平位置 ()) ＋ “,” ＋ 到文本 (取鼠标垂直位置 ()) ＋ “ 间隔” ＋ 到文本 (取启动时间 () － t) ＋ “毫秒”

  t ＝ 取启动时间 ()

否则

  如果真 (测试虚拟键_ (2) ≠ 0)

      _启动窗口标题 ＝ “右键按下 ” ＋ 到文本 (取鼠标水平位置 ()) ＋ “,” ＋ 到文本 (取鼠标垂直位置 ())

      判断循环首 (测试虚拟键_ (2) ≠ 0)

      判断循环尾 ()

      _启动窗口标题 ＝ “右键d起 坐标 ” ＋ 到文本 (取鼠标水平位置 ()) ＋ “,” ＋ 到文本 (取鼠标垂直位置 ()) ＋ “ 间隔” ＋ 到文本 (取启动时间 () － t) ＋ “毫秒”

      t ＝ 取启动时间 ()

  如果真结束

如果结束

版本 2

DLL命令 测试虚拟键_, 整数型, "user32", "GetAsyncKeyState"

  参数 键代码, 整数型, , vKey Long，欲测试的虚拟键的键码

动态鼠标、

考虑用全局鼠标钩子--fast

在鼠标钩子的回调函数获得屏幕设备的CDC，在鼠标的坐标处DrowText或者TextOut绘图，至于变颜色，设置一个全局颜色变量，进一次钩子回调函数变化一次就OK了

版本 2

子程序 鼠标钩子回调函数, 整数型

参数 参数一, 整数型

参数 参数二, 整数型

参数 参数三, 整数型

局部变量 鼠标, MOUSEHOOKSTRUCT

局部变量 鼠标键值, 整数型

CopyMemory (鼠标, 参数三, 20)

判断开始 (参数二 ＝ 512)

标签1标题 ＝ 到文本 (鼠标ptX － _启动窗口左边 ) ＋ “,” ＋ 到文本 (鼠标ptY － _启动窗口顶边 )

默认

判断结束

返回 (CallNextHookEx (鼠标钩子, 参数一, 参数二, 参数三))

子程序 __启动窗口_创建完毕

鼠标钩子 ＝ SetWindowsHookEx (14, &鼠标钩子回调函数, GetModuleHandle (0), 0)

子程序 __启动窗口_将被销毁

UnHookWindowsHookEx (鼠标钩子)

版本 2

数据类型 MOUSEHOOKSTRUCT

成员 pt, POINT

成员 hwnd, 整数型

成员 wHitTestCode, 整数型

成员 dwExtraInfo, 整数型

版本 2

DLL命令 GetModuleHandle, 整数型, , "GetModuleHandleA", , , 获取句柄

参数 lpModuleName, 整数型

DLL命令 CallNextHookEx, 整数型, , "CallNextHookEx", , , 下一个钩子

参数 hhk, 整数型

参数 nCode, 整数型

参数 wParam, 整数型

参数 lParam, 整数型

DLL命令 SetWindowsHookEx, 整数型, , "SetWindowsHookExA", , , 创建钩子

参数 idHook, 整数型

参数 lpfn, 子程序指针

参数 hmod, 整数型

参数 dwThreadId, 整数型

DLL命令 UnHookWindowsHookEx, 逻辑型, , "UnhookWindowsHookEx", , , 卸载钩子

参数 hhk, 整数型

DLL命令 WindowFromPoint, 整数型, "user32", "WindowFromPoint", , , 返回包含了指定点的窗口的句柄。忽略屏蔽、隐藏以及透明窗口 包含了指定点的窗口的句柄。如指定的点处没有窗口存在，则返回零

参数 xPoint, 整数型, , x点值

参数 yPoint, 整数型, , y点值;

DLL命令 CopyMemory, , , "RtlMoveMemory", , , 拷贝内存

参数 Destination, MOUSEHOOKSTRUCT, 传址

参数 Source, 整数型

参数 Length, 整数型

新出炉的底层鼠标钩子（Low Level Mouse Hook)

'==================窗体代码=================

Private Sub Form_Load()

hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseHookProc, ApphInstance, 0)

If hHook <> 0 Then

MsgBox "已钩住鼠标事件，请按本窗体右上方的X按钮关闭窗体，不要使用VB调试工具栏的“结束”按钮，以免VB崩溃"

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

UnhookWindowsHookEx hHook

End Sub

'=============模块代码==================

Public Const WH_MOUSE = 7 '本地钩子

Public Const WH_MOUSE_LL = 14 '全局钩子

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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

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_NCLBUTTONDOWN = &HA1 '窗口标题栏中按下鼠标左键

Public Const WM_NCLBUTTONUP = &HA2 '窗口标题栏中左开鼠标左键

Public Const WM_NCMOUSEMOVE = &HA0 '窗口标题栏中移动鼠标

Public Const WM_NCRBUTTONDOWN = &HA4 '窗口标题栏中按下鼠标右键

Public Const WM_NCRBUTTONUP = &HA5 '窗口标题栏中松开鼠标右键

Public hHook As Long

Public Type POINTAPI

x As Long

y As Long

End Type

Type MSLLHOOKSTRUCT

pt As POINTAPI '相对于屏幕左上角的坐标x,y

mouseData As Long '鼠标数据

flags As Long '标记

time As Long '时间戳

dwExtraInfo As Long '其他信息

End Type

Type MOUSEHOOKSTRUCT

pt As POINTAPI '相对于屏幕左上角的坐标x,y

hwnd As Long '鼠标光标下窗口的句柄

wHitTestCode As Long '鼠标光标在窗口中的位置，标题栏、左边框、右边框，下边框。。。

dwExtraInfo As Long '其他信息，通常为0

End Type

Dim oMouseHookStruct As MSLLHOOKSTRUCT

Public Function MouseHookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

CopyMemory oMouseHookStruct, ByVal lParam, Len(oMouseHookStruct)

DebugPrint "当前鼠标位置-x:" & oMouseHookStructptx & "; y:" & oMouseHookStructpty

Select Case wParam

Case WM_LBUTTONDOWN, WM_NCLBUTTONDOWN

DebugPrint "左键按下"

Case WM_LBUTTONUP, WM_NCLBUTTONUP

DebugPrint "左键d起"

Case WM_RBUTTONDOWN, WM_NCRBUTTONDOWN

DebugPrint "右键按下"

Case WM_RBUTTONUP, WM_NCRBUTTONUP

DebugPrint "右键d起"

Case WM_MOUSEMOVE, WM_NCMOUSEMOVE

DebugPrint "鼠标移动"

Case WM_MOUSEWHEEL

DebugPrint "鼠标滚轮"

End Select

MouseHookProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)

End Function

以上就是关于用vb做全局鼠标键盘钩子。。。求助。。全部的内容，包括:用vb做全局鼠标键盘钩子。。。求助。。、使用易语言怎么设置鼠标全局钩子、易语言 怎么获取鼠标在哪个地方点击了左键和右键,还有点击间隔的时间等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！