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