VB模拟进程管理器

VB模拟进程管理器:

'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
    '获得进程的句柄
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
            ByVal blnheritHandle As Long, ByVal dwAppProcessId 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 ProcessFirst Lib "kernel32" Alias "Process32First" _
            (ByVal mSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    '获得系统快照中的下一个进程的信息
    Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" _
            (ByVal mSnapShot As Long, uProcess As PROCESSENTRY32) 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
    Private Const TH32CS_SNAPPROCESS As Long = 2&
    Dim mresult
Private Sub Form_Load()
    '配置ListView控件。
    lvwPrss.ListItems.Clear
    lvwPrss.ColumnHeaders.Clear
    lvwPrss.ColumnHeaders.Add , , "进程ID", 1500
    lvwPrss.ColumnHeaders.Add , , "进程名", 5600
    lvwPrss.LabelEdit = lvwManual
    lvwPrss.FullRowSelect = True
    lvwPrss.HideSelection = False
    lvwPrss.HideColumnHeaders = False
    lvwPrss.View = lvwReport
End Sub


Private Sub doList()
    Dim uProcess As PROCESSENTRY32
    Dim mSnapShot As Long
    Dim mName As String
    Dim i As Integer
    Dim mlistitem As ListItem
    Dim msg As String
    lvwPrss.ListItems.Clear
    DoEvents
    '获取进程长度？？
    uProcess.dwSize = Len(uProcess)
    '创建一个系统快照
    mSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    If mSnapShot Then
        '获取第一个进程
        mresult = ProcessFirst(mSnapShot, uProcess)
        '失败则返回false
        Do While mresult
            '返回进程长度值+1，Chr(0)的作用：结束语，防止修改进程
            i = InStr(1, uProcess.szexeFile, Chr(0))
            '转换成小写
            mName = LCase$(Left$(uProcess.szexeFile, i - 1))
            '在listview控件中添加当前进程名
            Set mlistitem = lvwPrss.ListItems.Add(, , Text:=uProcess.th32ProcessID)
            '添加进程名
            mlistitem.SubItems(1) = mName
            '获取下一个进程
            mresult = ProcessNext(mSnapShot, uProcess)
        Loop
    Else
        ErrMsgProc (msg)
    End If
    cmdDelete.Enabled = (lvwPrss.ListItems.Count > 0)
End Sub
Private Sub cmdRefresh_Click()
    doList
End Sub

Private Sub Form_Activate()
    doList
End Sub
Private Sub cmdExit_Click()
    Unload Me
End Sub
'listview的大小随窗体变化
Private Sub Form_Resize()
    '此处不能最小化，否则出错
    lvwPrss.Move 0, 0, Me.ScaleWidth - cmdRefresh.Width, Me.ScaleHeight
    cmdRefresh.Move lvwPrss.Width - lvwPrss.Left
    cmdDelete.Move lvwPrss.Width - lvwPrss.Left
    cmdExit.Move lvwPrss.Width - lvwPrss.Left
End Sub
'强行终止当前进程
Private Sub cmdDelete_Click()
    If lvwPrss.ListItems.Count = 0 Then
        Exit Sub
    End If
    If MsgBox("真的终止" & lvwPrss.Name & " 进程吗?", vbYesNo + vbQuestion) <> vbYes Then
        Exit Sub
    End If
  
    Dim mProcID As Long
    '打开进程
    mProcID = OpenProcess(1&, -1&, lvwPrss.SelectedItem)
    '终止进程
    TerminateProcess mProcID, 0&
    DoEvents
    lvwPrss.ListItems.Remove (lvwPrss.SelectedItem.Index)
    lvwPrss.Refresh
End Sub
'显示错误信息
Sub ErrMsgProc(mMsg As String)
    MsgBox mMsg & vbCrLf & Err.Number & Space(5) & Err.Description
End Sub