利用WMI轻松打造WINDOWS任务管理器

一些WMI应用技巧,其中有监视的创建终止监视等操作

代码如下：
Option Explicit
'显示XP风格函数
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
'显示消息函数
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'进程创建事件
Private WithEvents CreateProcessEvent As SWbemSink
'进程结束事件
Private WithEvents DeleteProcessEvent As SWbemSink
'进程属性更改事件
Private WithEvents ModificationProcessEvent As SWbemSink

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_Initialize()
    '显示XP风格
    InitCommonControls
End Sub

Private Sub cmdAbout_Click()
    MessageBox 0, "欢迎你使用Chenhui530编写的“WMI进程管理器”实例源码！如" & vbNewLine & "果你在使用中发现有什么问题请及时通过以下方式转告联系我。" & Chr(13) & "QQ号码： 285305530,335429       附加消息：“VB技术交流”" & vbNewLine & "邮箱:Chenhui00530@163.com       论坛:www.chenhui530.com", "关于", vbInformation
End Sub

Private Sub cmdKill_Click()
    Dim i As Integer, sum As Integer, checkValue As Integer
    '循环LISTVIEW筛选处于选中状态的ITEM
    For i = 1 To lvProcessexInfo.ListItems.Count
        If lvProcessexInfo.ListItems(i).Selected Then
            sum = sum + 1
            If UseWmiKillProcess(lvProcessexInfo.ListItems(i).SubItems(1)) Then
'                Me.lvProcessexInfo.ListItems.Remove i
                checkValue = checkValue + 1
            End If
        End If
    Next
    '这里不能用VB自带的Msgbox函数，因为VB自带的MSGBOX函数会使程序暂时处于中断状态这样结束了的进程还会显示在LISTVIEW中
    '这个检测当选择多个进程时的结果
    If checkValue <> 0 Then
        If checkValue = sum Then
            MessageBox 0, "终止进程成功！！", "提示", vbInformation
        Else
            If checkValue > 0 Then
                MessageBox 0, "有部分进程终止失败！！", "提示", vbInformation
            Else
                MessageBox 0, "终止进程失败！！", "提示", vbCritical
            End If
        End If
    Else
        MessageBox 0, "你还没有选择需要结束的进程呢！！", "提示", vbInformation
    End If
End Sub

Private Sub cmdRun_Click()
    frmRun.Show
End Sub

