下面是新增加的两个功能代码块
代码一:
一个小技巧关于PrevInstance的
VERSION 5.00
Begin VB.Form frmMain
Caption = "李小俊是个猪头"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_RESTORE = &HF120&
Private Sub Form_Load()
Me.WindowState = 1
If App.PrevInstance Then
Me.Caption = ""
Dim hWnd As Long
hWnd = FindWindow(vbNullString, "李小俊是个猪头")
If hWnd > 0 Then
SendMessage hWnd, WM_SYSCOMMAND, SC_RESTORE, 0
SetForegroundWindow hWnd
Unload Me: End
End If
End If
End Sub
代码二:
利用WMI轻松打造WINDOWS任务管理器
由于这个代码有点长,就贴关键的地方吧,需要完整的可以到博客去下载
'终止进程函数
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
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
发表于 @ 2008年05月01日 13:37:43|评论(loading...)|编辑