1 'gethardwareinformation
2 On Error Resume Next
3 Dim WMI,WS,Fso
4 Set WMI = GetObject("Winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
5 Set cOSs = WMI.ExecQuery("Select * from Win32_OperatingSystem")
6 For Each oOS in cOSs
7 OSx = oOS.Caption & " " &oOS.CSDVersion & " " &oOS.Version & " (" & oOS.OSArchitecture &")" & vbCrLf
8 If CStr(Err.Number) <> 0 Then OSx = oOS.Caption & " " &oOS.CSDVersion & " " &oOS.Version & vbCrLf
9 Next
10 BBx= "————————————主板信息————————————" & vbCrLf
11 Set Board = WMI.InstancesOf("Win32_BaseBoard")
12 Set Bios = WMI.InstancesOf("Win32_Bios")
13 For Each oBoard In Board
14 BBx = BBx _
15 & "主板名称: " & oBoard.Product &vbTab & oBoard.Version & vbCrLf _
16 & "制造厂商: " & oBoard.Manufacturer & vbCrLf
17 Next
18 For Each oBios In Bios
19 BBx = BBx _
20 & "BIOS厂商: " & oBios.Manufacturer & vbCrLf _
21 & "BIOS日期: " & FormatDateTime(wDate(Trim(oBios.ReleaseDate)),1) & vbCrLf _
22 & "BIOS版本: " & oBios.SMBIOSBIOSVersion & vbCrLf _
23 & "OEM 版本: " & oBios.Version & vbCrLf
24 Next
25 Set Bios = Nothing:Set Board = Nothing
26
27 CPUx = "———————————处理器信息———————————" & vbCrLf
28 Set CPUs = WMI.InstancesOf("Win32_Processor")
29 Set Caches = WMI.InstancesOf("Win32_CacheMemory")
30 For Each ObjCPU In CPUs
31 MCS = ObjCPU.MaxClockSpeed :CCS = ObjCPU.CurrentClockSpeed
32 If MCS Mod 2 = 1 Then MCS = MCS + 1
33 If CCS Mod 2 = 1 Then CCS = CCS+ 1
34 OC= QOC(CCS,MCS)
35 If (OC-MCS) > 10 and (OC-MCS) > 0 Then OCLC = " 超频比率: " & FormatPercent((OC-MCS)/MCS)
36 If (OC-MCS) < -10 and (OC-MCS) < 0 Then OCLC = " 降频比率: " & FormatPercent((OC-MCS)/MCS)
37 CPUx = CPUx _
38 & "CPU 名称: " & Trim(ObjCPU.Name) & vbCrLf _
39 & "CPU 构架: " & ObjCPU.Description & vbCrLf _
40 & "制造厂商: " & ObjCPU.Manufacturer & vbCrLf _
41 & "接口规格: " & ObjCPU.SocketDesignation & vbCrLf _
42 & "CPU 数量: " & ObjCPU.CpuStatus & vbCrLf _
43 & "核心数量: " & ObjCPU.NumberOfCores & vbCrLf _
44 & "线程数量: " & ObjCPU.NumberOfLogicalProcessors & vbCrLf _
45 & "地址位宽: " & ObjCPU.AddressWidth & " Bit" & vbCrLf _
46 & "数据位宽: " & ObjCPU.DataWidth & " Bit" & vbCrLf _
47 & "CPU 电压: " & ObjCPU.CurrentVoltage / 10 & "V" & vbCrLf _
48 & "外部频率: " & ObjCPU.ExtClock & " MHz" & vbCrLf _
49 & "当前频率: " & OC & " MHz" & OCLC & vbCrLf _
50 & "原始频率: " & MCS & " MHz" & vbCrLf _
51 & "CPU 使用: " & ObjCPU.LoadPercentage & "%" & vbCrLf
52 Next
53 Function QOC(CCS,MCS)
54 If CCS = MCS Then
55 Set wReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
56 wReg.GetDWORDValue &H80000002,"HARDWARE\DESCRIPTION\System\CentralProcessor\0","~MHz",strValue
57 OC = strValue :Set wReg = Nothing
58 Else
59 OC = CCS
60 End If
61 QOC = OC :If QOC Mod 2 = 1 Then QOC = QOC + 1
62 End Function
63
64 For Each ObjCache In Caches
65 If objCache.MaxCacheSize > 0 Then
66 Select Case objCache.Purpose
67 case "L1-Cache"
68 CPUx = CPUx & "一级缓存: " & objCache.MaxCacheSize & "KB (L1数据＋L1缓存)" & vbCrLf
69 case "L2-Cache"
70 CPUx = CPUx & "二级缓存: " & objCache.MaxCacheSize & " KB" & vbCrLf
71 case "L3-Cache"
72 CPUx = CPUx & "三级缓存: " & objCache.MaxCacheSize & " KB" & vbCrLf
73 End Select
74 End If
75 Next
76 Set Caches = Nothing:Set CPUs = Nothing
77
78 Memx = "————————————内存信息————————————" & vbCrLf
79 Set Memorys = WMI.InstancesOf("Win32_PhysicalMemory")
80 Set MemKY = WMI.InstancesOf("Win32_OperatingSystem")
81 For Each aKY In MemKY
82 ZL=aKY.TotalVisibleMemorySize 'TotalPhysicalMemory
83 KY=aKY.FreePhysicalMemory
84 Next
85 Mems = 0:Memc = 0
86 Types = Array("Unknown","Other","DRAM","Synchronous DRAM","Cache DRAM","EDO","EDRAM","VRAM","SRAM", "RAM", _
87 "ROM","Flash","EEPROM","FEPROM","EPROM","CDRAM","3DRAM","SDRAM","SGRAM","RDRAM","DDR","DDR2")
88 For Each Mem In Memorys
89 For i = 0 To UBound(Types)
90 If Mem.MemoryType = i Then MemType = Types(i) :End If
91 Next
92 For j = 0 To 6
93 Select Case Mem.Tag
94 case "Physical Memory " &j
95 Mems = Mems+(Mem.Capacity)
96 Memx = Memx &"插槽" & Mem.DeviceLocator & ": " & Round(Mem.Capacity/1048576) &" MB " _
97 &MemType&"-"&Mem.Speed&"MHz"& " 数据带宽" & Mem.DataWidth &"Bit" &" 总带宽"&Mem.TotalWidth &"Bit" & vbCrLf
98 End Select
99 Next
100 Next
101 Memx = Memx _
102 &"内存安装: "& Round(Mems/1048576)&" MB " & vbCrLf _
103 &"内存总量: "& Round(ZL/1024)& " MB" & vbCrLf _
104 &"内存可用: "& Round(KY/1024)& " MB" & vbCrLf _
105 &"内存使用率: " &FormatPercent((ZL-KY)/ZL)& vbCrLf
106 Set Memorys = Nothing:Set MemKY = Nothing
107
108 Vx= "————————————显卡信息————————————" & vbCrLf
109 Set cVID = WMI.ExecQuery("SELECT DeviceID FROM Win32_VideoController")
110 For Each oVID In cVID
111 Set Video = WMI.ExecQuery("SELECT * FROM Win32_VideoController WHERE DeviceID='"& oVID.DeviceID &"'")
112 For Each oVideo In Video
113 Vx = Vx _
114 & "显卡名称: " & oVideo.Name & vbCrLf _
115 & "制造厂商: " & oVideo.AdapterCompatibility & vbCrLf _
116 & "物理显存: " & Round(oVideo.AdapterRAM/1048576)&" MB " & vbCrLf _
117 & "显示模式: " & oVideo.CurrentHorizontalResolution &" X " _
118 & oVideo.CurrentVerticalResolution &" "_
119 & oVideo.CurrentBitsPerPixel &"Bit " _
120 & oVideo.CurrentRefreshRate + 1 &"Hz" & vbCrLf
121 Next
122 Next
123 Set Video = Nothing:Set cVID = Nothing
124
125 Dx= "————————————硬盘信息————————————" & vbCrLf
126 Set IDE = WMI.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='IDE'")
127 Set cPPP = WMI.ExecQuery("SELECT * FROM Win32_PerfRawData_PerfDisk_PhysicalDisk")
128 For Each oIDE In IDE
129 For i = 0 To IDE.Count
130 Select Case oIDE.Index
131 Case i
132 For Each oPPP In cPPP
133 If InStr(oPPP.Name, i) Then vName = oPPP.Name
134 Next
135 Dx = Dx &"硬盘"&i&":" &vbTab & oIDE.Caption &vbCrLf &vbTab& "固件版本: " & oIDE.FirmwareRevision & vbCrLf
136 If CStr(Err.Number) <> 0 Then Dx = Dx &"硬盘"&i&":" &vbTab & oIDE.Caption &vbCrLf
137 Dx = Dx &vbTab& "标称容量: " & Round(oIDE.Size/1000000000) &" GB" &vbTab & "实际容量: " & Round(oIDE.Size/1073741824) &" GB" & vbCrLf _
138 &vbTab& "柱面数: " & oIDE.TotalCylinders &vbTab & "磁头数: " & oIDE.TotalHeads & vbCrLf _
139 &vbTab& "每道扇区数: " & oIDE.SectorsPerTrack &vbTab & "扇区大小: " & oIDE.BytesPerSector & vbCrLf _
140 &vbTab& "总扇区数: " & oIDE.TotalSectors & vbCrLf & vbTab & "分区状态: " &vName & vbCrLf
141 DevID = Replace(oIDE.DeviceID, "\", "\\")
142 Set cDP = WMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID="""&DevID&"""} WHERE AssocClass = Win32_DiskDriveToDiskPartition")
143 For Each oDP In cDP
144 Set cLD = WMI.ExecQuery ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID="""&oDP.DeviceID&"""} WHERE AssocClass = Win32_LogicalDiskToPartition")
145 For Each oLD In cLD
146 Dx = Dx & vbTab & oLD.DeviceID &" " & Left(oLD.VolumeName&" " ,11) & Left(oLD.FileSystem&" " ,6) & "共:" _
147 & Right(" "&Round(oLD.Size/1073741824,1),6) &" GB 可用:" _
148 & Right(" "&Round(oLD.FreeSpace/1073741824,1),6) &" GB 已用:" _
149 & Right(" "&Round((oLD.Size-oLD.FreeSpace)/1073741824,1),6)&" GB" & vbCrLf
150 Next
151 Next
152 End Select
153 Next
154 Next
155 Set cLD = Nothing:Set cDP = Nothing:Set IDE = Nothing:Set cDP = Nothing:Set cPPP = Nothing
156
157 Sx= "————————————声卡信息————————————" & vbCrLf
158 Set cSD = WMI.ExecQuery("SELECT * FROM Win32_SoundDevice")
159 For Each oSD In cSD
160 Sx = Sx & "声卡名称: " & oSD.ProductName & vbCrLf
161 Next
162 Set cSD = Nothing
163 Nx= "————————————网卡信息————————————" & vbCrLf
164 Set cNet = WMI.ExecQuery("Select * from Win32_NetworkAdapter WHERE PhysicalAdapter ='TRUE'")
165 For Each oNet In cNet
166 If oNet.NetEnabled = TRUE Then
167 Nx = Nx & "网卡名称: "& oNet.Name & vbTab & "活跃状态" & vbCrLf
168 Else
169 Nx = Nx & "网卡名称: "& oNet.Name & vbTab & "空闲状态" & vbCrLf
170 End If
171
172 Next
173 Set cNet = Nothing
174
175 If (Lcase(Right(Wscript.FullName,11)) = "wscript.exe") Then
176 MsgBox OSx & BBx & CPUx & Memx ,,"Hardware_Info.vbs v1.0 BY: fastslz"
177 MsgBox Vx & Sx &Nx ,,"Hardware_Info.vbs v1.0 BY: fastslz"
178 MsgBox Dx ,, "Hardware_Info.vbs v1.0 BY: fastslz"
179 MsgN = MsgBox ("是否保存到文件？" , 32+4 , "Hardware_Info.vbs v1.0 BY: fastslz")
180 If MsgN = 6 Then JZCSx = JZCS :wInfo
181 Else
182 WScript.Echo OSx & BBx & CPUx & Memx &Vx & Sx &Nx & Dx
183 End If
184
185 Set WMI = Nothing
186
187 Sub wInfo()
188 Set WS = CreateObject("WScript.Shell")
189 Set Fso = CreateObject("Scripting.FileSystemObject")
190 aFile = WS.CurrentDirectory &"\"& WS.ExpandEnvironmentStrings("%COMPUTERNAME%")&"_Hardware_Info.txt"
191 Set HInfo = Fso.CreateTextFile(aFile , True)
192 HInfo.WriteLine "Hardware_Info.vbs BY: fastslz http://bbs.bathome.net"
193 HInfo.WriteLine OSx & BBx & CPUx & Memx &Vx & Sx &Nx & Dx & JZCSx
194 HInfo.Close
195 WS.Run Chr(34)&aFile&Chr(34)
196 Set WS = Nothing:Set Fso = Nothing:Set HInfo = Nothing
197 End Sub
198
199 Function wDate(nD)
200 If Not IsNull(nD) Then
201 wDate = CDate(Mid(nD,5,2)&"/"&Mid(nD,7,2)&"/"&Left(nD,4)&" "&Mid(nD,9,2)&":"&Mid(nD,11,2)&":"&Mid(nD,13,2))
202 End If
203 End Function
204
205 Function JZCS()
206 NumMsg = vbCrLf & "———————————简易CPU基准测试———————————" & vbCrLf
207 Dim I,T1,T2,Tempvalue,aRunTime,bRunTime
208 T1 = Timer()
209 For I = 1 To 2000000
210 Tempvalue= 2^0.5
211 Next
212 T2 = Timer()
213 aRunTime = FormatNumber((T2-T1)*1000,2)
214 NumMsg = NumMsg & "CPU 200万次开方计算所需时间：" &aRunTime&" 毫秒" & vbCrLf
215 T1 = Timer()
216 For I = 1 To 6000000
217 Tempvalue= 1 + 1
218 Next
219 T2 = Timer()
220 bRunTime = FormatNumber((T2-T1)*1000,2)
221 NumMsg = NumMsg & "CPU 600万次加法计算所需时间："&bRunTime&" 毫秒" & vbCrLf
222 JZCS = NumMsg
223 End Function
