读取本机硬件信息的VBA代码

分类：计算机等级

|

更新时间：2016-07-08|

来源：转载

今天被朋友问到，如何在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　*　fromWin32_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　*　fromWin32_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－全国最大教育类网站(www．Examda。com)

End　Sub 来源:-计算机二级考试