Private Sub Command1_Click()
  Dim V As Variant, I As Long
 
  ' CPU-Taktfrequenz
  MsgBox "CPU-Taktfrequenz: " & Format( _
    GetProcessorSpeed, "#,0") & " MHz"
 
  ' Physikalischer Speicher
  MsgBox "Physikalischer Speicher: " & Format( _
    GetPhysicalMemory / 1024 / 1024, "#,0") & " MB"
 
  ' Festplatten & Größe
  V = GetDiskDrives
  For I = LBound(V) To UBound(V)
    MsgBox "Festplatte " & CStr(I + 1) & ": " & Format(V( _
      I) / 1024 / 1024 / 1024, "#") & " GB"
  Next I
 
  ' Soundkarten
  V = GetSoundDevices
  For I = LBound(V) To UBound(V)
    MsgBox "Soundkarte " & CStr(I + 1) & ": " & V(I)
  Next I
 
  ' Grafikkarten
  V = GetVideoDevices
  For I = LBound(V) To UBound(V)
    MsgBox "Grafikkarte " & CStr(I + 1) & ": " & V(I)
  Next I
 
  ' BIOS-Versionsnummer
  MsgBox "BIOS-Versionsnummer: " & GetBIOSVersion
 
End Sub
 
 
' ermittelt die Daten aus WMI
Public Function ReadWMIData(ByVal sField As String, _
  ByVal sTable As String) As Variant
  On Error Resume Next
 
  Dim objWMI As Object
  Dim objQuery As Object
  Dim objProperty As Object
  Dim objItem As Object
  Dim V As Variant
  Dim S As String
 
  S = ""
  Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
  Set objQuery = objWMI.ExecQuery( _
    "Select " & sField & " from " & sTable)
 
  If Not objQuery Is Nothing Then
 
    For Each objProperty In objQuery
 
      If Not objProperty Is Nothing Then
 
        For Each objItem In objProperty.Properties_
 
          If Not objItem Is Nothing Then
            If (objItem.Name = sField) And (IsArray( _
              objItem.Value) = False) And (IsNull(objItem.Value) = False) Then
              If S <> "" Then S = S & "|"
              S = S & Trim(CStr(objItem.Value))
            End If
          End If
 
        Next objItem
 
      End If
 
    Next objProperty
 
  End If
 
  Set objItem = Nothing
  Set objProperty = Nothing
  Set objQuery = Nothing
  Set objWMI = Nothing
 
  V = Split(S, "|")
  ReadWMIData = V
End Function
 
Public Function GetProcessorSpeed() As Long
  On Error Resume Next
 
  Dim V As Variant
 
  V = ReadWMIData("CurrentClockSpeed", "Win32_Processor")
 
  If LBound(V) < 0 Then
    GetProcessorSpeed = -1
  Else
    GetProcessorSpeed = CLng(V(0))
  End If
End Function
 
Public Function GetPhysicalMemory() As Long
  On Error Resume Next
 
  Dim V As Variant, I As Long, G As Long
 
  V = ReadWMIData("Capacity", "Win32_PhysicalMemory")
 
  If LBound(V) < 0 Then
    GetPhysicalMemory = -1
  Else
    G = 0
    For I = LBound(V) To UBound(V)
       G = G + CLng(V(I))
    Next I
    GetPhysicalMemory = G
  End If
End Function
 
Public Function GetDiskDrives() As Variant
  On Error Resume Next
 
  GetDiskDrives = ReadWMIData("Size", "Win32_DiskDrive")
 
End Function
 
Public Function GetSoundDevices() As Variant
  On Error Resume Next
 
  GetSoundDevices = ReadWMIData("Description", "Win32_SoundDevice")
 
End Function
 
Public Function GetVideoDevices() As Variant
  On Error Resume Next
 
  GetVideoDevices = ReadWMIData("AdapterDescription", _
    "Win32_VideoConfiguration")
 
End Function
 
Public Function GetBIOSVersion() As String
  On Error Resume Next
 
  Dim V As Variant
 
  V = ReadWMIData("Version", "Win32_BIOS")
 
  If LBound(V) < 0 Then
    GetBIOSVersion = ""
  Else
    GetBIOSVersion = V(0)
  End If
End Function

Viel Spass,
R@lf