VB重赏!求让ctrl+alt+del无效的VB代码!

2025-12-16 17:00:46
推荐回答(4个)
回答1:

可以用API扑捉非活动窗体的键盘状态,禁用CTRL,ALT,TAB,ESC组合键
HOOK
API如下(置于模块中):
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Public Const VK_ESCAPE = &H1B
Public Const VK_LWIN = &H5B
Public Const VK_RWIN = &H5C
Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20

Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type

Dim k As KBDLLHOOKSTRUCT

'HOOK地址接口函数
Public Function KeyboardHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim TrapKey As Boolean

If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
CopyMemory k, ByVal lParam, Len(k)
TrapKey = k.vkCode = VK_LWIN Or k.vkCode = VK_RWIN Or ((k.vkCode = VK_TAB) And ((k.flags And LLKHF_ALTDOWN) <> 0)) Or ((k.vkCode = VK_ESCAPE) And ((k.flags And LLKHF_ALTDOWN) <> 0)) Or ((k.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0))
End If
End If

If TrapKey Then
KeyboardHookProc = -1
Else
KeyboardHookProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End If

End Function

'窗体:
TWO COMMANDBUTTONS
Dim hHook As Long

Private Sub Command1_Click()
'使用钩子扑捉用户的操作
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardHookProc, App.hInstance, 0)
Command1.Enabled = False
Command2.Enabled = True
End Sub

Private Sub Command2_Click()

UnhookWindowsHookEx hHook
hHook = 0
Command2.Enabled = False
Command1.Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)

If hHook <> 0 Then UnhookWindowsHookEx hHook

End Sub

回答2:

我不会很好地运用API。
但可以实现达到任务管理器打开就关闭,开始菜单一弹出就消失。
(几乎有点失效的感觉)

先添一个Timer,Interval属性可以设成10。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Timer1_Timer()
hw = FindWindow(vbNullString, "Windows 任务管理器")
SendMessage hw, &H10, 0, 0
SendKeys "%"
Me.SetFocus
End Sub

'好恐怖啊~~~差点退不出来。
'如果不是在VB中运行,真不知怎么退出来。
'如果将将Form的样式设成none,将开始状态设成最大化,更爽。
'要是你担心退不出来,可以这样:
'Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'If KeyCode = Asc("I") Then End
'End Sub
'那么一按“I”键就可以退出来了。

回答3:

新建一个Timer,Interval=1,Enabled=True
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
Private Sub Timer1_Timer()
If FindWindow(vbNullString, "Windows 任务管理器") Then SendMessage FindWindow(vbNullString, "Windows 任务管理器"), WM_SYSCOMMAND, SC_CLOSE, ByVal 0&
End Sub

回答4:

Private Sub Command1_Click() '禁止
Open "C:\WINDOWS\system32\taskmgr.exe" For Binary As #1
End SubPrivate Sub Command2_Click() '解除
Close #1
End Sub