Question

用VB检测CPU使用率

我想用VB做一个程序，当CPU使用率为100时自动暂停程序，当使用率回落到50以下时又重新开始，可是要怎么样才能使系统返回当前的CPU使用率呢（这个软件没有实际用途，我只是想研究编程技术而已）

Answer 1

Option Explicit

'定义相关的API
Private 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)

'相关的常量
Private Const SYSTEM_BASICINFORMATION = 0&
Private Const SYSTEM_PERFORMANCEINFORMATION = 2&
Private Const SYSTEM_TIMEINFORMATION = 3&
Private Const NO_ERROR = 0

'相关的数据类型
Private Type LARGE_INTEGER
dwLow As Long
dwHigh As Long
End Type

Private Type SYSTEM_PERFORMANCE_INFORMATION
liIdleTime As LARGE_INTEGER
dwSpare(0 To 75) As Long
End Type

Private 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 Type

Private Type SYSTEM_TIME_INFORMATION
liKeBootTime As LARGE_INTEGER
liKeSystemTime As LARGE_INTEGER
liExpTimeZoneBias As LARGE_INTEGER
uCurrentTimeZoneId As Long
dwReserved As Long
End Type

Private lidOldIdle As LARGE_INTEGER
Private liOldSystem As LARGE_INTEGER

Private Function GetCPUUsage() As Long '这是接口过程

Dim sbSysBasicInfo As SYSTEM_BASIC_INFORMATION
Dim spSysPerforfInfo As SYSTEM_PERFORMANCE_INFORMATION
Dim stSysTimeInfo As SYSTEM_TIME_INFORMATION
Dim curIdle As Currency
Dim curSystem As Currency
Dim lngResult As Long

GetCPUUsage = -1

lngResult = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(sbSysBasicInfo), LenB(sbSysBasicInfo), 0&)
If lngResult <> NO_ERROR Then Exit Function

lngResult = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(stSysTimeInfo), LenB(stSysTimeInfo), 0&)
If lngResult <> NO_ERROR Then Exit Function

lngResult = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(spSysPerforfInfo), LenB(spSysPerforfInfo), ByVal 0&)
If lngResult <> NO_ERROR Then Exit Function

'计算CPU占用率
curIdle = ConvertLI(spSysPerforfInfo.liIdleTime) - ConvertLI(lidOldIdle)
curSystem = ConvertLI(stSysTimeInfo.liKeSystemTime) - ConvertLI(liOldSystem)
If curSystem <> 0 Then curIdle = curIdle / curSystem
curIdle = 100 - curIdle * 100 / sbSysBasicInfo.bKeNumberProcessors + 0.5
GetCPUUsage = Int(curIdle)

lidOldIdle = spSysPerforfInfo.liIdleTime
liOldSystem = stSysTimeInfo.liKeSystemTime
End Function

Private Function ConvertLI(liToConvert As LARGE_INTEGER) As Currency '把LARGE_INTEGER类型的数据转换成Currency类型
CopyMemory ConvertLI, liToConvert, LenB(liToConvert)
End Function

Private Sub Class_Initialize() '类初始化
Dim stSysTimeInfo As SYSTEM_TIME_INFORMATION
Dim spSysPerforfInfo As SYSTEM_PERFORMANCE_INFORMATION
Dim lngResult As Long

lngResult = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(stSysTimeInfo), LenB(stSysTimeInfo), 0&)
If lngResult <> NO_ERROR Then Exit Sub
lngResult = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(spSysPerforfInfo), LenB(spSysPerforfInfo), ByVal 0&)
If lngResult <> NO_ERROR Then Exit Sub
lidOldIdle = spSysPerforfInfo.liIdleTime
liOldSystem = stSysTimeInfo.liKeSystemTime
End Sub

Private Sub Form_Load()
Timer1.Interval = 1000

End Sub

Private Sub Timer1_Timer()
Me.Caption = "当前CPU占用率:" & GetCPUUsage & "%"
End Sub

心得交流http://hi.baidu.com/wyzy520

Answer 2

可以从注册表里或得
每一秒获取一次如果满足条件则退出