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      论坛:www.chenhui530", "关于", 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.ListImage
s.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.Propertie
s_.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, obj

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。