如何禁用键盘?

Question

用钩子来实现。禁用键盘。不过某些组合健如Ctrl+Alt+Del，Alt+Tab无法屏蔽。'In a module
Public Const WH_KEYBOARD = 2
Public Const VK_SHIFT = &H10
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public hHook As LongPublic Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If idHook < 0 Then
        'call the next hook
        KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
        If (GetKeyState(VK_SHIFT) And &HF0000000) Then
            'add the code
            MsgBox "Shift pressed ..."
        End If
        Call CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
        KeyboardProc = 0
    End If
End Function
'In a form
Private Sub Form_Load()
    'set a keyboard hook
    hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, App.ThreadID)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'remove the windows-hook
    UnhookWindowsHookEx hHook
End Sub

Answer 1

刚才的代码有个错误。返回值应该为1
Public Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If idHook < 0 Then
        'call the next hook
        KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
        If (GetKeyState(VK_SHIFT) And &HF0000000) Then
            'add the code
            MsgBox "Shift pressed ..."
        End If
        Call CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
        KeyboardProc = 1    'return 1
    End If
End Function

Answer 2

这太麻烦了,我有个方法一行代码就搞定!效果巨好!请Email索取[email protected]
 or
[email protected]

Answer 3

EnableWindow()可达目的，第二个叁数传0进入则不能输入，传1则相反Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Sub Command1_Click()
Call EnableWindow(Me.hwnd, 0)
Me.Caption = "现在拒绝KeyPress, MouseClick"
Dim i As Long
For i = 1 To 100
   Call Sleep(100)
   DoEvents '虽有DoEvents，会发现，按Form的任何地方都没有反应
Next i
Me.Caption = "现在解除了"
Call EnableWindow(Me.hwnd, 1)
End Sub