用vb6.0怎么写一个程序可以达到禁用win7的任务管理器?(还有,怎么可以禁用某个按键?比如禁用Ctrl键)

用vb6.0怎么写一个程序可以达到禁用win7的任务管理器?(还有,怎么可以禁用某个按键?比如禁用Ctrl键),第1张

'
'模块代码Module1
'
Option Explicit
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 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 WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_LWIN = &H5B
Private Const VK_RWIN = &H5C
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13
Private Const VK_CONTROL = &H11
Private Const VK_ESCAPE = &H1B
Private Const VK_MENU = &H12
Private Const VK_TAB = &H9
Private Const VK_Delete = &H2E
Private lngHook As Long
'使用底层KeyboardHook拦截按键消息
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim blnHook As Boolean
Dim p As PKBDLLHOOKSTRUCT

If nCode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP
Call CopyMemory(p, ByVal lParam, Len(p))
If pvkCode = VK_LWIN Or pvkCode = VK_RWIN Then blnHook = True '按下了左/右Win键
If pvkCode = VK_CONTROL Or pvkCode = VK_ESCAPE Then blnHook = True '按下了Ctrl+Esc键
If pvkCode = VK_MENU Or pvkCode = VK_TAB Then blnHook = True '按下了Alt+Tab键
Case Else
'do nothing
End Select
End If

If blnHook Then
LowLevelKeyboardProc = 1
Else
Call CallNextHookEx(WH_KEYBOARD_LL, nCode, wParam, lParam)
End If
End Function
Public Sub HooK()
lngHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, _
ApphInstance, _
0)
End Sub
Public Sub UnHooK()
Call UnhookWindowsHookEx(lngHook)
End Sub

'
'窗体代码Form11
'
Private Sub Form_Load()
Call HooK '屏蔽Win键
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnHooK '取消屏蔽Win键
End Sub

这个可以用双进程守护实现,代码如下:

我保证可以实现 ,而且cpu使用率正常,不会像其他人写的双进程保护,占用了大量的资源

新建工程1,添加command1和timer控件,直接复制代码,将这个程序保存为csrssexe

Option Explicit

Private Declare Function ShellExecute Lib "shell32dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long

Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String  260

End Type

Const TH32CS_SNAPPROCESS = &H2

Const TH32CS_SNAPmodule = &H8

Private Type MODULEENTRY32

dwSize As Long

th32ModuleID As Long

th32ProcessID As Long

GlblcntUsage As Long

ProccntUsage As Long

modBaseAddr As Byte

modBaseSize As Long

hModule As Long

szModule As String  256

szExePath As String  1024

End Type

Private Sub Command1_Click()

End

End Sub

Private Sub Form_Load()

AppTaskVisible = False '不要在任务管理内显示

End Sub

Private Sub Timer1_Timer()

Dim ret As Long, lPid As Long

Dim isLive As Boolean

Dim Mode As MODULEENTRY32, Proc As PROCESSENTRY32

Dim hSnapshot As Long, hMSnapshot As Long

Dim sFilename As String

If Dir(AppPath + "\stop") <> "" Then Exit Sub '如果当前文件夹内存在stop这个文件 则停止双进程保护

sFilename = AppPath + "\smssexe" '另一个进程的路径

hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)

ProcdwSize = Len(Proc)

ModedwSize = Len(Mode)

lPid = ProcessFirst(hSnapshot, Proc)

Do While lPid <> 0

hMSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Procth32ProcessID)

ModeszExePath = Space$(256)

ret = Module32First(hMSnapshot, Mode)

If ret > 0 Then

If InStr(1, ModeszExePath, sFilename, vbTextCompare) > 0 Then 'ModeszExePath=进程路径

isLive = True '找到目标进程

CloseHandle hMSnapshot

Exit Do

End If

End If

CloseHandle hMSnapshot

lPid = ProcessNext(hSnapshot, Proc)

Loop

CloseHandle hSnapshot

If Not isLive Then

ShellExecute 0, "", sFilename, "", "", 1 '如果目标进程不存在 则启动它

End If

End Sub

'timer的interval属性设置为1000

新建工程2,添加command1和timer控件,直接复制代码,将这个程序保存为smssexe

Option Explicit

Private Declare Function ShellExecute Lib "shell32dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long

Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String  260

End Type

Const TH32CS_SNAPPROCESS = &H2

Const TH32CS_SNAPmodule = &H8

Private Type MODULEENTRY32

dwSize As Long

th32ModuleID As Long

th32ProcessID As Long

GlblcntUsage As Long

ProccntUsage As Long

modBaseAddr As Byte

modBaseSize As Long

hModule As Long

szModule As String  256

szExePath As String  1024

End Type

Private Sub Command1_Click()

End

End Sub

Private Sub Form_Load()

AppTaskVisible = False '不要在任务管理内显示

End Sub

Private Sub Timer1_Timer()

Dim ret As Long, lPid As Long

Dim isLive As Boolean

Dim Mode As MODULEENTRY32, Proc As PROCESSENTRY32

Dim hSnapshot As Long, hMSnapshot As Long

Dim sFilename As String

If Dir(AppPath + "\stop") <> "" Then Exit Sub '如果当前文件夹内存在stop这个文件 则停止双进程保护

sFilename = AppPath + "\csrssexe"

hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)

ProcdwSize = Len(Proc)

ModedwSize = Len(Mode)

lPid = ProcessFirst(hSnapshot, Proc)

Do While lPid <> 0

hMSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Procth32ProcessID)

ModeszExePath = Space$(256)

ret = Module32First(hMSnapshot, Mode)

If ret > 0 Then

If InStr(1, ModeszExePath, sFilename, vbTextCompare) > 0 Then

isLive = True

CloseHandle hMSnapshot

Exit Do

End If

End If

CloseHandle hMSnapshot

lPid = ProcessNext(hSnapshot, Proc)

Loop

CloseHandle hSnapshot

If Not isLive Then

ShellExecute 0, "", sFilename, "", "", 1

End If

End Sub

'timer的interval属性设置为1000

你实现了以上两步后,会发现任务管理器不能结束smssexe 和csrssexe

其实仅仅要让任务管理期无法结束进程,那你把进程命名为关键进程就可以了,例如smssexe csrssexe winlogonexe等

对了,你要想结束这两个进程,新建一个stop文件夹,把两个程序拖进去,再点结束就可以了


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/13329932.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-07-16
下一篇 2023-07-16

发表评论

登录后才能评论

评论列表(0条)

保存