可以用API扑捉非活动窗体的键盘状态,禁用CTRL,ALT,TAB,ESC组合键
HOOK
API如下(置于模块中):
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Public Const VK_ESCAPE = &H1B
Public Const VK_LWIN = &H5B
Public Const VK_RWIN = &H5C
Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20
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 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" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Dim k As KBDLLHOOKSTRUCT
'HOOK地址接口函数
Public Function KeyboardHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim TrapKey As Boolean
If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
CopyMemory k, ByVal lParam, Len(k)
TrapKey = k.vkCode = VK_LWIN Or k.vkCode = VK_RWIN Or ((k.vkCode = VK_TAB) And ((k.flags And LLKHF_ALTDOWN) <> 0)) Or ((k.vkCode = VK_ESCAPE) And ((k.flags And LLKHF_ALTDOWN) <> 0)) Or ((k.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0))
End If
End If
If TrapKey Then
KeyboardHookProc = -1
Else
KeyboardHookProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End If
End Function
'窗体:
TWO COMMANDBUTTONS
Dim hHook As Long
Private Sub Command1_Click()
'使用钩子扑捉用户的操作
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardHookProc, App.hInstance, 0)
Command1.Enabled = False
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
UnhookWindowsHookEx hHook
hHook = 0
Command2.Enabled = False
Command1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
If hHook <> 0 Then UnhookWindowsHookEx hHook
End Sub
我不会很好地运用API。
但可以实现达到任务管理器打开就关闭,开始菜单一弹出就消失。
(几乎有点失效的感觉)
先添一个Timer,Interval属性可以设成10。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Timer1_Timer()
hw = FindWindow(vbNullString, "Windows 任务管理器")
SendMessage hw, &H10, 0, 0
SendKeys "%"
Me.SetFocus
End Sub
'好恐怖啊~~~差点退不出来。
'如果不是在VB中运行,真不知怎么退出来。
'如果将将Form的样式设成none,将开始状态设成最大化,更爽。
'要是你担心退不出来,可以这样:
'Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'If KeyCode = Asc("I") Then End
'End Sub
'那么一按“I”键就可以退出来了。
新建一个Timer,Interval=1,Enabled=True
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
Private Sub Timer1_Timer()
If FindWindow(vbNullString, "Windows 任务管理器") Then SendMessage FindWindow(vbNullString, "Windows 任务管理器"), WM_SYSCOMMAND, SC_CLOSE, ByVal 0&
End Sub
Private Sub Command1_Click() '禁止
Open "C:\WINDOWS\system32\taskmgr.exe" For Binary As #1
End SubPrivate Sub Command2_Click() '解除
Close #1
End Sub