VB利用WMI编写的任务管理器

原创 2007年09月30日 14:14:00

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
Attribute CreateProcessEvent.VB_VarHelpID = -1
'进程结束事件
Private WithEvents DeleteProcessEvent As SWbemSink
Attribute DeleteProcessEvent.VB_VarHelpID = -1
'进程属性更改事件
Private WithEvents ModificationProcessEvent As SWbemSink
Attribute ModificationProcessEvent.VB_VarHelpID = -1

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
 

WMI编程资料(VB示列)

  • 2008年06月11日 18:01
  • 463KB
  • 下载

VB 使用WMI编程(一)

由底至上是:          • 托管资源           • WMI 基础结构           • 使用者 托管资源    托管资源是任意逻辑或物理组件,通过使用 WMI 进行公开和管理。...
  • wu8313
  • wu8313
  • 2009年10月24日 07:39
  • 2144

VB 利用WMI进行服务监视

VERSION 5.00Begin VB.Form frmMain    Caption         =   "服务监视"   ClientHeight    =   2730   ClientL...
  • chenhui530
  • chenhui530
  • 2007年10月03日 11:25
  • 1462

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

一些WMI应用技巧,其中有监视的创建终止监视等操作代码如下:Option Explicit显示XP风格函数Private Declare Sub InitCommonControls Lib "com...
  • chenhui530
  • chenhui530
  • 2007年12月14日 12:53
  • 2160

VB 利用WMI进行进程监视

 VERSION 5.00Begin VB.Form frmMain    Caption         =   "Form1"   ClientHeight    =   3090   Clien...
  • chenhui530
  • chenhui530
  • 2007年10月03日 11:16
  • 2473

vb wmi 修改ip地址、网关、DNS

strComputer="." Set objWMIService=GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colNe...
  • yinxing2008
  • yinxing2008
  • 2013年02月24日 21:26
  • 1159

服务器上使用WMI报 '80041003' Automation 错误的解决办法

我在网上找的获取cpuid的vb代码,直接在vb中运行正常,我把它打包成dll文件,在asp中引用总是报下面错误在桌面--右击“我的电脑”--“管理”最后“确定“原因:'80041003'  Auto...
  • zhichao2001
  • zhichao2001
  • 2010年08月21日 09:51
  • 3235

使用WMI来得到系统的服务

WMI是可伸缩的系统管理结构,该规范采用一个统一、基于标准且可扩展的面向对象接口。它提供与系统管理员信息和基础WMI API交互的标准方法,主要由系统管理应用程序开发人员和系统管理员用来访问和操作系统...
  • online
  • online
  • 2004年08月09日 01:05
  • 2246

MFC实现Windows自带的任务管理器性能使用记录功能

1概述最近在项目中需要显示实时监控的折线图,通过在网上搜索解决方案,发现了一个开源的基于MFC的类实现了Windows任务管理器性能使用记录的显示。在此基础上进行修改。在这里对该类进行详细的分析,并且...
  • michealmeng555
  • michealmeng555
  • 2010年07月11日 14:49
  • 4903

用C#开发较完整的Windows任务管理器

原文:http://www.cnblogs.com/lemony/archive/2007/04/11/708309.html这个代码没有什么技术含量,仅仅使用 WMI 和 API 实现了 Windo...
  • qsdnet
  • qsdnet
  • 2007年04月11日 13:34
  • 1742
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB利用WMI编写的任务管理器
举报原因:
原因补充:

(最多只允许输入30个字)