Option Explicit
Private m_arrCPU() As String
Private m_objCPUSet As SWbemObjectSet
Private m_objWMINameSpace As SWbemServices
Private Sub Form_Load()
Dim objCPU As SWbemObject 'WMI Object
Dim strPath As String
Dim strCaption As String
Dim lngElement As Long
ReDim m_arrCPU(0) As String
On Error GoTo ErrorHandler
Set m_objWMINameSpace = GetObject("winmgmts:")
lstCPU.Clear
Set m_objCPUSet = m_objWMINameSpace.InstancesOf("Win32_Processor")
strCaption = m_objCPUSet.Count & " processor"
If m_objCPUSet.Count <> 1 Then strCaption = strCaption & "s"
strCaption = strCaption & " detected on this machine"
lblTitle.Caption = strCaption
For Each objCPU In m_objCPUSet
With objCPU
strPath = .Path_ & ""
If strPath <> "" Then
lstCPU.AddItem .Name
'save path to array, in case the machine has multiple CPUs,
'each can be identified and their info loaded if needed
lngElement = IIf(m_arrCPU(0) = "", 0, UBound(m_arrCPU) + 1)
ReDim Preserve m_arrCPU(lngElement) As String
m_arrCPU(lngElement) = strPath
End If
End With
Next
If lstCPU.ListCount <> 0 Then lstCPU.ListIndex = 0
ExitProc:
Set objCPU = Nothing
Exit Sub
ErrorHandler:
MsgBox "CPU Information could not be displayed." & vbCrLf & Err.Description, , "Error"
Resume ExitProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m_objCPUSet = Nothing
Set m_objWMINameSpace = Nothing
End Sub
Private Sub lstCPU_Click()
Dim objCPU As SWbemObject
Dim strInfo As String
On Error Resume Next
Set objCPU = m_objCPUSet(m_arrCPU(lstCPU.ListIndex))
With objCPU
strInfo = "Description: " & .Description & vbCrLf
strInfo = strInfo & "Processor ID: " & .ProcessorID & vbCrLf
strInfo = strInfo & "Status: " & .Status & vbCrLf
strInfo = strInfo & "Manufacturer: " & .Manufacturer & vbCrLf
strInfo = strInfo & "Availability: " & AvailabilityToString(.Availability) & vbCrLf
strInfo = strInfo & "Load Percentage: " & .LoadPercentage & vbCrLf
strInfo = strInfo & "Current Clock Speed: " & .CurrentClockSpeed & " MHz" & vbCrLf
strInfo = strInfo & "Maximum Clock Speed: " & .MaxClockSpeed & vbCrLf
strInfo = strInfo & "Level 2 Cache Size: " & .L2CacheSize & vbCrLf
strInfo = strInfo & "Level 2 Cache Speed: " & .L2CacheSpeed & vbCrLf
strInfo = strInfo & "Power Management Supported: " & .PowerManagementSupported
End With
txtCpu.Text = strInfo
End Sub
Private Function AvailabilityToString(p_intCode As Integer) As String
Dim strReturn As String
'These return p_intCodes are based on WMI SDK Documentation
Select Case p_intCode
Case 1, 2
strReturn = "Unknown"
Case 3
strReturn = "Running/Full Power"
Case 4
strReturn = "Warning"
Case 5
strReturn = "In Test"
Case 6
strReturn = "Not Applicable"
Case 7
strReturn = "Power Off"
Case 8
strReturn = "Off Line"
Case 9
strReturn = "Off Duty"
Case 10
strReturn = "Degraded"
Case 11
strReturn = "Not Installed"
Case 12
strReturn = "Install Error"
Case 13
strReturn = "Power Save - Unknown"
Case 14
strReturn = "Power Save - Low Power Mode"
Case 15
strReturn = "Power Save - Standby"
Case 16
strReturn = "Power Cycle"
Case 17
strReturn = "Power Save - Warning"
Case Else
strReturn = "Unknown"
End Select
AvailabilityToString = strReturn
End Function
Reply With Quote
download page says W2K is required ... bummer 
