无论用VB、Delphi、甚至VC++这个功能都得调用操作系统的Win API函数Hook来实现。
方法是用Hook来勾住系统捕捉到的键盘事件，当发现用户按下的是F12时阻止键盘消息传递来实现F12不响应的。
以下钩子程序能阻止除ctrl alt del以外的所有键盘消息
Option Explicit
Private Declare Function CallNextHookEx Lib "user32 " _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32 " _
(ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32 " _
Alias "RtlMoveMemory " _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_LWIN = &H5B
Private Const VK_RWIN = &H5C
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13
Private lngHook As Long
'使用底层KeyboardHook拦截按键消息
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim blnHook As Boolean
Dim p As PKBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP
Call CopyMemory(p, ByVal lParam, Len(p))
If p.vkCode = VK_LWIN Or p.vkCode = VK_RWIN Then '按下了左/右Win键
blnHook = True
End If
Case Else
'do nothing
End Select
End If
If blnHook Then
LowLevelKeyboardProc = 1
Else
Call CallNextHookEx(WH_KEYBOARD_LL, nCode, wParam, lParam)
End If
End Function
Public Sub HooK()
lngHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, _
App.hInstance, _
0)
End Sub
Public Sub UnHooK()
Call UnhookWindowsHookEx(lngHook)
End Sub
'***************************
'把以下程序粘贴到窗体中
'***************************
Private Sub Form_Load()
Hook
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHook
End Sub
form里
---------------------------------------------
Private Sub Command1_Click()
Unload Me
End Sub
'程序启动时注册功能热键F12
Private Sub Form_Load()
Dim Modifiers As Long, aa As Long
preWinProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
'uVirtKey = vbKeyF11
F12 = vbKeyF12
' RegisterHotKey Me.hWnd, 1, 0, uVirtKey
RegisterHotKey Me.hWnd, 2, 0, F12
End Sub
'当程序被关闭时，取消已经注册的热键
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, preWinProc
UnregisterHotKey Me.hWnd, uVirtKey '取消系统级热键,释放资源
'End '终止程序运行
End Sub
-----------------------------------------
模块里
------------------------------------------
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'从指定窗口的结构中取得信息
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
'运行指定的进程
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'向系统注册一个指定的热键
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
'取消热键并释放占用的资源
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long) As Long
'上述五个API函数是注册系统级热键所必需的，具体实现过程如后文所示
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) 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)
Const KEYEVENTF_KEYUP = &H2
Const VK_LWIN = &H5B
'热键标志常数,用来判断当键盘按键被按下时是否命中了我们设定的热键
Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = (-4)
'定义系统的热键,原中断标示,被隐藏的项目句柄
Public preWinProc As Long, MyhWnd As Long, uVirtKey As Long, F12 As Long
'热键拦截过程
Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_HOTKEY Then '如果拦截到热键标志常数
If wParam = 2 Then
'MsgBox "F12"
End If
Else
'如果不是热键,或者不是我们设置的热键,交还控制权给系统,继续监测热键
WndProc = CallWindowProc(preWinProc, hWnd, Msg, wParam, lParam)
End If
End Function
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024