windows获取硬件信息

黄智勇

'gethardwareinformation　　
On Error Resume Next
　　
Dim WMI,WS,Fso
　　
Set WMI = GetObject("Winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
　　
Set cOSs = WMI.ExecQuery("Select * from Win32_OperatingSystem")
　　
For Each oOS in cOSs
　　
    OSx = oOS.Caption & " " &oOS.CSDVersion & " " &oOS.Version & " (" & oOS.OSArchitecture &")" & vbCrLf
　　
    If CStr(Err.Number) <> 0 Then OSx = oOS.Caption & " " &oOS.CSDVersion & " " &oOS.Version & vbCrLf
　　
Next
　　
BBx= "————————————主板信息————————————"  & vbCrLf
　　
Set Board = WMI.InstancesOf("Win32_BaseBoard")
　　
Set Bios = WMI.InstancesOf("Win32_Bios")
　　
For Each oBoard In Board
　　
BBx = BBx _
　　
    & "主板名称: " & oBoard.Product &vbTab & oBoard.Version & vbCrLf _
　　
    & "制造厂商: " & oBoard.Manufacturer                    & vbCrLf
　　
Next
　　
For Each oBios In Bios
　　
BBx = BBx _
　　
    & "BIOS厂商: " & oBios.Manufacturer                    & vbCrLf _
　　
    & "BIOS日期: " & FormatDateTime(wDate(Trim(oBios.ReleaseDate)),1)  & vbCrLf _
　　
    & "BIOS版本: " & oBios.SMBIOSBIOSVersion & vbCrLf _
　　
    & "OEM 版本: " & oBios.Version   & vbCrLf
　　
Next
　　
Set Bios = Nothing:Set Board  = Nothing
　　
CPUx = "———————————处理器信息———————————"  & vbCrLf
　　
Set CPUs = WMI.InstancesOf("Win32_Processor")
　　
Set Caches = WMI.InstancesOf("Win32_CacheMemory")
　　
For Each ObjCPU In CPUs
　　
MCS = ObjCPU.MaxClockSpeed  :CCS = ObjCPU.CurrentClockSpeed
　　
If MCS Mod 2 = 1 Then MCS = MCS + 1
　　
If CCS Mod 2 = 1 Then CCS = CCS+ 1
　　
OC= QOC(CCS,MCS)
　　
If (OC-MCS) > 10 and (OC-MCS) > 0 Then OCLC = "  超频比率: " & FormatPercent((OC-MCS)/MCS)
　　
If (OC-MCS) < -10 and (OC-MCS) < 0 Then OCLC = "  降频比率: " & FormatPercent((OC-MCS)/MCS)
　　
CPUx = CPUx _
　　
     & "CPU 名称: " & Trim(ObjCPU.Name)                & vbCrLf _
　　
     & "CPU 构架: " & ObjCPU.Description               & vbCrLf _
　　
     & "制造厂商: " & ObjCPU.Manufacturer              & vbCrLf _
　　
     & "接口规格: " & ObjCPU.SocketDesignation         & vbCrLf _
　　
     & "CPU 数量: " & ObjCPU.CpuStatus                 & vbCrLf _
　　
     & "核心数量: " & ObjCPU.NumberOfCores             & vbCrLf _
　　
     & "线程数量: " & ObjCPU.NumberOfLogicalProcessors & vbCrLf _
　　
     & "地址位宽: " & ObjCPU.AddressWidth & " Bit"     & vbCrLf _
　　
     & "数据位宽: " & ObjCPU.DataWidth & " Bit"        & vbCrLf _
　　
     & "CPU 电压: " & ObjCPU.CurrentVoltage / 10 & "V" & vbCrLf _
　　
     & "外部频率: " & ObjCPU.ExtClock         & " MHz" & vbCrLf _
　　
     & "当前频率: " & OC               & " MHz" & OCLC & vbCrLf _
　　
     & "原始频率: " & MCS                     & " MHz" & vbCrLf _
　　
     & "CPU 使用: " & ObjCPU.LoadPercentage  & "%"     & vbCrLf
　　
Next
　　
Function QOC(CCS,MCS)
　　
    If CCS = MCS Then
　　
        Set wReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
　　
        wReg.GetDWORDValue &H80000002,"HARDWARE\DESCRIPTION\System\CentralProcessor\0","~MHz",strValue
　　
        OC = strValue :Set wReg = Nothing
　　
        Else
　　
        OC = CCS
　　
    End If
　　
    QOC = OC :If QOC Mod 2 = 1 Then QOC = QOC + 1
　　
End Function
　　
For Each ObjCache In Caches
　　
    If objCache.MaxCacheSize > 0  Then
　　
        Select Case objCache.Purpose
　　
        case "L1-Cache"
　　
        CPUx = CPUx & "一级缓存: " & objCache.MaxCacheSize & "KB    (L1数据＋L1缓存)" & vbCrLf
　　
        case "L2-Cache"
　　
        CPUx = CPUx & "二级缓存: " & objCache.MaxCacheSize & " KB" & vbCrLf
　　
        case "L3-Cache"
　　
        CPUx = CPUx & "三级缓存: " & objCache.MaxCacheSize & " KB" & vbCrLf
　　
        End Select
　　
    End If
　　
Next
　　
Set Caches = Nothing:Set CPUs = Nothing
　　
Memx = "————————————内存信息————————————" & vbCrLf
　　
Set Memorys = WMI.InstancesOf("Win32_PhysicalMemory")
　　
Set MemKY = WMI.InstancesOf("Win32_OperatingSystem")
　　
For Each aKY In MemKY
　　
    ZL=aKY.TotalVisibleMemorySize   'TotalPhysicalMemory
　　
    KY=aKY.FreePhysicalMemory
　　
Next
　　
Mems = 0:Memc = 0
　　
Types = Array("Unknown","Other","DRAM","Synchronous DRAM","Cache DRAM","EDO","EDRAM","VRAM","SRAM", "RAM", _
　　
               "ROM","Flash","EEPROM","FEPROM","EPROM","CDRAM","3DRAM","SDRAM","SGRAM","RDRAM","DDR","DDR2")
　　
For Each Mem In Memorys
　　
    For i = 0 To UBound(Types)
　　
        If Mem.MemoryType = i Then MemType = Types(i) :End If
　　
    Next
　　
    For j = 0 To 6
　　
        Select Case Mem.Tag
　　
            case "Physical Memory " &j
　　
            Mems = Mems+(Mem.Capacity)
　　
            Memx = Memx  &"插槽" & Mem.DeviceLocator & ": " & Round(Mem.Capacity/1048576) &" MB  " _
　　
                &MemType&"-"&Mem.Speed&"MHz"& " 数据带宽" & Mem.DataWidth &"Bit" &" 总带宽"&Mem.TotalWidth &"Bit" & vbCrLf
　　
        End Select
　　
    Next
　　
Next
　　
Memx = Memx _
　　
     &"内存安装: "& Round(Mems/1048576)&" MB " & vbCrLf _
　　
     &"内存总量: "& Round(ZL/1024)& " MB" & vbCrLf _
　　
     &"内存可用: "& Round(KY/1024)& " MB" & vbCrLf _
　　
     &"内存使用率: " &FormatPercent((ZL-KY)/ZL)& vbCrLf
　　
Set Memorys = Nothing:Set MemKY = Nothing
　　
Vx= "————————————显卡信息————————————"  & vbCrLf
　　
Set cVID = WMI.ExecQuery("SELECT DeviceID FROM Win32_VideoController")
　　
For Each oVID In cVID
　　
    Set Video = WMI.ExecQuery("SELECT * FROM Win32_VideoController WHERE DeviceID='"& oVID.DeviceID &"'")
　　
    For Each oVideo In Video
　　
        Vx = Vx _
　　
        & "显卡名称: " & oVideo.Name                                    & vbCrLf _
　　
        & "制造厂商: " & oVideo.AdapterCompatibility                    & vbCrLf _
　　
        & "物理显存: " & Round(oVideo.AdapterRAM/1048576)&" MB "        & vbCrLf _
　　
        & "显示模式: " & oVideo.CurrentHorizontalResolution &" X " _
　　
                       & oVideo.CurrentVerticalResolution   &" "_
　　
                       & oVideo.CurrentBitsPerPixel         &"Bit " _
　　
                       & oVideo.CurrentRefreshRate + 1      &"Hz"     & vbCrLf
　　
    Next
　　
Next
　　
Set Video = Nothing:Set cVID = Nothing
　　
Dx= "————————————硬盘信息————————————"  & vbCrLf
　　
Set IDE = WMI.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='IDE'")
　　
Set cPPP = WMI.ExecQuery("SELECT * FROM Win32_PerfRawData_PerfDisk_PhysicalDisk")
　　
For Each oIDE In IDE
　　
    For i = 0 To IDE.Count
　　
        Select Case oIDE.Index
　　
            Case i
　　
               For Each oPPP In cPPP
　　
                   If InStr(oPPP.Name, i) Then vName = oPPP.Name
　　
               Next
　　
               Dx = Dx  &"硬盘"&i&":" &vbTab    & oIDE.Caption &vbCrLf &vbTab& "固件版本: " & oIDE.FirmwareRevision   & vbCrLf
　　
               If CStr(Err.Number) <> 0 Then Dx = Dx  &"硬盘"&i&":" &vbTab    & oIDE.Caption &vbCrLf
　　
               Dx = Dx &vbTab& "标称容量: "    & Round(oIDE.Size/1000000000) &" GB" &vbTab & "实际容量: " & Round(oIDE.Size/1073741824) &" GB" & vbCrLf _
　　
               &vbTab& "柱面数: "      & oIDE.TotalCylinders  &vbTab & "磁头数: "   & oIDE.TotalHeads     & vbCrLf _
　　
               &vbTab& "每道扇区数: "  & oIDE.SectorsPerTrack &vbTab & "扇区大小: " & oIDE.BytesPerSector & vbCrLf _
　　
               &vbTab& "总扇区数: "    & oIDE.TotalSectors   & vbCrLf & vbTab &  "分区状态: "             &vName  & vbCrLf
　　
               DevID = Replace(oIDE.DeviceID, "\", "\\")
　　
               Set cDP = WMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID="""&DevID&"""} WHERE AssocClass = Win32_DiskDriveToDiskPartition")
　　
               For Each oDP In cDP
　　
                 Set cLD = WMI.ExecQuery ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID="""&oDP.DeviceID&"""} WHERE AssocClass = Win32_LogicalDiskToPartition")
　　
                   For Each oLD In cLD
　　
                     Dx = Dx & vbTab & oLD.DeviceID &" " & Left(oLD.VolumeName&"         " ,11) & Left(oLD.FileSystem&"   " ,6) & "共:" _
　　
                        & Right("    "&Round(oLD.Size/1073741824,1),6)                &" GB    可用:" _
　　
                        & Right("    "&Round(oLD.FreeSpace/1073741824,1),6)           &" GB    已用:" _
　　
                        & Right("    "&Round((oLD.Size-oLD.FreeSpace)/1073741824,1),6)&" GB" & vbCrLf
　　
                   Next
　　
              Next
　　
        End Select
　　
    Next
　　
