获得某进程相对应的CPU占用率
如果用代码取得某进程的CPU占用率?并非是调出任务管理器
[解决办法]
Public Declare Function GetProcessTimes Lib "kernel32 " Alias "GetProcessTimes " (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
[解决办法]
Option Explicit
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function RegQueryValueEx Lib "advapi32.dll " Alias "RegQueryValueExA " (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll " Alias "RegOpenKeyA " (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll " (ByVal hKey As Long) As Long
Private Declare Function PdhVbOpenQuery Lib "PDH.DLL " (ByRef QueryHandle As Long) As Long
Private Declare Function PdhCloseQuery Lib "PDH.DLL " (ByVal hQuery As Long) As Long
Private Declare Function PdhVbAddCounter Lib "PDH.DLL " (ByVal QueryHandle As Long, ByVal CounterPath As String, ByRef CounterHandle As Long) As Long
Private Declare Function PdhRemoveCounter Lib "PDH.DLL " (ByVal CounterHandle As Long) As Long
Private Declare Function PdhCollectQueryData Lib "PDH.DLL " (ByVal QueryHandle As Long) As Long
Private Declare Function PdhVbGetDoubleCounterValue Lib "PDH.DLL " (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double
Private Declare Function GetVersionEx Lib "kernel32 " Alias "GetVersionExA " (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const lType = 4
Private Const lSize = 4
Private Const HKEY_DYN_DATA As Long = &H80000006
Private mblnIsNT As Boolean
Private mhStatKey As Long
Private mhQuery As Long
Private mhCounter As Long
'获取CPU使用率
Public Property Get Usage() As Long
Dim ret As Long
Dim lData As Long
If mblnIsNT Then
Call PdhCollectQueryData(mhQuery) ' NT
ret = CLng(PdhVbGetDoubleCounterValue(mhCounter, lData))
Else
Call RegQueryValueEx(mhStatKey, "KERNEL\CPUUsage ", 0, lType, lData, lSize) ' 9x
ret = lData
End If
Usage = ret
End Property
Private Function mIsNT() As Boolean
Dim vi As OSVERSIONINFO
vi.dwOSVersionInfoSize = Len(vi)
Call GetVersionEx(vi)
mIsNT = (vi.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Private Sub Class_Initialize()
Dim lData As Long
Dim hKey As Long
mblnIsNT = mIsNT
If mblnIsNT Then
Call PdhVbOpenQuery(mhQuery)
Call PdhVbAddCounter(mhQuery, "\Processor(0)\% Processor Time ", mhCounter)
Else
Call RegOpenKey(HKEY_DYN_DATA, "PerfStats\StartStat ", hKey)
Call RegQueryValueEx(hKey, "KERNEL\CPUUsage ", 0, lType, lData, lSize)
Call RegCloseKey(hKey)
Call RegOpenKey(HKEY_DYN_DATA, "PerfStats\StatData ", mhStatKey)
End If
lData = Me.Usage
End Sub
Private Sub Class_Terminate()
Dim lData As Long
Dim hKey As Long
If mblnIsNT Then
Call PdhRemoveCounter(mhCounter) ' NT
Call PdhCloseQuery(mhQuery)
Else
Call RegCloseKey(mhStatKey) ' 9x
Call RegOpenKey(HKEY_DYN_DATA, "PerfStats\StopStat ", hKey)
Call RegQueryValueEx(hKey, "KERNEL\CPUUsage ", 0, lType, lData, lSize)
Call RegCloseKey(hKey)
End If
End Sub
