VB锁定键盘、鼠标
一、锁定键盘
1.添加模块
Module1
将以下代码复制到Module1
Public hHook As Long
Public h_Hook As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WH_KEYBOARD_LL = 13
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
MyKBHook = 1
End If
End Function
Public Function My_KBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
If wParam = WM_MOUSEMOVE Then
My_KBHook = CallNextHookEx(h_Hook, ncode, wParam, lParam)
Else
My_KBHook = 1
End If
End If
End Function
2.在Form_load中添加以下代码，实现键盘锁定
Private Sub Form_Load()
Open Environ("windir") & "\system32" & "\taskmgr.exe" For Random Lock Read As #1
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
end sub
3.在Form_Unload中添加以下代码，实现窗口关闭后解开键盘
Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub
二、鼠标锁定
Option Explicit
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Command1_Click() '锁定鼠标
Dim r As RECT
r.Left = 100: r.Top = 100
r.Right = 100: r.Bottom = 100
ClipCursor r
End Sub
'Private Sub Command2_Click() '解除锁定
'ClipCursor ByVal 0&
'End Sub
Private Sub Form_DblClick() '解除锁定
ClipCursor ByVal 0&
End Sub