Next
　　
Set cLD = Nothing:Set cDP = Nothing:Set IDE = Nothing:Set cDP = Nothing:Set cPPP =  Nothing
　　
Sx= "————————————声卡信息————————————"  & vbCrLf
　　
Set cSD = WMI.ExecQuery("SELECT * FROM Win32_SoundDevice")
　　
For Each oSD In cSD
　　
    Sx = Sx & "声卡名称: " & oSD.ProductName  & vbCrLf
　　
Next
　　
Set cSD = Nothing
　　
Nx= "————————————网卡信息————————————"  & vbCrLf
　　
Set cNet = WMI.ExecQuery("Select * from Win32_NetworkAdapter WHERE PhysicalAdapter ='TRUE'")
　　
For Each oNet In cNet
　　
    If oNet.NetEnabled = TRUE Then
　　
       Nx = Nx & "网卡名称: "& oNet.Name & vbTab & "活跃状态" & vbCrLf
　　
       Else
　　
       Nx = Nx & "网卡名称: "& oNet.Name & vbTab & "空闲状态" & vbCrLf
　　
    End If
　　

　　
Next
　　
Set cNet = Nothing
　　
'If (Lcase(Right(Wscript.FullName,11)) = "wscript.exe") Then
　　
'    MsgBox OSx & BBx & CPUx & Memx ,,"Hardware_Info.vbs v1.0 BY: fastslz"
　　
'    MsgBox Vx & Sx &Nx  ,,"Hardware_Info.vbs v1.0 BY: fastslz"
　　
'    MsgBox Dx ,, "Hardware_Info.vbs v1.0 BY: fastslz"
　　
'    MsgN = MsgBox ("是否保存到文件？" , 32+4 , "Hardware_Info.vbs v1.0 BY: fastslz")
　　
'    If MsgN = 6 Then JZCSx = JZCS :wInfo
　　
'    Else
　　
'    WScript.Echo OSx & BBx & CPUx & Memx &Vx & Sx &Nx & Dx
　　
'End If
　　
JZCSx = JZCS :wInfo