当然要使用键盘勾子了
新建一模块,写入如下代码
复制内容到剪贴板
代码:
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
'idHook参数代表拦截的类型，主要有键盘、鼠标等(当拦截键盘输入时值为2)
'lpfn参数代表Hook函数的位址
'hmod代表.dll的hInstance
'dwThreadId代表执行拦截的ThreadId
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WH_KEYBOARD = 2
Public Const WH_KEYBOARD_LL = 13
Public Const WH_SHELL = 10
Public Const WH_GETMESSAGE = 3
Public Const WH_CALLWNDPROC = 4
Public hHook As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Type tagKBDLLHOOKSTRUCT
vkCode As Integer '// virtual key code
scanCode As Integer '// scan code
flags As Long '// flags
Time As Long '// time stamp for this message
dwExtraInfo As Long '// extra info from the driver or keybd_event
End Type
Public Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Sub EnableHook() '定义EnableHook
'设置拦截
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf Myfunc, App.hInstance, 0)
End Sub
Sub DisableHook() '定义DisableHook
Dim ret As Long
ret = UnhookWindowsHookEx(hHook) '取消拦截
End Sub
Function Myfunc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'wParam代表按键
'On Error Resume Next
Dim kk As tagKBDLLHOOKSTRUCT
Dim kb As Long, pks As Byte
'Debug.Print wParam
CopyMemory kk, wParam, Len(kk)
Form1.Text1 = wParam
Form1.Label1 = ncode & ":" & kk.vkCode & ":" & kk.scanCode & ":" & kk.Time
'If wParam = 256 Then
Myfunc = 1: Exit Function
'endif
Myfunc = CallNextHookEx(hHook, ncode, wParam, lParam) '传到下一个拦截
End Function新建一窗体,加上一个Text1和Label1
写入下面代码
复制内容到剪贴板
代码:
Private Sub Form_Load()
Call EnableHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call DisableHook
End Sub
Private Sub Form_Click()
'让窗体不可见(也可以把Form1作为Splash屏幕)
'Form1.Visible = False
End Sub
