求助：用VBA获取系统的硬件信息

halfzx

用网上提供的第三方软件可以获取电脑的硬件信息,如果用VBA编一个这方面的程序该如何实现呢?

如提取主板的编号、硬盘的ID号、CPU的编号、内存的编号等等。

因为在网络环境下操作，运行后就可以收集当前工作组中所有电脑的信息。请各位大侠相助。

ccwan

xiuzhengyixiawodehua

[此贴子已经被作者于2007-4-24 16:06:00编辑过]

agstick

使用WMI得到计算机的信息

WMI是一项行业推荐规范，旨在为访问企业环境中的管理信息而开发一种标准化技术。该信息包括系统内存的状态、当前安装的客户应用程序清单，以及有关客户端状态的其他数据。

WMI是可伸缩的系统管理结构，该规范采用一个统一、基于标准且可扩展的面向对象接口。它提供与系统管理员信息和基础WMI API交互的标准方法，主要由系统管理应用程序开发人员和系统管理员用来访问和操作系统管理信息。

WMI可用来生成组织和管理系统信息的工具，使系统管理人员能够更密切的监视系统活动。

WMI提供了一套内置在Microsoft Windows操作系统中的丰富的系统管理服务，现在有大量的应用程序、服务和设备用其为信息技术操作和产品支持组织提供全方位的管理功能。基于WMI的管理系统的使用带来了更可靠的计算环境和更高的系统可靠性，从而节省了企业的开销。

WMI提供的大量的规范为许多高端应用程序，例如Microsoft Exchange、Microsoft SQL Server和Microsoft Internet信息服务(IIS)等实现如下管理任务。

1． 监视应用程序的运行情况

2．  检测瓶颈或故障

3．  管理和配置应用程序

4．  查询应用程序数据(使用对象关系的遍历和查询)

5．  执行无缝的本地或远程管理操作

 

下面我们通过一个例子来说明WMI的强大功能。以vb6为列：

引用”Microsoft WMI Scripting V1.1 Library”

代码如下:

Option Explicit

Dim WithEvents Sink As SWbemSink

Dim j As Integer

'功能:利用wmi组件得到计算机的信息,每一个小功能分开写，便于大家查阅

 

Private Sub cmdDone_Click()

Dim oWMINameSpace As SWbemServices

Dim oLogicalDiskSet As SWbemObjectSet

Dim oLogicalDisk As SWbemObject

 

Dim ObjSet As Variant

Dim sDrive As String

Dim sValue As String

Dim dblSize As Double

Dim Obj As Variant

 

Dim lIndex As Long

 

Set oWMINameSpace = GetObject("winmgmts:")

 

'得到驱动器的信息

On Error Resume Next

Set 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) Then

        dblSize = BytesToMegabytes(CDbl(sValue))

        sValue = CStr(dblSize) & " MB"

    End If

   

    ListView1.ListItems(lIndex).SubItems(5) = sValue

Next

   

 

 

CleanUp:

Set oLogicalDisk = Nothing

Set oLogicalDiskSet = Nothing

Set oWMINameSpace = Nothing

Exit Sub

 

ErrorHandler:

MsgBox "" & Err.Description

 

GoTo CleanUp

 

End Sub

 

Private Sub Command1_Click()

Unload Me

End 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 SWbemServices

Dim SystemSet As Variant

Dim System As Variant

Dim ObjSet As Variant

Dim 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.SerialNumber

Next

'cpu

Set 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 SWbemServices

Dim ObjSet As Variant

Dim Obj As Variant

Dim 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 = 0

End 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 + 1

End Sub

halfzx

3楼的感谢先,但与我的要求有些距离.其他朋友再帮我看看

agstick

WMI功能强大的很那，好好看看这篇贴子吧。

http://club.excelhome.net/viewthread.php?tid=212774&px=0

halfzx

烟酒一下,3Q

news30

收藏了，这个很不错~谢谢