利用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 & "郵箱:[email protected]       論壇: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