vb获取cpu占用率
合集下载
相关主题
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
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
'计算CPU占用率
curIdle = ConvertLI(spSysPerforfInfo.liIdleTime) - ConvertLI(lidOldIdle)
curSystem = ConvertLI(stSysTimeInfo.liKeSystemTime) - ConvertLI(liOldSystem)
Dim spSysPerforfInfo As SYSTEM_PERFORMANCE_INFORMATION
Dim stSysTimeInfo As SYSTEM_TIME_INFORMATION
Dim curIdle As Currency
Dim curSystem As Currency
'定义相关的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
' Label1.Caption = "当前CPU占用率:" & GetCPUUsage & "%"
'End Sub
liKeBootTime As LARGE_INTEGER
liKeSystemTime As LARGE_INTEGER
liExpTimeZoneBias As LARGE_INTEGER
uCurrentTimeZoneId As Long
dwReserved As Long
lidOldIdle = spSysPerforfInfo.liIdleTime
liOldSystem = stSysTimeInfo.liKeSystemTime
End Function
Private Function ConvertLI(liToConvert As LARGE_INTEGER) As Currency '把LARGE_INTEGER类型的数据转换成Currency类型
If lngResult <> NO_ERROR Then Exit Function
lngResult = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(stSysTimeInfo), LenB(stSysTimeInfo), 0&)
Dim lngResult As Long
GetCPUUsage = -1
lngResult = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(sbSysBasicInfo), LenB(sbSysBasicInfo), 0&)
If curSystem <> 0 Then curIdle = curIdle / curSystem
curIdle = 100 - curIdle * 100 / sbSysBasicInfo.bKeNumberProcessors + 0.5
GetCPUUsage = Int(curIdle)
'vb获取cpu占用率
'================================================================================================================================================================================
dwLow As Long
dwHigh As Long
End Type
Private Type SYSTEM_PERFORMANCE_INFORMATION
liIdleTime As LARGE_INTEGER
dwSpare(0 To 75) As Long
uMmLowestPhysicalPage As age As Long
uAllocationGranularity As Long
pLowestUserAddress As Long
pMmHighestUserAddress 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&
If lngResult <> NO_ERROR Then Exit Function
lngResult = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(spSysPerforfInfo), LenB(spSysPerforfInfo), ByVal 0&)
End Type
Private Type SYSTEM_BASIC_INFORMATION
dwUnknown1 As Long
uKeMaximumIncrement As Long
uPageSize As Long
uMmNumberOfPhysicalPages 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
CopyMemory ConvertLI, liToConvert, LenB(liToConvert)
End Function
Private Sub Class_Initialize() '类初始化
Dim stSysTimeInfo As SYSTEM_TIME_INFORMATION
Private Const SYSTEM_PERFORMANCEINFORMATION = 2&
Private Const SYSTEM_TIMEINFORMATION = 3&
Private Const NO_ERROR = 0
'相关的数据类型
Private Type LARGE_INTEGER
uKeActiveProcessors As Long
bKeNumberProcessors As Byte
bUnknown2 As Byte
wUnknown3 As Integer
End Type
Private Type SYSTEM_TIME_INFORMATION
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 Timer1_Timer()
Dim lngResult As Long
lngResult = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(stSysTimeInfo), LenB(stSysTimeInfo), 0&)
If lngResult <> NO_ERROR Then Exit Function
'计算CPU占用率
curIdle = ConvertLI(spSysPerforfInfo.liIdleTime) - ConvertLI(lidOldIdle)
curSystem = ConvertLI(stSysTimeInfo.liKeSystemTime) - ConvertLI(liOldSystem)
Dim spSysPerforfInfo As SYSTEM_PERFORMANCE_INFORMATION
Dim stSysTimeInfo As SYSTEM_TIME_INFORMATION
Dim curIdle As Currency
Dim curSystem As Currency
'定义相关的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
' Label1.Caption = "当前CPU占用率:" & GetCPUUsage & "%"
'End Sub
liKeBootTime As LARGE_INTEGER
liKeSystemTime As LARGE_INTEGER
liExpTimeZoneBias As LARGE_INTEGER
uCurrentTimeZoneId As Long
dwReserved As Long
lidOldIdle = spSysPerforfInfo.liIdleTime
liOldSystem = stSysTimeInfo.liKeSystemTime
End Function
Private Function ConvertLI(liToConvert As LARGE_INTEGER) As Currency '把LARGE_INTEGER类型的数据转换成Currency类型
If lngResult <> NO_ERROR Then Exit Function
lngResult = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(stSysTimeInfo), LenB(stSysTimeInfo), 0&)
Dim lngResult As Long
GetCPUUsage = -1
lngResult = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(sbSysBasicInfo), LenB(sbSysBasicInfo), 0&)
If curSystem <> 0 Then curIdle = curIdle / curSystem
curIdle = 100 - curIdle * 100 / sbSysBasicInfo.bKeNumberProcessors + 0.5
GetCPUUsage = Int(curIdle)
'vb获取cpu占用率
'================================================================================================================================================================================
dwLow As Long
dwHigh As Long
End Type
Private Type SYSTEM_PERFORMANCE_INFORMATION
liIdleTime As LARGE_INTEGER
dwSpare(0 To 75) As Long
uMmLowestPhysicalPage As age As Long
uAllocationGranularity As Long
pLowestUserAddress As Long
pMmHighestUserAddress 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&
If lngResult <> NO_ERROR Then Exit Function
lngResult = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(spSysPerforfInfo), LenB(spSysPerforfInfo), ByVal 0&)
End Type
Private Type SYSTEM_BASIC_INFORMATION
dwUnknown1 As Long
uKeMaximumIncrement As Long
uPageSize As Long
uMmNumberOfPhysicalPages 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
CopyMemory ConvertLI, liToConvert, LenB(liToConvert)
End Function
Private Sub Class_Initialize() '类初始化
Dim stSysTimeInfo As SYSTEM_TIME_INFORMATION
Private Const SYSTEM_PERFORMANCEINFORMATION = 2&
Private Const SYSTEM_TIMEINFORMATION = 3&
Private Const NO_ERROR = 0
'相关的数据类型
Private Type LARGE_INTEGER
uKeActiveProcessors As Long
bKeNumberProcessors As Byte
bUnknown2 As Byte
wUnknown3 As Integer
End Type
Private Type SYSTEM_TIME_INFORMATION
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 Timer1_Timer()