Office中国论坛/Access中国论坛

标题: [原创]如何用vba获取硬件序列号(如cpu的序列号),谢谢! [打印本页]

作者: dfmz_fd 时间: 2006-3-14 19:41
标题: [原创]如何用vba获取硬件序列号(如cpu的序列号),谢谢!
如何用vba获取硬件序列号(如cpu的序列号),谢谢!

作者: df 时间: 2006-3-14 20:21
[attach]16385[/attach]
cpu,网卡,硬件序列号

作者: dfmz_fd 时间: 2006-3-14 21:25
xiexie

作者: dfmz_fd 时间: 2006-3-14 21:33
标题: df,获取cpu的方法没有啊，只有网卡的，？谢谢
df,获取cpu的方法没有啊？谢谢

作者: nmgzhyf 时间: 2006-6-12 18:28
谢谢

作者: nmgzhyf 时间: 2006-6-12 18:28
找了好久了

作者: nmgzhyf 时间: 2006-6-12 18:29
终于找见了，非常感谢

作者: seeking 时间: 2006-6-20 01:28
标题: 没用
错误：找不到文件 getcpuid

网卡序列号不知道是不是物理地址，如果是物理地址有更简单的方法：

'获取IP地址
Private Function GetIP_MAC()
Dim strComputer As String
Dim objWMI As Object
Dim colIP As Object
Dim IP As Object
Dim i As Integer
Dim str As String
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colIP = objWMI.ExecQuery _
      ("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IP In colIP
      If Not IsNull(IP.IPAddress) Then
         For i = LBound(IP.IPAddress) To UBound(IP.IPAddress)
               str = str + IP.IPAddress(i) + "; " + IP.MACAddress(i) + ";"
         Next
      End If
Next
GetIP_MAC = str
End Function
所有的ip及物理地址都取出来了。

作者: fan0217 时间: 2006-6-20 03:15
获取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 时间: 2006-6-20 06:01

转贴：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

作者: simon_lm 时间: 2006-8-4 18:55
等待.....

作者: simon_lm 时间: 2006-8-4 18:59
等待.....

作者: leonsu 时间: 2006-8-4 19:07
顶~~~~~~~~~

作者: simon_lm 时间: 2006-8-4 19:07
...

作者: leonsu 时间: 2006-8-4 19:07
再顶~~~~~~~~~~~~~

作者: leonsu 时间: 2006-8-4 19:07
继续顶~~~~~~~~~~

作者: boy_2005 时间: 2006-8-8 02:35
good !!! thanks !!!

作者: hhyyt 时间: 2006-10-16 01:11
支持一下，不错的

作者: xvdongszhp 时间: 2006-11-12 18:58
太感谢了

作者: nature876 时间: 2011-10-24 10:25
下来看看

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)