End Sub '卸钩子 Private sub DelHook() UnhookWindowsHookEx lHook(0) 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 GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer 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 KEYMSGS vKey As Long '虚拟码 (and &HFF) sKey As Long '扫描码 flag As Long '键按下:128 抬起:0 time As Long 'Window运行时间 End Type Public Const WH_KEYBOARD_LL = 13 Public Const Alt_Down = &H20 '----------------------------------------- '消息 Public Const HC_ACTION = 0 Public Const HC_SYSMODALOFF = 5 Public Const HC_SYSMODALON = 4 '键盘消息 Public Const WM_KEYDOWN = &H100 Public Const WM_KEYUP = &H101 Public Const WM_SYSKEYDOWN = &H104 Public Const WM_SYSKEYUP = &H105 Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long Public strKeyName As String * 255 Public Declare Function GetActiveWindow Lib "user32" () As Long Public keyMsg As KEYMSGS Public MouseMsg As MOUSEMSGS Public lHook(1) As Long '-------------------------------------- '模拟按键 Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)'键盘钩子 Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim lKey As Long Dim strKeyName As String * 255 Dim strLen As Long
If code = HC_ACTION Then CopyMemory keyMsg, lParam, LenB(keyMsg) Select Case wParam Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:
If KeyAscii=32 then
KeyAscii=0
End If
'Form
'安装钩子
Private sub AddHook()
'键盘钩子
lHook(0) = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)
End Sub
'卸钩子
Private sub DelHook()
UnhookWindowsHookEx lHook(0)
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 GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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 KEYMSGS
vKey As Long '虚拟码 (and &HFF)
sKey As Long '扫描码
flag As Long '键按下:128 抬起:0
time As Long 'Window运行时间
End Type
Public Const WH_KEYBOARD_LL = 13
Public Const Alt_Down = &H20
'-----------------------------------------
'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
'键盘消息
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public strKeyName As String * 255
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public keyMsg As KEYMSGS
Public MouseMsg As MOUSEMSGS
Public lHook(1) As Long
'--------------------------------------
'模拟按键
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)'键盘钩子
Public Function CallKeyHookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
If code = HC_ACTION Then
CopyMemory keyMsg, lParam, LenB(keyMsg)
Select Case wParam
Case WM_SYSKEYDOWN, WM_KEYDOWN, WM_SYSKEYUP, WM_KEYUP:
lKey = keyMsg.sKey And &HFF '扫描码
lKey = lKey * 65536 '虚拟码
If (keyMsg.vKey And &HFF)=32 Then '空格键
CallKeyHookProc = 1 '屏蔽按键
End If
End Select
End If
If code <> 0 Then
CallKeyHookProc = CallNextHookEx(0, code, wParam, lParam)
End If
End Function