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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, lProcessID As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) Private Declare Function Process32First Lib "kernel32" (ByVal hsnapshot As Long, uprocess As PROCESSENTRY32) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hsnapshot As Long, uprocess As PROCESSENTRY32) As Long ‘‘‘‘‘‘‘‘‘设置俺的程序优先极为最高 Const THREAD_BASE_PRIORITY_IDLE = -15 Const THREAD_BASE_PRIORITY_LOWRT = 15 Const THREAD_BASE_PRIORITY_MIN = -2 Const THREAD_BASE_PRIORITY_MAX = 2 Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1) Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1) Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE Const THREAD_PRIORITY_NORMAL = 0 Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT Const HIGH_PRIORITY_CLASS = &H80 Const IDLE_PRIORITY_CLASS = &H40 Const NORMAL_PRIORITY_CLASS = &H20 Const REALTIME_PRIORITY_CLASS = &H100 Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long Private Declare Function GetCurrentThread Lib "kernel32" () As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long ‘‘‘‘‘‘‘‘‘这儿让我的窗体在最上 Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Const HWND_TOPMOST = -1 Private Const SWP_SHOWWINDOWS = &H40 ‘‘‘‘ 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 Private Const TH32CS_SNAPPROCESS As Long = 2& Dim procresult Private Sub Form_Activate() prochlvwlis End Sub Sub prochlvwlis() Dim uprocess As PROCESSENTRY32 Dim hsnapshot As Long Dim mname As String Dim i As Integer Dim proclvw As ListItem lvw.ListItems.Clear DoEvents uprocess.dwSize = Len(uprocess) hsnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&) ‘ If failure -1 (false) If hsnapshot Then procresult = Process32First(hsnapshot, uprocess) ‘ If failure -1 (false) Do While procresult i = InStr(1, uprocess.szExeFile, Chr(0)) mname = LCase$(Left$(uprocess.szExeFile, i - 1)) Set proclvw = lvw.ListItems.Add(, , Text:=mname) proclvw.SubItems(6) = uprocess.th32ModuleID proclvw.SubItems(5) = Hex(uprocess.th32ParentProcessID) proclvw.SubItems(4) = Hex(uprocess.th32ProcessID) proclvw.SubItems(3) = uprocess.cntUsage proclvw.SubItems(2) = uprocess.cntThreads proclvw.SubItems(1) = uprocess.pcPriClassBase procresult = Process32Next(hsnapshot, uprocess) Loop End If End Sub Sub ErrMsgProc(mMsg As String) ‘‘‘‘错误处理 MsgBox mMsg & vbCrLf & Err.Number & Space(5) & Err.Description End Sub Private Sub Form_Resize() ‘‘‘改变窗体大小时的设置 lvw.Width = ProcH.Width - 100 lvw.Height = Abs(ProcH.Height - 4000) TabStrip1.Height = Abs(ProcH.Height - 3350) TabStrip1.Width = ProcH.Width - 100 morelvw.Width = TabStrip1.Width - 250 morelvw.Height = Abs(TabStrip1.Height - 500) End Sub Private Sub lvw_Click() ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem help End Sub Private Sub lvw_DblClick() Call mnuTe_Click End Sub Private Sub fParent() If lvw.ListItems.Count = 0 Then Exit Sub End If Dim mParentProcID As Long Dim i As Integer Dim mFound As Boolean mFound = False mParentProcID = "&H" & (lvw.ListItems(lvw.SelectedItem.Index).SubItems(5)) For i = 1 To lvw.ListItems.Count If "&H" & (lvw.ListItems(i).SubItems(4)) = mParentProcID Then lvw.SelectedItem = lvw.ListItems(i) lvw.SetFocus mFound = True Exit For End If Next If mFound = False Then MsgBox "没有父进程的东东----------最好不要试图终止它!" End If End Sub Private Sub Form_Load() ‘‘‘‘‘载入窗体时发生 ProcH.Width = 8400 ProcH.Height = 5280 If App.PrevInstance Then MsgBox "程序正在运行,请检查窗口是否被最小化。" End If App.TaskVisible = False ‘‘‘‘将程序从CTRL+DEL+ALT的列表中隐藏 Dim hThread As Long, hProcess As Long ‘‘设置优先极了 hThread = GetCurrentThread hProcess = GetCurrentProcess SetThreadPriority hThread, THREAD_PRIORITY_HIGHEST SetPriorityClass hProcess, REALTIME_PRIORITY_CLASS ‘‘‘‘ Dim retValue As Long retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOWS) ‘‘‘‘‘‘ lvw.ListItems.Clear ‘‘‘‘清空列表,初始化 lvw.ColumnHeaders.Clear ‘‘‘‘清空表头,初始化 lvw.ColumnHeaders.Add , , "进程名称", 4000 ‘‘‘添加到表头第一项,有顺序的 lvw.ColumnHeaders.Add , , "优先极", 600 lvw.ColumnHeaders.Add , , "线程数", 600 ‘‘‘‘ lvw.ColumnHeaders.Add , , "引用", 600 ‘‘ lvw.ColumnHeaders.Add , , "进程ID", 1000 ‘‘‘‘ lvw.ColumnHeaders.Add , , "父进程 ID", 1000 ‘‘ lvw.ColumnHeaders.Add , , "", 0 lvw.LabelEdit = lvwManual lvw.FullRowSelect = True lvw.HideSelection = False lvw.HideColumnHeaders = False lvw.View = lvwReport End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) ‘‘‘‘‘窗体上按下鼠标时发生 If Button >= 2 Then ‘‘‘‘‘如果鼠标按键是右键~也有特殊的情况如滚轮鼠标 Me.PopupMenu mnuprochhead1 End If End Sub Private Sub mnuaboutx_Click() ‘‘‘‘‘给出一个消息框,这儿只使用了+VBCRLF+=&vbcrlf&,是实现换行的 MsgBox "关于 ProcH XP.........." + vbCrLf + " 由 bob008(冻东)完成!" + vbCrLf + "☆☆☆严禁任何未经许可的商业性发布行为及修改!☆☆☆" + vbCrLf + "我会把注册表的偷懒设置设置的更多,如删除打开文件的历史记录等!" + vbCrLf + "最关键的是这是完全免费的程序!并且完全绿色" + vbCrLf + "如果你有什么好的提议或索取源码可与我联系" + vbCrLf + "如果有个免费的主页就好了,可惜-俺又懒的做!烦!" + vbCrLf + "还想加入木马的检测--正在搜集常见木马的特征及标识库!" + vbCrLf + "如果你搜集了,发个MAIL给我!因为我以后会很少用VB了,正在转汇编!" End Sub Private Sub mnufileexit_Click() Unload Me End Sub Private Sub mnurefreshlist_Click() prochlvwlis End Sub ‘‘‘‘‘系统文件菜单 Private Sub mnusysfile_Click(Index As Integer) Select Case Index Case 1 Dim sysfile As String Dim openp As String sysfile = "c:\windows\system.ini" ‘要打开的文件 openp = "Notepad.exe" ‘用记事本打开 Shell openp & " " & sysfile, vbNormalFocus Case 2 sysfile = "c:\windows\win.ini" ‘要打开的文件 openp = "Notepad.exe" ‘用记事本打开 Shell openp & " " & sysfile, vbNormalFocus Case 3 sysfile = "c:\msdos.sys" ‘要打开的文件 openp = "Notepad.exe" ‘用记事本打开 Shell openp & " " & sysfile, vbNormalFocus Case 4 sysfile = "c:\config.sys" ‘要打开的文件 openp = "Notepad.exe" ‘用记事本打开 Shell openp & " " & sysfile, vbNormalFocus Case 5 sysfile = "c:\autoexec.bat" ‘要打开的文件 openp = "Notepad.exe" ‘用记事本打开 Shell openp & " " & sysfile, vbNormalFocus End Select End Sub Private Sub mnusyspro_Click(Index As Integer) Select Case Index Case 1 Shell "C:\WINDOWS\SYSTEM\dxdiag.exe", 1 ‘‘‘DirectX诊断工具 Case 2 Shell " C:\WINDOWS\SYSTEM\msconfig.exe", 1 ‘‘‘系统配置实用程序 Case 3 Shell "c:\windows\Scanregw.exe", 1 ‘‘‘‘注册表检查程序 Case 4 Shell "c:\windows\regedit.exe", 1 ‘‘‘‘注册表编辑器 End Select End Sub Private Sub mnumailtome_Click() Shell "start mailto:abscbn@163.com", vbHide ‘‘‘‘‘也可以是0,如果改为1,你可以看到效果就会很差 End Sub Private Sub mnuTe_Click() If lvw.ListItems.Count = 0 Then ‘‘‘‘如果没有选择就结束 Exit Sub End If If MsgBox("结束 " & lvw.SelectedItem & " 吗?", vbYesNo + vbQuestion) <> vbYes Then Exit Sub End If Dim mProcID As Long mProcID = OpenProcess(1&, -1&, "&H" & lvw.SelectedItem.SubItems(4)) TerminateProcess mProcID, 0& DoEvents lvw.ListItems.Remove (lvw.SelectedItem.Index) lvw.Refresh prochlvwlis End Sub Private Sub mnutouprocesshomepage_Click() Shell "rundll32.exe url.dll,FileProtocolHandler http://www.csdn.net" ‘‘‘‘你可以更改你要的链接 End Sub Private Sub TabStrip1_Click() Select Case TabStrip1.SelectedItem.Key Case "modlis" morelisa Case "thrlis" morelisb Case "verlis" morelisc Case "proclis" End Select End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1 Call mnuTe_Click Case 3 fParent Case 5 Dim b As Object Dim s As String Dim o As String Dim g As String Dim h As String Dim k As String On Error Resume Next Set b = CreateObject("wscript.shell") s = "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools" b.regdelete s On Error Resume Next o = "HKLM\SYSTEM\CurrentControlSet\Services\Cdrom\AUTORUN" b.regwrite o, 0, "REG_DWORD" On Error Resume Next g = "HKCU\Software\Microsoft\Windows\CurentVersion\Explorer\RunMRU\" b.regdelete g On Error Resume Next h = "HKCU\Software\Microsoft\Windows\CurentVersion\Explorer\Doc Find Spec MRU\" b.regdelete h On Error Resume Next k = "HKCU\Software\Microsoft\Windows\CurentVersion\Explorer\RecentDocs\" b.regdelete k On Error Resume Next End Select End Sub Sub help() ‘‘‘‘‘‘statusbar上的常见提示 If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\kernel32.dll" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 内核驱动--警告:不要试图终止它!" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\mmtask.tsk" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 计划任务--讨厌的家伙!俺从不用它!" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\ddhelp.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 实时帮助--不要终止它,这个东东的优先极极高!" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\internat.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 输入法图标--不要终止它!" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\systray.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 音量控制图标--不要终止它!" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\msgsrv.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " ☆★☆严重警告--你好毒啊!☆★☆" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\explorer.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!!" If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\mprexe.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!! " If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\wmiexe.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!! " If ProcH.StatusBar1.Panels(2).Text = "c:\windows\system\msgsrv32.exe" Then ProcH.StatusBar1.Panels(2).Text = lvw.SelectedItem + " 警告--不要试图终止它!!! " End Sub Sub morelisa() morelvw.ListItems.Clear ‘‘‘‘清空列表,初始化 morelvw.ColumnHeaders.Clear ‘‘‘‘清空表头,初始化 morelvw.ColumnHeaders.Add , , "模块名称", 2000 ‘‘‘添加到表头第一项,有顺序的 morelvw.ColumnHeaders.Add , , "模块路径", 4000 morelvw.ColumnHeaders.Add , , "占用内存", 1000 ‘‘‘‘ morelvw.ColumnHeaders.Add , , "引用数", 1000 ‘‘ morelvw.ColumnHeaders.Add , , "全局引用", 1000 ‘‘‘‘ morelvw.ColumnHeaders.Add , , "模块ID", 1000 ‘‘ morelvw.LabelEdit = lvwManual morelvw.FullRowSelect = True morelvw.HideSelection = False morelvw.HideColumnHeaders = False morelvw.View = lvwReport End Sub Sub morelisb() morelvw.ListItems.Clear ‘‘‘‘清空列表,初始化 morelvw.ColumnHeaders.Clear ‘‘‘‘清空表头,初始化 morelvw.ColumnHeaders.Add , , "线程ID", 1400 ‘‘‘添加到表头第一项,有顺序的 morelvw.ColumnHeaders.Add , , "基础优先极", 2000 morelvw.ColumnHeaders.Add , , "线程优先极", 2000 ‘‘‘‘ morelvw.ColumnHeaders.Add , , "引用数", 1000 ‘‘ morelvw.LabelEdit = lvwManual morelvw.FullRowSelect = True morelvw.HideSelection = False morelvw.HideColumnHeaders = False morelvw.View = lvwReport End Sub Sub morelisc() morelvw.ListItems.Clear ‘‘‘‘清空列表,初始化 morelvw.ColumnHeaders.Clear ‘‘‘‘清空表头,初始化 morelvw.ColumnHeaders.Add , , "项目名称", 3000 ‘‘‘添加到表头第一项,有顺序的 morelvw.ColumnHeaders.Add , , "信息", 4000 morelvw.FullRowSelect = True morelvw.HideSelection = False morelvw.HideColumnHeaders = False