获取 WINNT & WIN2000 下 CPU 使用率的 OCX 发放 ！

Question

花了好几个小时想用 VB 做这个功能，可实在是对 VB 调用 API 感到恼火！无奈下，把 VC 的程序该成了 OCX ，在 VB 里面调用上网找找好象没有这样的现成控件， VC 和 DELPHI 的现成代码到是很多。为解决广大 VB 程序员苦于无法方便的实现该功能的问题，先提供该 OCX 需要的人在这里留下 EMAIL 只发前20位，实在是没时间花在发邮件上。 其它同仁互相转发吧 。

Answer 1

OCX 提供3个方法：GetCPUuRate1.Initialize  ''用于初始化控件
GetCPUuRate1.GetURate    ''开始捕捉使用率
GetCPUuRate1.StopGetURate  '' 停止工作由于调用的系统 API 运行比较慢，所以时间步长定为1秒 ， 这样就和系统的任务管理器产生误差，因为两者所取的时间点不同，所以得到的结果会有所不同，但基本可用。

Answer 2

[email protected]凑个热闹.
 
:)

Answer 3

怎么都是两颗星的在参与，我有一个控件可以参看CPU Load、MEMORY Load、PageFile、Virtual Memory、Hard Drive Free Space等等的数据
喜欢的人我发给他
[email protected]

Answer 4

何必那么麻烦，这是我收集的一个类Option Explicit' OS Version API Calls
Private Type OSVERSIONINFO
   dwOSVersionInfoSize  As Long
   dwMajorVersion       As Long
   dwMinorVersion       As Long
   dwBuildNumber        As Long
   dwPlatformId         As Long
   szCSDVersion         As String * 128
End TypePrivate Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long' Windows 9x API Calls
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_DYN_DATA = &H80000006
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS = 0&
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 RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const REG_DWORD As Long = 4' Windows NT\2000\XP API Calls
Private Const SYSTEM_BASICINFORMATION = 0&
Private Const SYSTEM_PERFORMANCEINFORMATION = 2&
Private Const SYSTEM_TIMEINFORMATION = 3&
Private Const NO_ERROR = 0Private Type LARGE_INTEGER
    dwLow As Long
    dwHigh As Long
End TypePrivate Type SYSTEM_BASIC_INFORMATION
    dwUnknown1 As Long
    uKeMaximumIncrement As Long
    uPageSize As Long
    uMmNumberOfPhysicalPages As Long
    uMmLowestPhysicalPage As Long
    uMmHighestPhysicalPage As Long
    uAllocationGranularity As Long
    pLowestUserAddress As Long
    pMmHighestUserAddress As Long
    uKeActiveProcessors As Long
    bKeNumberProcessors As Byte
    bUnknown2 As Byte
    wUnknown3 As Integer
End TypePrivate Type SYSTEM_PERFORMANCE_INFORMATION
    liIdleTime As LARGE_INTEGER
    dwSpare(0 To 75) As Long
End TypePrivate Type SYSTEM_TIME_INFORMATION
    liKeBootTime As LARGE_INTEGER
    liKeSystemTime As LARGE_INTEGER
    liExpTimeZoneBias  As LARGE_INTEGER
    uCurrentTimeZoneId As Long
    dwReserved As Long
End TypePrivate Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)' Class Level Variables
Private m_blnIsWinNT As Boolean
Private liOldIdleTime As LARGE_INTEGER
Private liOldSystemTime As LARGE_INTEGER
Private hKey As Long
Private dwDataSize As Long
Private dwCpuUsage As Byte
Private dwType As Long

Answer 5

