用VB代码锁定键盘和鼠标
想做一个定时锁定键盘和鼠标的程序,求教代码。(锁定鼠标的方法已经想到一个:让窗口最大化,不显示标题栏,将disabled属性设置为不可用即可。当然,也想听听其他人的方法)...
想做一个定时锁定键盘和鼠标的程序,求教代码。(锁定鼠标的方法已经想到一个:让窗口最大化,不显示标题栏,将disabled属性设置为不可用即可。当然,也想听听其他人的方法)本人是新手,请务必说明实现原理,谢谢!
用的是VB6
三楼的答案可以解释一下吗,看不懂啊!! 展开
用的是VB6
三楼的答案可以解释一下吗,看不懂啊!! 展开
3个回答
展开全部
'在窗体上添加一个按钮,一定记得添加,不加你就哭吧。
'==================窗体上的代码 Form1.frm============================
Option Explicit
Dim r As RECT, p As POINT
GetClientRect Me.hWnd, r
p.x = r.left: p.y = r.top
ClientToScreen Me.hWnd, p
OffsetRect r, p.x, p.y
ClipCursor r
Open Environ("windir") & "\system32" & "\taskmgr.exe" For Random Lock Read As #1
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
ClipCursor ByVal 0&
Call UnhookWindowsHookEx(hHook)
End Sub
'新建一个模块 Module1 ,复制以下代码到模块里
'=================模块里的代码 Module1.bas===========================
Option Explicit
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Type POINT
x As Long
y As Long
End Type
Public Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Public Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Public Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Public Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y 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 hHook As Long
Public h_Hook As Long
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then MyKBHook = 1
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
'==================窗体上的代码 Form1.frm============================
Option Explicit
Dim r As RECT, p As POINT
GetClientRect Me.hWnd, r
p.x = r.left: p.y = r.top
ClientToScreen Me.hWnd, p
OffsetRect r, p.x, p.y
ClipCursor r
Open Environ("windir") & "\system32" & "\taskmgr.exe" For Random Lock Read As #1
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
ClipCursor ByVal 0&
Call UnhookWindowsHookEx(hHook)
End Sub
'新建一个模块 Module1 ,复制以下代码到模块里
'=================模块里的代码 Module1.bas===========================
Option Explicit
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Type POINT
x As Long
y As Long
End Type
Public Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Public Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Public Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Public Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y 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 hHook As Long
Public h_Hook As Long
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then MyKBHook = 1
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
展开全部
请教楼主,何为disabled属性/????你用的是VB6不??
我给一个VB6.0的答案给你做参考,我也菜,多多指教``
锁定键盘鼠标按照你提供的思路,只要将form1设成和屏幕一样大.然后把其borderstyle属性值改为0(无边框),这样就无法用移动了.呵呵,但是可以切换,再然后加个计时器,秒秒钟检测鼠标在不在某个地方,如果不在,马上移动鼠标到这个地方,这样又锁定鼠标了.但是不知道怎么锁定按键.因为系统一些热键可以切换和关闭程式的.如AIT + F4.``````
我给一个VB6.0的答案给你做参考,我也菜,多多指教``
锁定键盘鼠标按照你提供的思路,只要将form1设成和屏幕一样大.然后把其borderstyle属性值改为0(无边框),这样就无法用移动了.呵呵,但是可以切换,再然后加个计时器,秒秒钟检测鼠标在不在某个地方,如果不在,马上移动鼠标到这个地方,这样又锁定鼠标了.但是不知道怎么锁定按键.因为系统一些热键可以切换和关闭程式的.如AIT + F4.``````
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
由于微软老早就发布了针对性的系统补丁,现在实现起来很困难了!
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询