[原创]如何用vba获取硬件序列号(如cpu的序列号),谢谢!

fan0217

获取CPU信息

Type CPUInfo
    AddressWidth  As String
    Architecture  As String
    Availability  As String
    Caption  As String
    ConfigManagerErrorCode  As String
    ConfigManagerUserConfig  As String
    CpuStatus  As String
    CreationClassName  As String
    CurrentClockSpeed  As String
    CurrentVoltage  As String
    DataWidth  As String
    Description  As String
    DeviceID  As String
    ErrorCleared  As String
    ErrorDescription  As String
    ExtClock  As String
    Family  As String
    InstallDate  As String
    L2CacheSize  As String
    L2CacheSpeed  As String
    LastErrorCode  As String
    Level  As String
    LoadPercentage  As String
    Manufacturer  As String
    MaxClockSpeed  As String
    Name  As String
    OtherFamilyDescription  As String
    PNPDeviceID  As String
    PowerManagementCapabilities  As String
    PowerManagementSupported  As String
    ProcessorId  As String
    ProcessorType  As String
    Revision  As String
    Role  As String
    SocketDesignation  As String
    Status  As String
    StatusInfo  As String
    Stepping  As String
    SystemCreationClassName  As String
    SystemName  As String
    UniqueId  As String
    UpgradeMethod  As String
    Version  As String
    VoltageCaps  As String
End Type

'===============================================================================
'-函数名称:     GetCPUInfo
'-功能描述:     获取CPU信息
'-输入参数说明:
'-返回参数说明: 返回CPU的一系列信息
'-使用语法示例: Msgbox GetCPUInfo.Caption
'-参考:
'-使用注意:     使用本函数时请保留函数信息内容
'-兼容性:       2000,XP,2003
'-作者:         fan0217@163.com
'-更新日期：    2006-05-20
'===============================================================================
Function GetCPUInfo() As CPUInfo
On Error Resume Next
Dim objWMIService As Object
Dim objItem As Object
Dim colItems As Object

Set objWMIService = GetObject("winmgmts://.oot/cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48)

For Each objItem In colItems
    With GetCPUInfo
        .AddressWidth = objItem.AddressWidth
        .Architecture = objItem.Architecture
        .Availability = objItem.Availability
        .Caption = objItem.Caption
        .ConfigManagerErrorCode = objItem.ConfigManagerErrorCode
        .ConfigManagerUserConfig = objItem.ConfigManagerUserConfig
        .CpuStatus = objItem.CpuStatus
        .CreationClassName = objItem.CreationClassName
        .CurrentClockSpeed = objItem.CurrentClockSpeed
        .CurrentVoltage = objItem.CurrentVoltage
        .DataWidth = objItem.DataWidth
        .Description = objItem.Description
        .DeviceID = objItem.DeviceID
        .ErrorCleared = objItem.ErrorCleared
        .ErrorDescription = objItem.ErrorDescription
        .ExtClock = objItem.ExtClock
        .Family = objItem.Family
        .InstallDate = objItem.InstallDate
        .L2CacheSize = objItem.L2CacheSize
        .L2CacheSpeed = objItem.L2CacheSpeed
        .LastErrorCode = objItem.LastErrorCode
        .Level = objItem.Level
        .LoadPercentage = objItem.LoadPercentage
        .Manufacturer = objItem.Manufacturer
        .MaxClockSpeed = objItem.MaxClockSpeed
        .Name = objItem.Name
        .OtherFamilyDescription = objItem.OtherFamilyDescription
        .PNPDeviceID = objItem.PNPDeviceID
        .PowerManagementCapabilities = objItem.PowerManagementCapabilities
        .PowerManagementSupported = objItem.PowerManagementSupported
        .ProcessorId = objItem.ProcessorId
        .ProcessorType = objItem.ProcessorType
        .Revision = objItem.Revision
        .Role = objItem.Role
        .SocketDesignation = objItem.SocketDesign

fan0217

转贴：VBA/VB获取硬盘序列号

Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA"     (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize  As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags  As Long, ByVal lpFileSystemNameBuffer As String,  ByVal nFileSystemNameSize As Long) As Long
Function GetSerialNumber(sRoot As String) As Long
    Dim lSerialNum As Long
    Dim R As Long
    Dim sTemp1 As String, sTemp2 As String
    strLabel = String$(255, Chr$(0))    '磁盘卷标
    strType = String$(255, Chr$(0))    '文件系统类型 一般为 FAT
    R = GetVolumeInformation(sRoot, strLabel, Len(strLabel), lSerialNum, 0, 0, strType, Len(strType))
    GetSerialNumber = lSerialNum
End Function