获取CPU信息

loquat

惯例只发图片，原因我不想说

loquat

也还有其他方式，效率较高的是API方式，环境变量方式。
不过低版本系统并没有对应的环境变量。API又有点难度。

小花鹿

曲高和寡啊                                                                                             

zhanglei1371

这个虽然效率低了点，凑合也能用(上面代码手打了一行，或许电脑原因，获取失败)^_^：

1. Sub 查询CPU()
   
2.     Dim WmiObj  As Object
   
3.     For Each WmiObj In GetObject("Winmgmts:").InstancesOf("Win32_Processor")
   
4.         MsgBox "当前CPU使用率为：" & WmiObj.LoadPercentage & "%"
   
5.     Next
   
6. End Sub
   
7. 
   
8. Sub test()
   
9. Dim sComputerName, WMI_Obj, WMI_ObjProps, ObjClsItem
   
10.     sComputerName = Environ("computername")
    
11.     If Len(Trim(sComputerName)) = 0 Then sComputerName = "."
    
12.     Set WMI_Obj = GetObject("winmgmts:\" & sComputerName & "\root\cimv2")
    
13.     Set WMI_ObjProps = WMI_Obj.ExecQuery("Select * from Win32_Processor", , 48)
    
14.     For Each ObjClsItem In WMI_ObjProps
    
15.         MsgBox "AddressWidth: " & ObjClsItem.AddressWidth
    
16.         MsgBox "Architecture: " & ObjClsItem.Architecture
    
17.         MsgBox "Availability: " & ObjClsItem.Availability
    
18.         MsgBox "Caption: " & ObjClsItem.Caption
    
19.         MsgBox "ConfigManagerErrorCode: " & ObjClsItem.ConfigManagerErrorCode
    
20.         MsgBox "ConfigManagerUserConfig: " & ObjClsItem.ConfigManagerUserConfig
    
21.         MsgBox "CpuStatus: " & ObjClsItem.CpuStatus
    
22.         MsgBox "CreationClassName: " & ObjClsItem.CreationClassName
    
23.         MsgBox "CurrentClockSpeed: " & ObjClsItem.CurrentClockSpeed
    
24.         MsgBox "CurrentVoltage: " & ObjClsItem.CurrentVoltage
    
25.         MsgBox "DataWidth: " & ObjClsItem.DataWidth
    
26.         MsgBox "Description: " & ObjClsItem.Description
    
27.         MsgBox "DeviceID: " & ObjClsItem.DeviceID
    
28.         MsgBox "ErrorCleared: " & ObjClsItem.ErrorCleared
    
29.         MsgBox "ErrorDescription: " & ObjClsItem.ErrorDescription
    
30.         MsgBox "ExtClock: " & ObjClsItem.ExtClock
    
31.         MsgBox "Family: " & ObjClsItem.Family
    
32.         MsgBox "InstallDate: " & ObjClsItem.InstallDate
    
33.         MsgBox "L2CacheSize: " & ObjClsItem.L2CacheSize
    
34.         MsgBox "L2CacheSpeed: " & ObjClsItem.L2CacheSpeed
    
35.         MsgBox "L3CacheSize: " & ObjClsItem.L3CacheSize
    
36.         MsgBox "L3CacheSpeed: " & ObjClsItem.L3CacheSpeed
    
37.         MsgBox "LastErrorCode: " & ObjClsItem.LastErrorCode
    
38.         MsgBox "Level: " & ObjClsItem.Level
    
39.         MsgBox "LoadPercentage: " & ObjClsItem.LoadPercentage
    
40.         MsgBox "Manufacturer: " & ObjClsItem.Manufacturer
    
41.         MsgBox "MaxClockSpeed: " & ObjClsItem.MaxClockSpeed
    
42.         MsgBox "Name: " & ObjClsItem.Name
    
43.         MsgBox "NumberOfCores: " & ObjClsItem.NumberOfCores
    
44.     Next
    
45. End Sub

复制代码

loquat

zhanglei1371 发表于 2019-7-26 22:21
这个虽然效率低了点，凑合也能用(上面代码手打了一行，或许电脑原因，获取失败)^_^：

我没有对比，你有兴趣，可以对比一下效率，以下是高精度计时器代码
就以前的印象，好像我这个代码比你发的这种效率要高很多。。。现在我就懒得测了。

1. Option Private Module
   
2. Option Explicit
   
3. 
   
4. Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
   
5. Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
   
6. 
   
7. Dim m_Time As Double          '
   
8. Dim m_TimeStart As Currency   '计时起点
   
9. Dim curFreq As Currency       '当前cpu频率
   
10. Dim m_TimeFreq As Double
    
11. 
    
12. Public Property Get mTimer() As Double
    
13.     Dim curTime As Currency
    
14.     QueryPerformanceCounter curTime
    
15.     mTimer = 1000 * (curTime - m_TimeStart) * m_TimeFreq + m_Time    '单位毫秒
    
16. End Property
    
17. 
    
18. Public Property Let mTimer(ByVal newValue As Double)
    
19.     Dim curOverhead As Currency
    
20.     m_Time = newValue
    
21.     QueryPerformanceFrequency curFreq
    
22.     m_TimeFreq = 1 / curFreq
    
23.     QueryPerformanceCounter curOverhead
    
24.     QueryPerformanceCounter m_TimeStart
    
25.     m_TimeStart = m_TimeStart + (m_TimeStart - curOverhead)
    
26. End Property
    

复制代码

使用简单：
mTimer = 0
你的代码
debug.print mTimer  '精确到毫秒级