新建From1(窗体),新建Command1(按钮CommandButton),代码:
Private Sub Command1_Click()
Debug.Print f_GetCPUUsage
End Sub
新建模块 modCpuValue.bas,代码:
'定义相关的API
Public Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
'相关的常量
Public Const SYSTEM_BASICINFORMATION = 0&
Public Const SYSTEM_PERFORMANCEINFORMATION = 2&
Public Const SYSTEM_TIMEINFORMATION = 3&
Public Const NO_ERROR = 0
'相关的数据类型
Public Type LARGE_INTEGER
dwLow As Long
dwHigh As Long
End Type
Public Type SYSTEM_PERFORMANCE_INFORMATION
liIdleTime As LARGE_INTEGER
dwSpare(0 To 75) As Long
End Type
Public 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
Public lidOldIdle As LARGE_INTEGER
Public liOldSystem As LARGE_INTEGER
Public Function f_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
f_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
f_GetCPUUsage = Int(curIdle)
lidOldIdle = spSysPerforfInfo.liIdleTime
liOldSystem = stSysTimeInfo.liKeSystemTime
End Function
Public Function ConvertLI(liToConvert As LARGE_INTEGER) As Currency '把LARGE_INTEGER类型的数据转换成Currency类型
CopyMemory ConvertLI, liToConvert, LenB(liToConvert)
End Function
Public Function 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 Function
lngResult = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(spSysPerforfInfo), LenB(spSysPerforfInfo), ByVal 0&)
If lngResult <> NO_ERROR Then Exit Function
lidOldIdle = spSysPerforfInfo.liIdleTime
liOldSystem = stSysTimeInfo.liKeSystemTime
End Function
按一下按钮就在立即窗口中可以看到值。