vb 如果让系统不能结束你的进程

vb 如果让系统不能结束你的进程
2009年12月25日
　　这个可以用双进程守护实现，代码如下：
　　我保证可以实现 ,而且cpu使用率正常，不会像其他人写的双进程保护，占用了大量的资源
　　新建工程1，添加command1和timer控件，直接复制代码，将这个程序保存为csrss.exe
　　Option Explicit
　　Private Declare Function ShellExecute Lib "shell32.dll" 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()
　　App.TaskVisible = 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(App.Path + "\stop")  "" Then Exit Sub '如果当前文件夹内存在stop这个文件 则停止双进程保护
　　sFilename = App.Path + "\smss.exe" '另一个进程的路径
　　hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
　　Proc.dwSize = Len(Proc)
　　Mode.dwSize = Len(Mode)
　　lPid = ProcessFirst(hSnapshot, Proc)
　　Do While lPid  0
　　hMSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Proc.th32ProcessID)
　　Mode.szExePath = Space$(256)
　　ret = Module32First(hMSnapshot, Mode)
　　If ret > 0 Then
　　If InStr(1, Mode.szExePath, sFilename, vbTextCompare) > 0 Then 'Mode.szExePath=进程路径
　　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控件，直接复制代码,将这个程序保存为smss.exe
　　Option Explicit
　　Private Declare Function ShellExecute Lib "shell32.dll" 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()
　　App.TaskVisible = 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(App.Path + "\stop")  "" Then Exit Sub '如果当前文件夹内存在stop这个文件 则停止双进程保护
　　sFilename = App.Path + "\csrss.exe"
　　hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
　　Proc.dwSize = Len(Proc)
　　Mode.dwSize = Len(Mode)
　　lPid = ProcessFirst(hSnapshot, Proc)
　　Do While lPid  0
　　hMSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Proc.th32ProcessID)
　　Mode.szExePath = Space$(256)
　　ret = Module32First(hMSnapshot, Mode)
　　If ret > 0 Then
　　If InStr(1, Mode.szExePath, 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
　　你实现了以上两步后，会发现任务管理器不能结束smss.exe 和csrss.exe
　　其实仅仅要让任务管理期无法结束进程，那你把进程命名为关键进程就可以了，例如smss.exe csrss.exe winlogon.exe等
　　对了，你要想结束这两个进程，新建一个stop文件夹，把两个程序拖进去，再点结束就可以了