读取本机硬件信息的VBA代码
2009-06-02 19:32
295 查看
今天被朋友问到,如何在VB或者VBA代码中读取诸如硬盘或者CPU等硬件设备的序列号这一类信息。我写了一个范例如下
1. 在我的机器上运行的效果。我这个例子读取了四部分信息(CPU,物理硬盘,逻辑磁盘,网卡)
2.代码如下。代码的原理是使用WMI接口。需要管理员权限才能执行该代码
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0
'''这个范例程序是读取CPU,物理硬盘,逻辑磁盘,和网卡的有关序列号的
'''作者:陈希章
'''时间:2009年6月2日
Sub Test()
Dim len5 As Long, aa As Long
Dim cmprName As String
Dim osver As OSVERSIONINFO
'取得Computer Name
cmprName = String(255, 0)
len5 = 256
aa = GetComputerName(cmprName, len5)
cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1)
Computer = cmprName '取得CPU端口号
ActiveCell.Worksheet.Cells.Clear
Dim rng As Range
Set rng = Range("B7")
rng.Font.Bold = True
rng.Value = "CPU"
Set rng = rng.Offset(1)
Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_Processor")
For Each mycpu In CPUs
rng.Value = mycpu.processorid
Set rng = rng.Offset(1)
Next rng.Value = "Hard Disk"
rng.Offset(, 1).Value = "Media Type"
rng.Resize(, 2).Font.Bold = True
Set rng = rng.Offset(1) Set disks = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_DiskDrive")
For Each disk In disks
rng.Value = disk.pnpdeviceid
rng.Offset(, 1).Value = disk.mediatype
Set rng = rng.Offset(1)
Next
Set hds = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_LogicalDisk")
rng.Value = "Logic Disk Caption"
rng.Offset(, 1).Value = "VolumeSerialNumber"
rng.Resize(, 2).Font.Bold = True
Set rng = rng.Offset(1)
For Each hd In hds
rng.Value = hd.Caption
rng.Offset(, 1).Value = hd.VolumeSerialNumber
Set rng = rng.Offset(1)
Next
Set networks = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_NetworkAdapter")
rng.Value = "Caption"
rng.Offset(, 1).Value = "MAC Address"
rng.Offset(, 2).Value = "PNPDeviceID" rng.Resize(, 3).Font.Bold = True
Set rng = rng.Offset(1)
For Each network In networks
rng.Value = network.Caption
rng.Offset(, 1).Value = network.macaddress
rng.Offset(, 2).Value = network.pnpdeviceid
Set rng = rng.Offset(1)
Next
End Sub
1. 在我的机器上运行的效果。我这个例子读取了四部分信息(CPU,物理硬盘,逻辑磁盘,网卡)
2.代码如下。代码的原理是使用WMI接口。需要管理员权限才能执行该代码
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0
'''这个范例程序是读取CPU,物理硬盘,逻辑磁盘,和网卡的有关序列号的
'''作者:陈希章
'''时间:2009年6月2日
Sub Test()
Dim len5 As Long, aa As Long
Dim cmprName As String
Dim osver As OSVERSIONINFO
'取得Computer Name
cmprName = String(255, 0)
len5 = 256
aa = GetComputerName(cmprName, len5)
cmprName = Left(cmprName, InStr(1, cmprName, Chr(0)) - 1)
Computer = cmprName '取得CPU端口号
ActiveCell.Worksheet.Cells.Clear
Dim rng As Range
Set rng = Range("B7")
rng.Font.Bold = True
rng.Value = "CPU"
Set rng = rng.Offset(1)
Set CPUs = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_Processor")
For Each mycpu In CPUs
rng.Value = mycpu.processorid
Set rng = rng.Offset(1)
Next rng.Value = "Hard Disk"
rng.Offset(, 1).Value = "Media Type"
rng.Resize(, 2).Font.Bold = True
Set rng = rng.Offset(1) Set disks = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_DiskDrive")
For Each disk In disks
rng.Value = disk.pnpdeviceid
rng.Offset(, 1).Value = disk.mediatype
Set rng = rng.Offset(1)
Next
Set hds = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_LogicalDisk")
rng.Value = "Logic Disk Caption"
rng.Offset(, 1).Value = "VolumeSerialNumber"
rng.Resize(, 2).Font.Bold = True
Set rng = rng.Offset(1)
For Each hd In hds
rng.Value = hd.Caption
rng.Offset(, 1).Value = hd.VolumeSerialNumber
Set rng = rng.Offset(1)
Next
Set networks = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Computer & "\root\cimv2").ExecQuery("select * from Win32_NetworkAdapter")
rng.Value = "Caption"
rng.Offset(, 1).Value = "MAC Address"
rng.Offset(, 2).Value = "PNPDeviceID" rng.Resize(, 3).Font.Bold = True
Set rng = rng.Offset(1)
For Each network In networks
rng.Value = network.Caption
rng.Offset(, 1).Value = network.macaddress
rng.Offset(, 2).Value = network.pnpdeviceid
Set rng = rng.Offset(1)
Next
End Sub
相关文章推荐
- 读取本机硬件信息的VBA代码
- [转].net读取硬件信息的参考代码
- windows平台下,c++获取cpu型号,读取注册表获取系统软硬件信息代码
- JavaScript 读取元素的CSS信息的代码
- python读取读取配置文件信息操作代码
- 显卡由于其配置信息(注册表中的)不完整或已损坏,Windows 无法启动这个硬件设备。 (代码 19)
- 读取数据库信息构建视图字段的备注信息,方便程序代码生成
- Java Socket通信读取相关信息代码
- Java Socket通信读取相关信息代码
- samba unix风格的配置文件配置信息读取C代码.
- Excel读取某一列的宏代码VBA代码源码及解说(详尽版)
- C# 收集机器硬件信息的相关代码片断(cpu频率、磁盘可用空间、内存容量……)
- 获取计算机硬件信息的VB.NET代码范例
- android 读取手机硬件信息,我这里只读出SMEI码
- C# 读取硬件相关内容信息
- 读取JPG图片的Exif属性(三) - Exif属性读取GPS信息代码(C/C++实现)
- NET 2.0 调用FFMPEG,并异步读取输出信息的代码
- ASP.NET中读取XML文件信息的4种方法与示例代码
- ASP.NET中读取XML文件信息的4种方法与示例代码
- usb由于其配置信息(注册表中的)不完整或已损坏,Windows 无法启动这个硬件设备(代码 19 )