如何封掉键盘，关于注册表的问题

[hello8118]

请问如何封杀系统功能键。alt + tab 等.

[junwhj]

只能在WIN2K下运行,且不能屏蔽Ctrl+Alt+Del
模块中:
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type

Private Const HC_ACTION = 0
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_TAB = &H9
Private Const VK_ESCAPE = &H1B
Private Const VK_CONTROL = &H11
Private Const WH_KEYBOARD_LL = 13
Private Const LLKHF_ALTDOWN = &H20

Private PrevHook As Long


Public Function LowLevelKeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fEatKeystroke As Boolean
Dim p As PKBDLLHOOKSTRUCT

If ncode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP
CopyMemory p, ByVal lParam, Len(p)
If (p.flags And LLKHF_ALTDOWN) <> 0 Then 'Alt + AnyKey
fEatKeystroke = True
End If
If (p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0) Then 'Ctrl + Esc
fEatKeystroke = True
End If
Case Else
'do nothing
End Select
End If

If fEatKeystroke Then
LowLevelKeyboardProc = 1
Else
CallNextHookEx WH_KEYBOARD_LL, ncode, wParam, lParam
End If
End Function


Public Sub Hook()
PrevHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
End Sub


Public Sub UnHook()
UnhookWindowsHookEx PrevHook
End Sub


窗体中:
Private Sub Form_Load()
Hook()
End Sub

Private Sub Form_UnLoad(Cancel as integer)
UnHook()
End Sub

[hello8118]

需要这么多代码吗?，还有如何可以实现标止mouse 移动这个功能呢?--不管怎么样还是要多谢谢 junwhj() 网友：），请大虾不吝告之>

[vbanswer]

禁止使用 Alt-Tab 或 Ctrl-Alt-Del

Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Integer, ByVal aBOOL As Integer) As Integer
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hWnd As Integer) As Integer
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Integer) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Private TaskBarhWnd As Long
Private IsTaskBarEnabled As Integer
Private TaskBarMenuHwnd As Integer
'禁止或允许使用 Alt-Tab
Sub FastTaskSwitching(bEnabled As Boolean)
Dim X As Long, bDisabled As Long
bDisabled = Not bEnabled
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
'禁止使用Ctrl-Alt-Del
Public Sub DisableTaskBar()
Dim EWindow As Integer
TaskBarhWnd = FindWindow("Shell_traywnd", "")
If TaskBarhWnd <> 0 Then
EWindow = IsWindowEnabled(TaskBarhWnd)
If EWindow = 1 Then
IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 0)
End If
End If
End Sub
'允许使用Ctrl-Alt-Del
Public Sub EnableTaskBar()
If IsTaskBarEnabled = 0 Then
IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 1)
End If
End Sub

禁止 Ctrl+Alt+Del
声明(For Win95)：
Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni As Long) As Long
使用：
'禁止
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
'开启
Dim pOld As Boolean
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)



........................................................................................................................................................................................





禁止使用 Alt+F4 关闭窗口

Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&

Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)

c = GetMenuItemCount(hwndMenu)

DeleteMenu hwndMenu, c - 1, MF_BYPOSITION

c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION

End Sub




........................................................................................................................................................................................






如何让窗体右上角的X失效？


在VB中，每个窗体都有两个卸载事件，不同的是，QueryUnload事件不仅允许用户
取消进程，并且告诉程序做些什么来开始卸载工作。为使窗体右上角的X失效，并
下面的代码放在该事件中就行了。

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = -1

End Sub



........................................................................................................................................................................................





让窗口拒绝接受键盘和鼠标事件

声明：
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
使用：
'拒绝接受键盘和鼠标事件
Call EnableWindow(Form.hwnd, 0)
'允许接受键盘和鼠标事件
Call EnableWindow(Form.hwnd, 1)


........................................................................................................................................................................................



禁止使用 Alt+F4 关闭窗口

Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&

Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)

c = GetMenuItemCount(hwndMenu)

DeleteMenu hwndMenu, c - 1, MF_BYPOSITION

c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION

End Sub


........................................................................................................................................................................................



禁止x按钮及关闭菜单

Option Explicit

Private Declare Function GetSystemMenu Lib "user32"_
(ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function GetMenuItemCount Lib "user32"_
(ByVal hMenu As Long) As Long

Private Declare Function RemoveMenu Lib "user32"_
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Private Declare Function DrawMenuBar Lib "user32"_
(ByVal hwnd As Long) As Long

Private Const MF_BYPOSITION = &H400&

Private Const MF_REMOVE = &H1000&

Private Sub DisableX()
　　 Dim hMenu As Long
　　 Dim nCount As Long
　　 hMenu = GetSystemMenu(Me.hWnd, 0)
　　 nCount = GetMenuItemCount(hMenu)
　　 'Get rid of the Close menu and its separator
　　 Call RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
　　 Call RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
　　 'Make sure the screen updates
　　 'our change　　 DrawMenuBar Me.hWnd
End Sub

Private Sub Form_Load()
　　 DisableX
End Sub

Private Sub Form_Click()
'We need a way out, since the X button'doesn't work :-)
　　 Unload Me
End Sub


应该是可以的吧!

[doubleyang]

除第一个外没有能在2000下通过的

[junwhj]

To: hello8118(hello)
'==================================
'禁止鼠标移动的例子
'==================================
Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Sub Form_Load()
Dim rc As RECT

rc.Left = Screen.Width / Screen.TwipsPerPixelX / 2
rc.Top = Screen.Height / Screen.TwipsPerPixelY / 2
rc.Right = rc.Left
rc.Bottom = rc.Top

Call ClipCursor(rc)
'Call ShowCursor(0) '隐藏鼠标
End Sub

Private Sub Command1_Click()
Dim rc As RECT

rc.Left = 0
rc.Top = 0
rc.Bottom = Screen.Height / Screen.TwipsPerPixelY
rc.Right = Screen.Width / Screen.TwipsPerPixelX

Call ClipCursor(rc)
'Call ShowCursor(1) '显示鼠标
End Sub