VB6获取电脑硬件信息
VB6通过WIMI获取电脑硬件信息，可以查看电脑硬件配置信息。
看效果
上代码
'获取系统信息
Private Function getSysInfo()
Dim Info, System, item
Set System = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
For Each item In System
Info = "计算机名称: " & item.Name & vbCrLf
Info = Info & "状态: " & item.Status & vbCrLf
Info = Info & "类型: " & item.SystemType & vbCrLf
Info = Info & "生产厂家: " & item.Manufacturer & vbCrLf
Info = Info & "型号: " & item.Model & vbCrLf
'info = info & "内存: ~" & item.totalPhysicalMemory \ 1024000 & "MB" & vbCrLf
Info = Info & "域: " & item.domain & vbCrLf
Info = Info & "工作组" & item.Workgroup & vbCrLf '获得工作组和域的选项不能同时用
Info = Info & "当前用户: " & item.username & vbCrLf
Info = Info & "启动状态" & item.BootupState & vbCrLf
Info = Info & "该计算机属于" & item.PrimaryOwnerName & vbCrLf
Info = Info & "系统类型" & item.CreationClassName & vbCrLf
Info = Info & "计算机类类型" & item.Description & vbCrLf
Next
getSysInfo = Info
End Function
'获取硬件信息
Public Function getPCInfo()
On Error Resume Next
Dim Info
Set wshshell = CreateObject("wscript.shell")
wshshell.run ("%comspec% /c net start winmgmt"), 0 '启动服务
Set WshNetwork = CreateObject("WScript.Network")
computername = WshNetwork.computername
Info = "计算机名：" & computername & vbCrLf & vbCrLf
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
'主板
Set board = objWMIService.ExecQuery("select * from win32_baseboard")
For Each item In board
board2 = board2 & item.Product & vbCrLf
Next
Info = Info & "主板：" & vbCrLf & board2 & vbCrLf
'CPU
Set cpu = objWMIService.ExecQuery("select * from win32_processor")
For Each item In cpu
cpu2 = cpu2 & item.Name & vbCrLf
Next
Info = Info & "CPU：" & vbCrLf & cpu2 & vbCrLf
'内存
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory", , 48)
Dim memory1
For Each objItem In colItems
a = objItem.capacity / 1048576
temp = temp + Val(objItem.capacity)
If InStr(memory1, "1条" & a & "M") <> 0 Then
memory1 = Replace(memory1, "1条" & a & "M", "2条" & a & "M")
ElseIf InStr(memory1, "2条" & a & "M") <> 0 Then
memory1 = Replace(memory1, "2条" & a & "M", "3条" & a & "M")
ElseIf InStr(memory1, "3条" & a & "M") <> 0 Then
memory1 = Replace(memory1, "3条" & a & "M", "4条" & a & "M")
Else
memory1 = memory1 & "1条" & a & "M"
End If
n = n + 1
Next
memory = temp / 1048576
If n = 1 Then
memory2 = memory1
Else
memory2 = memory1 & " 总计" & memory & "M"
End If
Info = Info & "内存：" & vbCrLf & memory2 & vbCrLf & vbCrLf
'硬盘
Set disk = objWMIService.ExecQuery("select * from win32_diskdrive")
For Each item In disk
disk2 = disk2 & item.Model & vbCrLf
Next
Info = Info & "硬盘：" & vbCrLf & disk2 & vbCrLf
'显卡
Set video = objWMIService.ExecQuery("select * from win32_videocontroller", , 48)
For Each item In video
video2 = video2 & item.Description & vbCrLf
Next
Info = Info & "显卡：" & vbCrLf & video2 & vbCrLf
'网卡
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter", , 48)
For Each objItem In colItems
lan2 = lan2 & objItem.Name & vbCrLf
Next
Info = Info & "网卡：" & vbCrLf & lan2 & vbCrLf
getPCInfo = Info
End Function
'获取CPU信息
Private Function getCPUInfo()
Dim CPUs()
n = 0
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48)
For Each objItem In colItems
ReDim Preserve CPUs(n)
CPUs(n) = "CPU信息如下：" & vbCrLf
CPUs(n) = CPUs(n) & "处理器位数: " & objItem.AddressWidth & "位" & vbCrLf
If objItem.Architecture = 0 Then
CPUs(n) = CPUs(n) & "平台的处理器的设计:X86 " & vbCrLf
ElseIf objItem.Architecture = 1 Then
CPUs(n) = CPUs(n) & "平台的处理器的设计:MIPS " & vbCrLf
ElseIf objItem.Architecture = 2 Then
CPUs(n) = CPUs(n) & "平台的处理器的设计:Alpha " & vbCrLf
ElseIf objItem.Architecture = 3 Then
CPUs(n) = CPUs(n) & "平台的处理器的设计:PowerPC " & vbCrLf
Else
CPUs(n) = CPUs(n) & "平台的处理器的设计:ia64 " & vbCrLf
End If
CPUs(n) = CPUs(n) & "用性和状态: " & runState(objItem.Availability) & vbCrLf
CPUs(n) = CPUs(n) & "标签: " & objItem.Caption & vbCrLf
CPUs(n) = CPUs(n) & "管理程序错误编码: " & objItem.ConfigManagerErrorCode & vbCrLf
CPUs(n) = CPUs(n) & "是否使用用户定义的配置: " & objItem.ConfigManagerUserConfig & vbCrLf
CPUs(n) = CPUs(n) & "处理器的当前状态: " & objItem.CpuStatus & vbCrLf
CPUs(n) = CPUs(n) & "创建范例类别的名称: " & objItem.CreationClassName & vbCrLf
CPUs(n) = CPUs(n) & "当前速度: " & objItem.CurrentClockSpeed & "HZ" & vbCrLf
CPUs(n) = CPUs(n) & "处理器的电压: " & objItem.CurrentVoltage & "V" & vbCrLf
CPUs(n) = CPUs(n) & "处理器数据宽度: " & objItem.DataWidth & "位" & vbCrLf
CPUs(n) = CPUs(n) & "描述: " & objItem.Description & vbCrLf
CPUs(n) = CPUs(n) & "DeviceID: " & objItem.DeviceID & vbCrLf
CPUs(n) = CPUs(n) & "错误是否已经清除: " & objItem.ErrorCleared & vbCrLf
CPUs(n) = CPUs(n) & "错误描述: " & objItem.ErrorDescription & vbCrLf
CPUs(n) = CPUs(n) & "外部时钟频率: " & objItem.ExtClock & vbCrLf
CPUs(n) = CPUs(n) & "处理器系列类型: " & objItem.Family & vbCrLf
CPUs(n) = CPUs(n) & "安装日期: " & objItem.InstallDate & vbCrLf
CPUs(n) = CPUs(n) & "2 级高速缓存的大小: " & objItem.L2CacheSize & vbCrLf
CPUs(n) = CPUs(n) & "2 级高速缓存的速度: " & objItem.L2CacheSpeed & vbCrLf
CPUs(n) = CPUs(n) & "最后一次出错代码: " & objItem.LastErrorCode & vbCrLf
CPUs(n) = CPUs(n) & "处理器类型.Level: " & objItem.Level & vbCrLf
CPUs(n) = CPUs(n) & "处理器在最后一秒钟内的负载能量: " & objItem.LoadPercentage & vbCrLf
CPUs(n) = CPUs(n) & "制造商: " & objItem.Manufacturer & vbCrLf
CPUs(n) = CPUs(n) & "最大时钟频率: " & objItem.MaxClockSpeed & vbCrLf
CPUs(n) = CPUs(n) & "名称: " & objItem.Name & vbCrLf
CPUs(n) = CPUs(n) & "内核总数: " & objItem.NumberOfCores & vbCrLf
CPUs(n) = CPUs(n) & "逻辑处理器数: " & objItem.NumberOfLogicalProcessors & vbCrLf
CPUs(n) = CPUs(n) & "其他描述: " & objItem.OtherFamilyDescription & vbCrLf
CPUs(n) = CPUs(n) & "逻辑设备的 Win32 即插即用设备 ID: " & objItem.PNPDeviceID & vbCrLf
CPUs(n) = CPUs(n) & "电源的功能: " & objItem.PowerManagementCapabilities & vbCrLf
CPUs(n) = CPUs(n) & "PowerManagementSupported: " & objItem.PowerManagementSupported & vbCrLf
CPUs(n) = CPUs(n) & "ProcessorId: " & objItem.ProcessorId & vbCrLf
CPUs(n) = CPUs(n) & "ProcessorType: " & objItem.ProcessorType & vbCrLf
CPUs(n) = CPUs(n) & "版本: " & objItem.Revision & vbCrLf
CPUs(n) = CPUs(n) & "Role: " & objItem.Role & vbCrLf
CPUs(n) = CPUs(n) & "芯片插槽种类: " & objItem.SocketDesignation & vbCrLf
CPUs(n) = CPUs(n) & "状态: " & objItem.Status & vbCrLf
CPUs(n) = CPUs(n) & "StatusInfo: " & objItem.StatusInfo & vbCrLf
CPUs(n) = CPUs(n) & "修改等级: " & objItem.Stepping & vbCrLf
CPUs(n) = CPUs(n) & "作用系统的创建类名: " & objItem.SystemCreationClassName & vbCrLf
CPUs(n) = CPUs(n) & "系统名: " & objItem.SystemName & vbCrLf
CPUs(n) = CPUs(n) & "UniqueId: " & objItem.UniqueId & vbCrLf
CPUs(n) = CPUs(n) & "CPU 插座信息: " & objItem.UpgradeMethod & vbCrLf
CPUs(n) = CPUs(n) & "修订版号: " & objItem.Version & vbCrLf
CPUs(n) = CPUs(n) & "处理器的电压能量: " & objItem.VoltageCaps & vbCrLf
n = n + 1
Next
Dim str
str = ""
For i = 0 To n - 1
str = str & CPUs(i)
Next
getCPUInfo = str
End Function
Function runState(a)
Select Case a
Case 3
runState = "设备正在运行并且拥有全部能量"
Case 4
runState = "警告！"
Case 5
runState = "测试"
Case 10
runState = "降低"
Case 13
runState = "节能.未知：设备处于节能模式，但是该设备在这个模式中的准确状态未知"
Case 14
runState = "节能.降低：设备处于节能模式，但是仍旧运行并且反映出降低的功能"
Case 15
runState = "待机：设备没有在运行，但是可以“快速”进入全能状态"
Case 17
runState = "节能。警告：设备虽然处于警告状态，但是还处于节能状态"
Case Else
runState = "未知"
End Select
End Function
Private Sub Command1_Click()
Text1.Text = getSysInfo()
Text2.Text = getPCInfo()
Text3.Text = getCPUInfo()
End Sub
