'模块代码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文件夹,把两个程序拖进去,再点结束就可以了
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)