Private Sub Form_Load()
    Dim objSWbemServices As SWbemServices, process As SWbemObject, processes As SWbemObjectSet, lvItem As ListItem
    Dim processUserName As String, processPath As String, i As Integer, lgWorkingSetSize As Long
    '连接WMI服务
    If ConnectWmiServer(objSWbemServices, ".") Then
        Me.Show
        '限制鼠标更改窗体大小
        ControlSize frmMain, False
        '遍历进程
        Set processes = objSWbemServices.ExecQuery("Select * From Win32_Process")
        For Each process In processes
            DoEvents
            i = i + 1
            statusMsg.Panels.Item(1).Text = "进程数： " & i
            '当进程ID为0时表示是系统空闲进程
            If process.Properties_("ProcessID") = "0" Then
                Set lvItem = Me.lvProcessexInfo.ListItems.Add(, , "系统空闲进程")
            Else
                '不为0则显示其名字
                Set lvItem = Me.lvProcessexInfo.ListItems.Add(, , process.Properties_("Name"))
            End If
            '添加进程ID到LISTVIEW中
            lvItem.SubItems(1) = process.Properties_("ProcessID")
            '获取进程用户名称(通过进程中的GetOwner函数)
            processUserName = IIf(IsNull(process.ExecMethod_("GetOwner").Properties_("User")), "SYSTEM", process.ExecMethod_("GetOwner").Properties_("User"))
            lgWorkingSetSize = lgWorkingSetSize + (Val(process.Properties_("WorkingSetSize")) / 1024) / 1024
            '添加进程用户名到LISTVIEW中
            lvItem.SubItems(2) = processUserName
            '添加进程使用内存到LISTVIEW中
            lvItem.SubItems(3) = CStr(Val(process.Properties_("WorkingSetSize")) / 1024) & "K"
            statusMsg.Panels.Item(2).Text = "内存使用： " & lgWorkingSetSize & "M"
            '添加进程路径到LISTVIEW中（在这里先判断COMMANDLINE为空吗不为空则先判断PATH如果PATH长于COMMANDLINE就用PATH）
            If IsNull(process.Properties_("CommandLine")) Then
                If IsNull(process.Properties_("ExecutablePath")) Then
                    processPath = ""
                Else
                    processPath = process.Properties_("ExecutablePath")
                End If
            Else
                If Len(process.Properties_("ExecutablePath")) > Len(process.Properties_("CommandLine")) Then
                    processPath = process.Properties_("ExecutablePath")
                Else
                    processPath = process.Properties_("CommandLine")
                End If
            End If
            processPath = Replace(processPath, """", "")
            lvItem.SubItems(4) = processPath
            '要获取图标必须使用路径不能用COMMANDLINE
            If IsNull(process.Properties_("ExecutablePath")) Then
                processPath = ""
            Else
                processPath = process.Properties_("ExecutablePath")
            End If
            '排除进程ID为0和4的进程
            If process.Properties_("ProcessID") <> "0" And process.Properties_("ProcessID") <> "4" Then
                'IMAGELIST添加KEY因为KEY必须为唯一而且不能为数字所以我在前面加了个H
                imgProcessList.ListImages.Add , "H" & process.Properties_("ProcessID"), GetIcon(processPath)
                lvItem.smallIcon = imgProcessList.ListImages.Item("H" & process.Properties_("ProcessID")).Key
            End If
        Next
        '开始进程的监视
        StartMonitorCreateProcessEvent
        StartMonitorDeleteProcessEvent
        StartMonitorModificationProcessEvent
    Else
        MessageBox 0, "连接不到WMI服务！！", "错误", vbCritical
    End If
    '释放对象内存
    SetObjectNothing objSWbemServices
    SetObjectNothing process
    SetObjectNothing processes
    SetObjectNothing lvItem

    '限制窗体大小
    OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
    '恢复鼠标更改窗体大小
    ControlSize frmMain, True
End Sub

Private Function GetWorkingSetSize() As String
    Dim i As Integer, lgWorkingSetSize As Long
    For i = 1 To Me.lvProcessexInfo.ListItems.Count
        lgWorkingSetSize = lgWorkingSetSize + Val(Me.lvProcessexInfo.ListItems(i).SubItems(3))
    Next
    GetWorkingSetSize = CStr(lgWorkingSetSize / 1024) & "M"
End Function

'释放变量内存方法
Private Sub SetObjectNothing(obj As Object)
    Set obj = Nothing
End Sub

'终止进程函数
Private Function UseWmiKillProcess(ByVal processId As String) As Boolean
    Dim objSWbemServices As SWbemServices, process As SWbemObject, processes As SWbemObjectSet, intReturn As Integer
    '连接WMI服务
    If ConnectWmiServer(objSWbemServices, ".") Then
        Set processes = objSWbemServices.ExecQuery("Select * From Win32_Process Where ProcessID=" & processId)
        For Each process In processes
            '调用Terminate方法结束进程
            intReturn = process.Terminate
            If intReturn = 0 Then
                UseWmiKillProcess = True
            Else
                UseWmiKillProcess = False
            End If
        Next
    Else
        MessageBox 0, "连接不到WMI服务！！", "错误", vbCritical
    End If
End Function

'连接 WMI服务函数(此函数也可以连接远程计算机，当要连接远程计算机时把参数“strComputerName”指示为IP地址即可但是注意的是还要提供用户名和密码)
Private Function ConnectWmiServer(objSWbemServices As SWbemServices, ByVal strComputerName As String, Optional ByVal strNameSpace As String = "root/cimv2", Optional ByVal strUserName As String = "", Optional ByVal strPassWord As String = "") As Boolean
    Dim objSWbemLocator As SWbemLocator
    On Error GoTo errLine
    Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
    '提升权限为DEBUG权限
    objSWbemLocator.Security_.Privileges.Add wbemPrivilegeDebug
    If strComputerName <> "." Then
        Set objSWbemServices = objSWbemLocator.ConnectServer(strComputerName, strNameSpace, strUserName, strPassWord)
    Else
        Set objSWbemServices = objSWbemLocator.ConnectServer()
    End If
    ConnectWmiServer = True
    Set objSWbemLocator = Nothing
    Exit Function
errLine:
    ConnectWmiServer = False
    Set objSWbemLocator = Nothing
End Function

'利用 WMI创建进程
Public Function UseWmiCreateProcess(ByVal strFile As String) As Long
    Dim objSWbemServices As SWbemServices, objSWbemObject As SWbemObject, processId As Long, errResult As Long
    '连接 WMI服务
    If ConnectWmiServer(objSWbemServices, ".") Then
        '获取一个 WMI实例
        Set objSWbemObject = objSWbemServices.Get("Win32_Process")
        '调用CREATE方法创建一进程
        errResult = objSWbemObject.Create(strFile, Null, Null, processId)
        '当成功则返回其PID
        If errResult <> 0 Then
            UseWmiCreateProcess = 0
        Else
            UseWmiCreateProcess = processId
        End If
    Else
        MessageBox 0, "连接不到 WMI服务！！", "错误", vbCritical
    End If
    '释放内存
    SetObjectNothing objSWbemServices
    SetObjectNothing objSWbemObject
End Function

Private Sub StartMonitorCreateProcessEvent()
    '执行进程创建事件
    Dim objSWbemServices As SWbemServices
    If ConnectWmiServer(objSWbemServices, ".") Then
        Set CreateProcessEvent = New SWbemSink
        'Set objSWbemServices = GetObject("winmgmts://./root/cimv2")
        objSWbemServices.ExecNotificationQueryAsync CreateProcessEvent, "SELECT * FROM __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_Process'"
    Else
        MessageBox 0, "连接不到 WMI服务！！", "错误", vbCritical
    End If
    SetObjectNothing objSWbemServices
End Sub

Private Sub StartMonitorDeleteProcessEvent()
    '执行进程结束事件
    Dim objSWbemServices As SWbemServices
    If ConnectWmiServer(objSWbemServices, ".") Then
        Set DeleteProcessEvent = New SWbemSink
        'Set objSWbemServices = GetObject("winmgmts://./root/cimv2")
        objSWbemServices.ExecNotificationQueryAsync DeleteProcessEvent, "SELECT * FROM __InstanceDeletionEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_Process'"
    Else
        MessageBox 0, "连接不到 WMI服务！！", "错误", vbCritical
    End If
    SetObjectNothing objSWbemServices
End Sub

Private Sub StartMonitorModificationProcessEvent()
    '执行进程属性变更事件
    Dim objSWbemServices As SWbemServices
    If ConnectWmiServer(objSWbemServices, ".") Then
        Set ModificationProcessEvent = New SWbemSink
        'Set objSWbemServices = GetObject("winmgmts://./root/cimv2")
        objSWbemServices.ExecNotificationQueryAsync ModificationProcessEvent, "SELECT * FROM __InstanceModificationEvent WITHIN 5 WHERE TargetInstance ISA 'Win32_Process'"
    Else
        MessageBox 0, "连接不到 WMI服务！！", "错误", vbCritical
    End If
    SetObjectNothing objSWbemServices
End Sub

 '进程创建事件
Private Sub CreateProcessEvent_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    '当有进程创建了则添加信息到LISTVIEW中
    Dim lvItem As ListItem, lgWorkingSetSize As Long
    Dim processUserName As String, processPath As String
    '添加进程名到LISTVIEW中
    Set lvItem = Me.lvProcessexInfo.ListItems.Add(, , objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("Name").Value)
    '添加进程PID到LISTVIEW中
    lvItem.SubItems(1) = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessID").Value
    '添加进程用户名到LISTVIEW中
    processUserName = GetProcessUserNameByProcessID(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessID").Value)
    lvItem.SubItems(2) = processUserName
    '添加进程使用的内存到LISTVIEW中
    lvItem.SubItems(3) = CStr(CLng(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("WorkingSetSize").Value) / 1024) & "K"
    '添加进程路径到LISTVIEW中
    If IsNull(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("CommandLine")) Then
        If IsNull(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ExecutablePath")) Then
            processPath = ""
        Else
            processPath = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ExecutablePath")
        End If
    Else
        If Len(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ExecutablePath")) > Len(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("CommandLine")) Then
            processPath = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ExecutablePath")
        Else
            processPath = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("CommandLine")
        End If
    End If
    lvItem.SubItems(4) = Replace(processPath, """", "")
    processPath = objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ExecutablePath").Value
    imgProcessList.ListImages.Add , "H" & objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessID").Value, GetIcon(processPath)
    lvItem.smallIcon = imgProcessList.ListImages.Item("H" & objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessID").Value).Key
    lgWorkingSetSize = (Val(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("WorkingSetSize").Value) / 1024) / 1024
    statusMsg.Panels.Item(1).Text = "进程数： " & CStr(Mid(statusMsg.Panels.Item(1).Text, 5, Len(statusMsg.Panels.Item(1).Text) - 4) + 1)
    statusMsg.Panels.Item(2).Text = "内存使用： " & Mid(statusMsg.Panels.Item(2).Text, 6, Len(statusMsg.Panels.Item(2).Text) - 6) + lgWorkingSetSize & "M"
    SetObjectNothing lvItem
End Sub

'获取进程用户名函数
Private Function GetProcessUserNameByProcessID(ByVal processId As String) As String
    Dim objSWbemServices As SWbemServices, objWbemObjectSet As SWbemObjectSet, objWbemObject As SWbemObject
    '连接WMI服务
    If ConnectWmiServer(objSWbemServices, ".") Then
        Set objWbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_Process Where ProcessID=" & processId)
        For Each objWbemObject In objWbemObjectSet
            '获取进程用户名称(通过进程中的GetOwner函数
            GetProcessUserNameByProcessID = objWbemObject.ExecMethod_("GetOwner").Properties_("User")
        Next
    Else
        MessageBox 0, "连接不到WMI服务！！", "错误", vbCritical
    End If
    '释放内存
    SetObjectNothing objSWbemServices
    SetObjectNothing objWbemObjectSet
    SetObjectNothing objWbemObject
End Function

'进程退出事件
Private Sub DeleteProcessEvent_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    '当有进程结束了则查找LISTVIEW对应项并且删除它
    Dim lvItem As ListItem, lgWorkingSetSize As Long
    Set lvItem = Me.lvProcessexInfo.FindItem(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessID"), lvwSubItem, , lvwPartial)
    Me.lvProcessexInfo.ListItems.Remove lvItem.Index
    '更新进程数
    statusMsg.Panels.Item(1).Text = "进程数： " & CStr(Mid(statusMsg.Panels.Item(1).Text, 5, Len(statusMsg.Panels.Item(1).Text) - 4) - 1)
    '更新内存使用率
    lgWorkingSetSize = (Val(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("WorkingSetSize").Value) / 1024) / 1024
    statusMsg.Panels.Item(2).Text = "内存使用： " & Mid(statusMsg.Panels.Item(2).Text, 6, Len(statusMsg.Panels.Item(2).Text) - 6) - lgWorkingSetSize & "M"
    SetObjectNothing lvItem
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.lvProcessexInfo.Width = Me.Width - 340
    Me.lvProcessexInfo.Height = Me.Height - 1760
    Me.cmdAbout.Top = Me.lvProcessexInfo.Height + 500
    Me.cmdExit.Top = Me.cmdAbout.Top
    Me.cmdKill.Top = Me.cmdAbout.Top
    Me.cmdRun.Top = Me.cmdAbout.Top
    Me.cmdExit.Left = Me.Width - 220 - Me.cmdExit.Width
    Me.cmdRun.Left = Me.cmdExit.Left - Me.cmdExit.Width - 140
    Me.cmdKill.Left = Me.cmdRun.Left - Me.cmdRun.Width - 140
    Me.cmdAbout.Left = Me.cmdKill.Left - Me.cmdKill.Width - 140
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    End
End Sub

'进程属性变更事件
Private Sub ModificationProcessEvent_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
    '主要是监视内存的变化
    On Error Resume Next
    Dim lvItem As ListItem, lgWorkingSetSize As Long
    Set lvItem = Me.lvProcessexInfo.FindItem(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("ProcessID"), lvwSubItem, , lvwPartial)
    '算出实时内存使用情况（也可以用GetWorkingSetSize函数，但是这个显得科学些）
    lgWorkingSetSize = Left(lvItem.SubItems(3), Len(lvItem.SubItems(3)) - 1)
    lgWorkingSetSize = CInt((objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("WorkingSetSize").Value / 1024 - lgWorkingSetSize) / 1024)
    lvItem.SubItems(3) = CStr(Val(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("WorkingSetSize").Value) / 1024) & "K"
    statusMsg.Panels.Item(2).Text = "内存使用： " & Mid(statusMsg.Panels.Item(2).Text, 6, Len(statusMsg.Panels.Item(2).Text) - 6) + lgWorkingSetSize & "M"
    SetObjectNothing lvItem
End Sub