Option ExplicitDim WithEvents Sink As SWbemSinkDim j As Integer'功能:利用wmi組件得到計算機的信息,每一個小功能分開寫，便于大家查閱 Private Sub cmdDone_Click()Dim oWMINameSpace As SWbemServicesDim oLogicalDiskSet As SWbemObjectSetDim oLogicalDisk As SWbemObject Dim ObjSet As VariantDim sDrive As StringDim sValue As StringDim dblSize As DoubleDim Obj As Variant Dim lIndex As Long Set oWMINameSpace = GetObject("winmgmts:") '得到驅動器的信息On Error Resume NextSet ObjSet = oWMINameSpace.InstancesOf("Win32_DiskDrive") For Each Obj In ObjSet List5.AddItem Obj.Caption & " - " & BytesToMegabytes(Obj.Size) & " GB"Next  '得到每一個驅動器的詳細信息On Error GoTo ErrorHandler'Set oWMINameSpace = GetObject("winmgmts:")Set oLogicalDiskSet = oWMINameSpace.InstancesOf("Win32_LogicalDisk")For Each oLogicalDisk In oLogicalDiskSet  On Error Resume Next   sDrive = oLogicalDisk.deviceid    ListView1.ListItems.Add , , sDrive  lIndex = ListView1.ListItems.Count    sValue = oLogicalDisk.Description & ""  ListView1.ListItems(lIndex).SubItems(1) = sValue   sValue = oLogicalDisk.FileSystem & ""  ListView1.ListItems(lIndex).SubItems(2) = sValue    sValue = oLogicalDisk.VolumeName & ""  ListView1.ListItems(lIndex).SubItems(3) = sValue    sValue = oLogicalDisk.VolumeSerialNumber & ""  ListView1.ListItems(lIndex).SubItems(4) = sValue    sValue = oLogicalDisk.Size & ""  If IsNumeric(sValue) ThendblSize = BytesToMegabytes(CDbl(sValue))sValue = CStr(dblSize) & " MB"  End If    ListView1.ListItems(lIndex).SubItems(5) = sValueNext    CleanUp:Set oLogicalDisk = NothingSet oLogicalDiskSet = NothingSet oWMINameSpace = NothingExit Sub ErrorHandler:MsgBox "" & Err.Description GoTo CleanUp End Sub Private Sub Command1_Click()Unload MeEnd Sub Private Function BytesToMegabytes(Bytes As Double) As Double Dim dblAns As Double dblAns = (Bytes / 1024) / 1024 BytesToMegabytes = Format(dblAns, "###,###,##0.00")End Function Private Sub Command2_Click()Dim oWMINameSpace As SWbemServicesDim SystemSet As VariantDim System As VariantDim ObjSet As VariantDim Obj As Variant  Set oWMINameSpace = GetObject("winmgmts:")'操作系統Set SystemSet = oWMINameSpace.InstancesOf("Win32_OperatingSystem") For Each System In SystemSet  List1.AddItem System.Caption  List1.AddItem System.Manufacturer  List1.AddItem System.BuildType & “” ‘Win9x下好像取不出來  List1.AddItem System.Version  List1.AddItem System.SerialNumberNext'cpuSet ObjSet = oWMINameSpace.InstancesOf("Win32_Processor") For Each Obj In ObjSet  List2.AddItem Obj.Caption  List2.AddItem Obj.currentclockspeed & " Mhz"Next End Sub Private Sub Command3_Click()Dim oWMINameSpace As SWbemServicesDim ObjSet As VariantDim Obj As VariantDim Adapter As Variant '內存Set oWMINameSpace = GetObject("winmgmts:")Set ObjSet = oWMINameSpace.InstancesOf("Win32_PhysicalMemory")Dim i As String For Each Obj In ObjSet  List3.AddItem BytesToMegabytes(Obj.capacity) & " MB" & " Chip"Next '網卡Set Sink = New SWbemSink  Set Adapter = GetObject("winmgmts:")Adapter.InstancesOfAsync Sink, "Win32_NetworkAdapter" End Sub Private Sub Form_Load()j = 0End Sub Private Sub Sink_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet) Dim Adapter As Variant‘得到所有的適配器信息Set Adapter = GetObject("winmgmts:Win32_NetworkAdapterConfiguration=" & j & "") List4.AddItem Adapter.Description If IsNull(Adapter.MACAddress) Then  List4.AddItem "No MAC Address"  List4.AddItem ""Else  List4.AddItem "Mac: " & Adapter.MACAddress  List4.AddItem ""End If j = j + 1End Sub