| SWbemServices, SWbemObjectSet |
| |
| |
| Ab WinNT/95/98, wenn WMI installiert ist | |
| |
 | Private m_objWMINameSpace As SWbemServices | | |
| Private m_objCPUSet As SWbemObjectSet | |
| Private asCpuPaths() As String | |
| |
| Private Sub cmdActual_Click() | |
| Call auswertung | |
| End Sub | |
| |
| Private Sub Form_Load() | |
| Call auswertung | |
| End Sub | |
| |
| Private Sub auswertung() | |
| Dim oCpu As SWbemObject, sPath$, sCaption$, lElement As Long |
| ReDim asCpuPaths(0) As String | |
| On Error GoTo ErrorHandler | |
| Set m_objWMINameSpace = GetObject("winmgmts:") | Name des PCs. |
| lstCPU.Clear | |
| |
| Set m_objCPUSet = m_objWMINameSpace.InstancesOf("Win32_Processor") |
| sCaption = m_objCPUSet.Count & " Prozessor" |
| If m_objCPUSet.Count <> 1 Then sCaption = sCaption & "en" |
| sCaption = sCaption & " auf diesem PC" | |
| lblTitle.Caption = sCaption | |
| |
| For Each oCpu In m_objCPUSet | ListBox mit CPU-Namen aufbauen. |
| With oCpu | |
| sPath = .Path_ & "" | |
| If sPath <> "" Then | |
| lstCPU.AddItem .Name | Array für die ListBox (bei PCs mit mehreren CPUs). |
| lElement = IIf(asCpuPaths(0) = "", 0, UBound(asCpuPaths) + 1) |
| ReDim Preserve asCpuPaths(lElement) As String |
| asCpuPaths(lElement) = sPath | |
| End If | |
| End With | |
| Next | |
| If lstCPU.ListCount <> 0 Then lstCPU.ListIndex = 0 | |
| |
| CleanUp: | |
| Set oCpu = Nothing | |
| Exit Sub | |
| |
| ErrorHandler: | |
| MsgBox "CPU-Informationen nicht abrufbar wegen Fehler: " _ | |
| & Err.Description, , "Fehler" | |
| GoTo CleanUp | |
| End Sub | |
| |
| Private Sub Form_Unload(Cancel As Integer) | |
| Set m_objCPUSet = Nothing | |
| Set m_objWMINameSpace = Nothing | |
| End Sub | |
| |
| Private Sub lstCPU_Click() | |
| Dim oCpu As SWbemObject, sInfoString As String | |
| On Error Resume Next | |
| Set oCpu = m_objCPUSet(asCpuPaths(lstCPU.ListIndex)) | |
| With oCpu | Werte in ListBox ausgeben. |
| sInfoString = "Beschreibung: " & .Description & vbCrLf |
| sInfoString = sInfoString & "Processor ID: " & .ProcessorID & vbCrLf |
| sInfoString = sInfoString & "Status: " & .Status & vbCrLf |
| sInfoString = sInfoString & "Hersteller: " & .Manufacturer & vbCrLf |
| sInfoString = sInfoString & "Gültigkeit: " & AvailabilityToString(.Availability) & vbCrLf |
| sInfoString = sInfoString & "Belastung %: " & .LoadPercentage & vbCrLf |
| sInfoString = sInfoString & "Aktuelle Taktfrequenz: " & .CurrentClockSpeed & " MHz" & vbCrLf |
| sInfoString = sInfoString & "Maximale Taktfrequenz: " & .MaxClockSpeed & " MHz" & vbCrLf |
| sInfoString = sInfoString & "Level 2 Cache Size: " & .L2CacheSize & " MB" & vbCrLf |
| sInfoString = sInfoString & "Level 2 Cache Speed: " & .L2CacheSpeed & vbCrLf |
| sInfoString = sInfoString & "Power Management Supported: " & .PowerManagementSupported |
| End With | |
| txtCpu.Text = sInfoString | |
| End Sub | |
| |
| Private Function AvailabilityToString(Code As Integer) As String |
| Dim sAns As String | |
| Select Case Code | Fehler abfangen. |
| Case 1, 2 | |
| sAns = "Unbekannt" | |
| Case 3 | |
| sAns = "Running/Full Power" | |
| Case 4 | |
| sAns = "Warnung" | |
| Case 5 | |
| sAns = "Im Test" | |
| Case 6 | |
| sAns = "Nicht anwendbar" | |
| Case 7 | |
| sAns = "Power Off" | |
| Case 8 | |
| sAns = "Off Line" | |
| Case 9 | |
| sAns = "Off Duty" | |
| Case 10 | |
| sAns = "Degraded" | |
| Case 11 | |
| sAns = "Nicht installiert" | |
| Case 12 | |
| sAns = "Installationsfehler" | |
| Case 13 | |
| sAns = "Power Save - Unbekannt" | |
| Case 14 | |
| sAns = "Power Save - Low Power Mode" | |
| Case 15 | |
| sAns = "Power Save - Standby" | |
| Case 16 | |
| sAns = "Power Cycle" | |
| Case 17 | |
| sAns = "Power Save - Warnung" | |
| Case Else | |
| sAns = "Unbekannt" | |
| End Select | |
| AvailabilityToString = sAns | |
| End Function | |
| |
| Private Sub cmdEnde_Click() | |
| Unload Me | |
| End Sub | |
| |
zurück