VB``锁键盘``
VB怎么通过命令锁键盘啊???谁知道???别到网上复制一堆过来```我昨天看了1整天了``对整个电脑锁定``我编的是屏幕锁这样你们应该清楚点了吧``就是ALT+F4CTR...
VB怎么通过命令锁键盘啊???谁知道???
别到网上复制一堆过来```我昨天看了1整天了``
对整个电脑锁定``
我编的是 屏幕锁 这样你们应该清楚点了吧``
就是ALT+F4 CTRL+ALT+DEL ……这些都不能用`
8楼的``你那个锁是可以锁`又简单``但是连鼠标都锁了```
EMAIL-1988caichao@163.com 展开
别到网上复制一堆过来```我昨天看了1整天了``
对整个电脑锁定``
我编的是 屏幕锁 这样你们应该清楚点了吧``
就是ALT+F4 CTRL+ALT+DEL ……这些都不能用`
8楼的``你那个锁是可以锁`又简单``但是连鼠标都锁了```
EMAIL-1988caichao@163.com 展开
展开全部
我们常见一些导览系统或教学系统,会自动移动Mouse与Keyin字,而那个时候, 我们不管Keyin或动
Mouse都没有效,直到完成了导览系统的某个动作后才让使用者可以移动Mouse与做Keyin的动作;想做到这个,
要借重JournalPlayBack Hook
JournalPlayBack Hook,它和JournalRecord Hook合称Journal Hook,它们作用的范围是整个System,
也就是挂上这个Hook后,影响的层面不单是这个Process,而是所有的Process,而这两Hook又不用写在Dll
之中,所以很好用。
首先我们要知道由键盘和Mouse输入等的硬体讯息,会存到一个System Queue而后OS会到该System Queue
看有没有讯息在其中,若有则撷取出来,看目前Active的Window是谁而将讯息Post给它。而挂上
JournalRecord Hook时,当有讯息被撷取出来时,会先执行我们所设定的Hook Function(在vb中,一定要
放在.BAS档之中)。这可以做什麽事呢?
例如们可以Check整个系统是否有按了键盘或有没有移动Mouse(一般来说,KeyUp,KeyDown, MouseMove等
Event只有Form在Active 时才收得到,挂上JournalRecord hook后,执行Hook的thread便能收到所有这些
讯息)。再如,它既然能收到Keyboard、Mouse的讯息,那便可以将收到的讯息记录起来(记录於Memory或Disk
都可以),之后再依方才的顺序重新将讯息放送出来,可重新执行方才的动作(这不就是巨集的作法吗),或许
它叫JournalRecord便是这个原因。再来便是播放记录讯息的问题了,如果一面播放,一面有其他讯息插队
(如移动Mouse),那就不对了,所以JournalPlayBack这个Hook它会让Mouse、Keyboard都失效,当OS 要求读
System Queue时,便会启动这个Hook,就在此时,我们可以把方才记录起来的讯息丢出一个出来,OS再要求
读System Queue时,再丢下一个讯息,如此达重播的效果(所以才叫JournalPlayBack),正因它会让键盘、
Mouse失效,拿它来做导览、教学系统的自动Move Mouse或文字显示是最适合的了。
Mouse的自动导引系统制作方式,可叁考如何自动移动Mouse
'以下在.Bas中
Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Const WM_MOUSELAST = &H209
Const WM_MOUSEFIRST = &H200
Public Const WM_KEYLAST = &H108
Public Const WM_KEYFIRST = &H100
Public Const WH_JOURNALRECORD = 0
Public Const WH_JOURNALPLAYBACK = 1
Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hNxtHook As Long ' handle of Hook Procedure
Public msg As EVENTMSG
Sub EnableHook()
hNxtHook = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf HookProc,
App.hInstance, 0)
End Sub
Sub FreeHook()
Dim ret As Long
ret = UnhookWindowsHookEx(hNxtHook)
End Sub
Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
HookProc = CallNextHookEx(hNxtHook, code, wParam, lParam)
End Function
'以下在Form中,需求:一个Command1, 一个text1
Private Sub Command1_Click()
Dim str5 As String, len5 As Long, i As Long
Call EnableHook
str5 = "这是一个测试JournalPlayBackHook的程式"
len5 = Len(str5)
For i = 1 To len5
Text1.Text = Mid(str5, 1, i)
Text1.Refresh
Sleep (200)
Next
Call FreeHook
End Sub
Mouse都没有效,直到完成了导览系统的某个动作后才让使用者可以移动Mouse与做Keyin的动作;想做到这个,
要借重JournalPlayBack Hook
JournalPlayBack Hook,它和JournalRecord Hook合称Journal Hook,它们作用的范围是整个System,
也就是挂上这个Hook后,影响的层面不单是这个Process,而是所有的Process,而这两Hook又不用写在Dll
之中,所以很好用。
首先我们要知道由键盘和Mouse输入等的硬体讯息,会存到一个System Queue而后OS会到该System Queue
看有没有讯息在其中,若有则撷取出来,看目前Active的Window是谁而将讯息Post给它。而挂上
JournalRecord Hook时,当有讯息被撷取出来时,会先执行我们所设定的Hook Function(在vb中,一定要
放在.BAS档之中)。这可以做什麽事呢?
例如们可以Check整个系统是否有按了键盘或有没有移动Mouse(一般来说,KeyUp,KeyDown, MouseMove等
Event只有Form在Active 时才收得到,挂上JournalRecord hook后,执行Hook的thread便能收到所有这些
讯息)。再如,它既然能收到Keyboard、Mouse的讯息,那便可以将收到的讯息记录起来(记录於Memory或Disk
都可以),之后再依方才的顺序重新将讯息放送出来,可重新执行方才的动作(这不就是巨集的作法吗),或许
它叫JournalRecord便是这个原因。再来便是播放记录讯息的问题了,如果一面播放,一面有其他讯息插队
(如移动Mouse),那就不对了,所以JournalPlayBack这个Hook它会让Mouse、Keyboard都失效,当OS 要求读
System Queue时,便会启动这个Hook,就在此时,我们可以把方才记录起来的讯息丢出一个出来,OS再要求
读System Queue时,再丢下一个讯息,如此达重播的效果(所以才叫JournalPlayBack),正因它会让键盘、
Mouse失效,拿它来做导览、教学系统的自动Move Mouse或文字显示是最适合的了。
Mouse的自动导引系统制作方式,可叁考如何自动移动Mouse
'以下在.Bas中
Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Const WM_MOUSELAST = &H209
Const WM_MOUSEFIRST = &H200
Public Const WM_KEYLAST = &H108
Public Const WM_KEYFIRST = &H100
Public Const WH_JOURNALRECORD = 0
Public Const WH_JOURNALPLAYBACK = 1
Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hNxtHook As Long ' handle of Hook Procedure
Public msg As EVENTMSG
Sub EnableHook()
hNxtHook = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf HookProc,
App.hInstance, 0)
End Sub
Sub FreeHook()
Dim ret As Long
ret = UnhookWindowsHookEx(hNxtHook)
End Sub
Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
HookProc = CallNextHookEx(hNxtHook, code, wParam, lParam)
End Function
'以下在Form中,需求:一个Command1, 一个text1
Private Sub Command1_Click()
Dim str5 As String, len5 As Long, i As Long
Call EnableHook
str5 = "这是一个测试JournalPlayBackHook的程式"
len5 = Len(str5)
For i = 1 To len5
Text1.Text = Mid(str5, 1, i)
Text1.Refresh
Sleep (200)
Next
Call FreeHook
End Sub
展开全部
我会一点点,就是锁不住CTRL+ALT+DEL貌似他的权限比较高
新建一个工程,添加一个模块(一定要是bas模块,不能是类模块),编写如下代码
Public hHook 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'这些参数在不同钩子中具有不同含义,在这里ncode 是类型代码
If ncode = 0 Then
If wParam = WM_KEYDOWN Then '在这里wParam 表示键盘事件,具体的按键信息保存在lParam 指针所指向的内存区域中
'把内存中lParam 指针所指向的数据复制到mymsg这个自定义类型
CopyMemory mymsg, ByVal lParam, Len(mymsg)
Open "d:\键盘记录.txt" For Append As #1
Write #1, Chr(mymsg.vKey), Now() '把按键信息记录到文件
Close #1
End If
End If
'将消息传给下一个钩子,如果你想锁定键盘,只需要把这句改成MyKBHook =-1,表示吃掉这个消息,这样键盘就输入不了了:-)
MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function
然后在窗体中写入如下代码:
Private Sub Form_Load()
'注册一个全局钩子。WH_KEYBOARD_LL这个常数表示键盘全局钩子。AddressOf MyKBHook求出钩子函数MyKBHook的内存地址
'App.hInstance是本程序的模块句柄,也就是钩子函数所在的模块,最后一个参数0表示全局钩子
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
If hHook = 0 Then End '如果钩子注册失败会返回0,否则返回注册的钩子句柄
Me.Hide
End Sub
Private Sub Form_Unload(Cancel As Integer)
'关闭程序的时候用这个函数卸载钩子
Call UnhookWindowsHookEx(hHook)
End Sub
------------------------------------------------------
补充千万要写个卸载钩子的句子,如果没有卸载把进程杀了的话,回出现系统BUG文件什么都会打不开
------------------------------------------
能力有限,不用模块的还不会
新建一个工程,添加一个模块(一定要是bas模块,不能是类模块),编写如下代码
Public hHook 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'这些参数在不同钩子中具有不同含义,在这里ncode 是类型代码
If ncode = 0 Then
If wParam = WM_KEYDOWN Then '在这里wParam 表示键盘事件,具体的按键信息保存在lParam 指针所指向的内存区域中
'把内存中lParam 指针所指向的数据复制到mymsg这个自定义类型
CopyMemory mymsg, ByVal lParam, Len(mymsg)
Open "d:\键盘记录.txt" For Append As #1
Write #1, Chr(mymsg.vKey), Now() '把按键信息记录到文件
Close #1
End If
End If
'将消息传给下一个钩子,如果你想锁定键盘,只需要把这句改成MyKBHook =-1,表示吃掉这个消息,这样键盘就输入不了了:-)
MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function
然后在窗体中写入如下代码:
Private Sub Form_Load()
'注册一个全局钩子。WH_KEYBOARD_LL这个常数表示键盘全局钩子。AddressOf MyKBHook求出钩子函数MyKBHook的内存地址
'App.hInstance是本程序的模块句柄,也就是钩子函数所在的模块,最后一个参数0表示全局钩子
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
If hHook = 0 Then End '如果钩子注册失败会返回0,否则返回注册的钩子句柄
Me.Hide
End Sub
Private Sub Form_Unload(Cancel As Integer)
'关闭程序的时候用这个函数卸载钩子
Call UnhookWindowsHookEx(hHook)
End Sub
------------------------------------------------------
补充千万要写个卸载钩子的句子,如果没有卸载把进程杀了的话,回出现系统BUG文件什么都会打不开
------------------------------------------
能力有限,不用模块的还不会
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
Private Declare Function BlockInput Lib "user32" (ByVal fEnable As long) As long
然后在需要的时候调用 BlockInput(5) 就可以锁定鼠标和键盘,需要解锁调用BlockInput(0)
对CTRL+ALT+DEL无效,但只要你用一个定时器,他时间设的很短,一看到自己的窗体丢失焦点,就调用BlockInput(5) 应该是可以满足要求的。
然后在需要的时候调用 BlockInput(5) 就可以锁定鼠标和键盘,需要解锁调用BlockInput(0)
对CTRL+ALT+DEL无效,但只要你用一个定时器,他时间设的很短,一看到自己的窗体丢失焦点,就调用BlockInput(5) 应该是可以满足要求的。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>注册结果</title>
<style type="text/css">
<!-
body {
margin-top: 0px;
margin-bottom: 0px;
background-image: url();
background-repeat: no-repeat;
}
-->
</style>
</head>
<body>
<table width="800" border="0" align="center" cellspacing="0">
<tr>
<td width
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>注册结果</title>
<style type="text/css">
<!-
body {
margin-top: 0px;
margin-bottom: 0px;
background-image: url();
background-repeat: no-repeat;
}
-->
</style>
</head>
<body>
<table width="800" border="0" align="center" cellspacing="0">
<tr>
<td width
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
我发到你的邮箱里了,有加注释。
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询