' Returns the current usage of the CPU as a percentage
Public Function CurrentCPUUsage() As Long   Dim structSysBaseInfo      As SYSTEM_BASIC_INFORMATION
   Dim structSysPerfInfo      As SYSTEM_PERFORMANCE_INFORMATION
   Dim structSysTimeInfo      As SYSTEM_TIME_INFORMATION
   Dim dblIdleTime            As Currency
   Dim dblSystemTime          As Currency
   Dim lngReturn              As Long   If m_blnIsWinNT = True Then
   
      CurrentCPUUsage = 0
      
      ' get number of processors in the system
      lngReturn = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(structSysBaseInfo), LenB(structSysBaseInfo), 0&)
      
      If lngReturn <> NO_ERROR Then Exit Function
      
      ' get new system time
      lngReturn = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(structSysTimeInfo), LenB(structSysTimeInfo), 0&)
      If lngReturn <> NO_ERROR Then Exit Function      ' get new CPU's idle time
      lngReturn = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(structSysPerfInfo), LenB(structSysPerfInfo), ByVal 0&)
      If lngReturn <> NO_ERROR Then Exit Function      ' CurrentValue = NewValue - OldValue
      dblIdleTime = LI2Currency(structSysPerfInfo.liIdleTime) - LI2Currency(liOldIdleTime)
      dblSystemTime = LI2Currency(structSysTimeInfo.liKeSystemTime) - LI2Currency(liOldSystemTime)
      
      ' CurrentCpuIdle = IdleTime / SystemTime
      If dblSystemTime <> 0 Then dblIdleTime = dblIdleTime / dblSystemTime
      
      ' CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
      dblIdleTime = 100 - dblIdleTime * 100 / structSysBaseInfo.bKeNumberProcessors + 0.5
      CurrentCPUUsage = Int(dblIdleTime)
      
      ' store new CPU's idle and system time
      liOldIdleTime = structSysPerfInfo.liIdleTime
      liOldSystemTime = structSysTimeInfo.liKeSystemTime
   
   Else
   
      dwDataSize = 4 'size of Long
      
      'Query the counter
      RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize
      CurrentCPUUsage = CLng(dwCpuUsage)
   
   End IfEnd FunctionPrivate Sub Class_Initialize()   Dim structOSVersionInfo    As OSVERSIONINFO
   Dim structSysTimeInfo      As SYSTEM_TIME_INFORMATION
   Dim structSysPerfInfo      As SYSTEM_PERFORMANCE_INFORMATION
   Dim lngReturn              As Long
   
   structOSVersionInfo.dwOSVersionInfoSize = Len(structOSVersionInfo)
   GetVersionEx structOSVersionInfo
   m_blnIsWinNT = (structOSVersionInfo.dwPlatformId = 2)
   
   ' Check which version of windows (9x or NT\2K\XP)
   If m_blnIsWinNT = True Then
   
      'get new system time
      lngReturn = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(structSysTimeInfo), LenB(structSysTimeInfo), 0&)
      If lngReturn <> NO_ERROR Then Exit Sub      'get new CPU's idle time
      lngReturn = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(structSysPerfInfo), LenB(structSysPerfInfo), ByVal 0&)
      If lngReturn <> NO_ERROR Then Exit Sub      'store new CPU's idle and system time
      liOldIdleTime = structSysPerfInfo.liIdleTime
      liOldSystemTime = structSysTimeInfo.liKeSystemTime
   
   Else
    
      ' start the counter by reading the value of the 'StartStat' key
      If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StartStat", 0, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then Exit Sub      dwDataSize = 4 'Length of Long
      RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize
      RegCloseKey hKey
      
      ' get current counter's value
      If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, KEY_READ, hKey) <> ERROR_SUCCESS Then Exit Sub
    
   End IfEnd SubPrivate Sub Class_Terminate()
    
   If m_blnIsWinNT = False Then
       
      RegCloseKey hKey
      
      'stopping the counter
      If RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StopStat", 0, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then Exit Sub
      dwDataSize = 4 'length of Long
      RegQueryValueEx hKey, "KERNEL\CPUUsage", ByVal 0&, dwType, dwCpuUsage, dwDataSize
      RegCloseKey hKey   End IfEnd SubPrivate Function LI2Currency(liInput As LARGE_INTEGER) As Currency
   
   CopyMemory LI2Currency, liInput, LenB(liInput)
   
End Function调用：
Private m_clsCPUUsage As New clsCPUUsagePrivate Sub Timer1_Timer()
   Label1.Caption = m_clsCPUUsage.CurrentCPUUsage
End Sub

Answer 6

楼上的，太感谢了！能不能把你的控件给我发一个？万分感谢！[email protected]

Answer 7

上边我写的代码是使用ntdll的api不知楼主使用哪种方法，另外在2000、Xp下还可以用 PDH.DLL中提供的api,声明在WINPERF.H 头文件中，调用这个就省事多了
Declare Function PdhVbGetOneCounterPath _
    Lib "PDH.DLL" _
    (ByVal PathString As String, _
    ByVal PathLength As Long, _
    ByVal DetailLevel As Long, _
    ByVal CaptionString As String) _
    As Long
    
Declare Function PdhVbCreateCounterPathList _
        Lib "PDH.DLL" _
        (ByVal PERF_DETAIL As Long, _
         ByVal CaptionString As String) _
        As LongDeclare Function PdhVbGetCounterPathFromList _
        Lib "PDH.DLL" _
        (ByVal Index As Long, _
         ByVal Buffer As String, _
         ByVal BufferLength As Long) _
        As LongDeclare Function PdhOpenQuery _
    Lib "PDH.DLL" _
    (ByVal Reserved As Long, _
    ByVal dwUserData As Long, _
    ByRef hQuery As Long) _
    As PDH_STATUSDeclare Function PdhCloseQuery _
    Lib "PDH.DLL" _
    (ByVal hQuery As Long) _
    As PDH_STATUSDeclare Function PdhVbAddCounter _
    Lib "PDH.DLL" _
    (ByVal QueryHandle As Long, _
    ByVal CounterPath As String, _
    ByRef CounterHandle As Long) _
    As PDH_STATUSDeclare Function PdhCollectQueryData _
    Lib "PDH.DLL" _
    (ByVal QueryHandle As Long) _
    As PDH_STATUS
    
Declare Function PdhVbIsGoodStatus _
    Lib "PDH.DLL" _
    (ByVal StatusValue As Long) _
    As Long
    
Declare Function PdhVbGetDoubleCounterValue _
    Lib "PDH.DLL" _
    (ByVal CounterHandle As Long, _
    ByRef CounterStatus As Long) _
    As Double

Answer 8

对的，我用的是 ntdll的api ：NtQuerySystemInformation但是搞不定在VB里面的调用，所以才用 VC ，简单方便