远程检测硬件信息的VBS脚本代码

  Option Explicit

 
  '********************************说明开始*************************************
  'Input格式：起始IP-数量=用户名=密码;起始计算机名-数量=用户名=密码
  '              多个配置项用“;”隔开
  '例：192.168.0.1-10指明IP范围为192.168.0.1~192.168.0.10，支持跨网段
  '例：PC001-10指明范围为PC001~PC010(计算机名可以包含-号)
  '与指定格式不相同的，默认为单IP[计算机名],也可以在"未扫描的计算机.txt"里配置
  '"硬件信息.txt"是以逗号分隔各项硬件信息，你需要自己导入XLS整理、精简
  '未扫描到的计算机，会把机号、用户名、密码保存到"未扫描的计算机.txt"
  '再次运行脚本将只读取"未扫描的计算机.txt"里的信息(如果存在并且大小不为0)
  '********************************说明结束*************************************
 
  Dim Input, InfoOutFile, LogFile '请按格式给Input赋值
  Input = "PC001-109=administrator=lynetbar;pc110-85=administrator=LYnetbar"
  InfoOutFile = "硬件信息.txt"
  LogFile = "未扫描的计算机.txt"
 
  Redim arrConfig(0)
  Dim WshShell, FSO, intCount1, intCount2
  intCount1 = 0
  intCount2 = 0
  Set WshShell = WScript.CreateObject("WScript.Shell")
  Set FSO = WScript.Createobject("Scripting.Filesystemobject")
  ReadConfig
  WshShell.Popup "扫描过程会很慢，请耐心等待，完成后会给出提示",,"扫描开始"
  LinkRemoteServer arrConfig
  Dim LenNum1, LenNum2
  If intCount1 > intCount2 Then
    LenNum1 = 0
    LenNum2 = Len(intCount1) - Len(intCount2)
  Else
    LenNum1 = Len(intCount2) - Len(intCount1)
    LenNum2 = 0
  End If
  Sort InfoOutFile
  WshShell.Popup "扫描结果：" & _
                 vbCrLf & vbTab & "扫描成功：" & Space(LenNum1) & intCount1 & " 台" & _
                 vbCrLf & vbTab & "扫描失败：" & Space(LenNum2) & intCount2 & " 台" & _
                 vbCrLf & "扫描失败的电脑已做记录，再次运行脚本只扫描记录里的电脑",,"扫描完成"
 
Function ReadConfig
  Dim objMatches, objMatche,objLogFile, arrLog, intUBarrConfig
  If FSO.FileExists(LogFile) Then
    If FSO.GetFile(LogFile).Size = 0 Then
      Set objMatches = GetMatche("([^;=]+)=([^;=]+)=([^;=]+)", Input)
      For Each objMatche In objMatches
        GetConfig objMatche.SubMatches(0), objMatche.SubMatches(1), objMatche.SubMatches(2)
      Next
      If objMatches.Count = 0 Then
        Msgbox "配置信息格式不正确，请修改"
        WScript.Quit
      End If
    Else
      Set objLogFile = FSO.OpenTextFile(LogFile)
      Do Until objLogFile.AtEndOfStream
        arrLog = Split(objLogFile.ReadLine,"=")
        intUBarrConfig = ((Ubound(arrConfig)+1)\3+1)*3-1
        Redim Preserve arrConfig(intUBarrConfig)
        arrConfig(intUBarrConfig-2) = arrLog(0)
        arrConfig(intUBarrConfig-1) = arrLog(1)
        arrConfig(intUBarrConfig-0) = arrLog(2)
      Loop
    End If
  Else
    Set objMatches = GetMatche("([^;=]+)=([^;=]+)=([^;=]+)", Input)
    For Each objMatche In objMatches
      GetConfig objMatche.SubMatches(0), objMatche.SubMatches(1), objMatche.SubMatches(2)
    Next
    If objMatches.Count = 0 Then
      Msgbox "配置信息格式不正确，请修改"
      WScript.Quit
    End If
  End If
End Function

'*********************************************************************************
'目的：连接到远程主机的WMI命名空间
'输入：arrArray数组，包含有计算机名[IP]、用户名、密码
'调用：LinkServer过程
'        如果返回SWbemLocator对象ConnectServer方法的实例，调用OutInfo过程
'        如果返回Err对象，输出计算机名[IP]、用户名、密码到LogFile文件
'      OutInfo过程
'        如果返回False输出计算机名[IP]、用户名、密码到LogFile文件
'传递：SWbemLocator对象ConnectServer方法的实例传递给OutInfo过程
'      计算机名[IP]、命名空间、用户名、密码传递给LinkServer过程
'*********************************************************************************
Function LinkRemoteServer(arrArray)
  Dim objErrLog, E, objLinkServer, objConnection, objWbemLocator
  Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
  Set objErrLog = FSO.CreateTextFile(LogFile,True)
  For E = 0 To Ubound(arrArray) Step 3
    Set objLinkServer =  LinkServer(arrConfig(E),"root\cimv2",arrConfig(E+1),arrConfig(E+2))
    If Err Then
      objErrLog.Writeline arrArray(E) & "=" & arrArray(E+1) & "=" & arrArray(E+2)
      intCount2 = intCount2 + 1
      Err.Clear
    Else
      If Not OutInfo(objLinkServer) Then
        objErrLog.Writeline arrArray(E) & "=" & arrArray(E+1) & "=" & arrArray(E+2)
        intCount2 = intCount2 + 1
      End If
    End If
  Next
End Function

'******************************************************
'目的：输出硬件信息
'输入：SWbemLocator对象ConnectServer方法的实例
'调用：获取硬件信息的GetXXXInfo过程
'传递：SWbemLocator对象ConnectServer方法的实例
'返回：所有调用的GetInfo过程都未返回Err对象，则返回True
'      某个GetInfo过程返回Err对象，则返回False
'******************************************************
Function OutInfo(objRemote)
  Dim OutFile, arrInfo, strOutInfo, Tmp, A
  If FSO.FileExists(InfoOutFile) Then
    Set OutFile = FSO.OpenTextFile(InfoOutFile,8)
  Else
    Set OutFile = FSO.CreateTextFile(InfoOutFile)
    OutFile.Writeline "计算机名,系统(初装日期),主板型号(厂商),CPU型号(接口类型),外频,L2容量(速度)," & _
                      "内存总量,内存速度(位置),内存类型(封装类型),硬盘型号(容量),显卡型号(显存),网卡,IP/MAC"
  End If
  arrInfo = GetOSInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  strOutInfo = arrInfo(0) & "," & arrInfo(1) & "(" & arrInfo(2) & "),"
  arrInfo = GetBoardInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(0) & "(" & arrInfo(1) & "),"
  arrInfo = GetCPUInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(1) & "(" & arrInfo(8) & ")," & arrInfo(4) & "," & _
               arrInfo(6) & "(" & arrInfo(7) & "),"
  arrInfo = GetMemoryInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  Tmp = 0
  For A = 1 To Ubound(arrInfo) Step 6
    Tmp = Tmp + Cint(arrInfo(A))
  Next
  strOutInfo = strOutInfo & arrInfo(0) & "条，共" & Tmp & "M,"
  Tmp = ""
  For A = 2 To Ubound(arrInfo) Step 6
    If A = Ubound(arrInfo) - 4 Then
      Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & "),"
    Else
      Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & ") "
    End If
  Next
  strOutInfo = strOutInfo & Tmp
  Tmp = ""
  For A = 4 To Ubound(arrInfo) Step 6
    If A = Ubound(arrInfo) - 2 Then
      Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & "),"
    Else
      Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & ") "
    End If
  Next
  strOutInfo = strOutInfo & Tmp
  arrInfo = GetDiskInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(1) & "(" & arrInfo(3) & "G),"
  arrInfo = GetVideoInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(0) & "(" & arrInfo(1) & "M),"
  arrInfo = GetNetworkInfo(objRemote)
  If Err Or Vartype(arrInfo) <> 8204 Then
    OutInfo = False
    Err.Clear
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(1) & "," & arrInfo(2) & Space(17-Len(arrInfo(2))) & arrInfo(3)
  OutFile.Writeline strOutInfo
  intCount1 = intCount1 + 1
  OutInfo = True
End Function

'*********************************************************
'目的：连接到远程主机的WMI命名空间
'输入：strComputer：远程主机的计算机名或IP
'      strNamespace：命令空间
'      strUserName：用户名
'      strPassword：密码
'返回：连接成功，返回SWbemLocator类连接远程主机后的对象的实例
'      连接失败，返回错误对象
'*********************************************************
Function LinkServer(strComputer,strNamespace,strUserName,strPassword)
  Dim objWbemLocator
  Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
  Dim objConnection
  On Error Resume Next
  Set objConnection = objwbemLocator.ConnectServer _
                      (strComputer, strNamespace, strUserName, strPassword)
  If Err Then
      Set LinkServer = Err
      Exit Function
  End If
  On Error Goto 0
  objConnection.Security_.ImpersonationLevel = 3
  Set LinkServer = objConnection
End Function

'******************************************
'目的：正则表达式
'输入：strPatrn：正则表达式模式
'      strString：要执行正则表达式的字符串
'返回：Match对象
'******************************************
Function GetMatche(strPatrn, strString)
  Dim RegEx
  Set RegEx = New Regexp
  RegEx.Global = True
  RegEx.IgnoreCase =True
  RegEx.Pattern = strPatrn
  Set GetMatche = RegEx.Execute(strString)
End Function

'***************************************
'目的：2、8、16进制转10进制
'输入：strString：2、8、16进制数
'      intNum：进制(2|8|16)
'返回：10进制数
'***************************************
Function ChangeToDecimal(strString, intNum)
  ChangeToDecimal = 0
  If Isnull(strString) Then ChangeToDecimal = 0 : Exit Function
  Dim A, M
  For A = 1 To Len(strString)
    M = LCase(Mid(strString, A, 1))
    Select Case M
      Case "a" :M = 10
      Case "b" :M = 11
      Case "c" :M = 12
      Case "d" :M = 13
      Case "e" :M = 14
      Case "f" :M = 15
    End Select
    ChangeToDecimal = ChangeToDecimal + M * intNum^(Len(strString)-A)
  Next
End Function

'*******************************************************
'目的：分析配置信息
'输入：strIP, strUser, strPW：IP[计算机名]、账户、密码
'返回：无，直接把分析结果保存在数组
'*******************************************************
Function GetConfig(strIP, strUser, strPW)
  Dim Matches, SubMatche
  Dim IP_1, IP_2, IP_3, IP_4, intStar, intEnd, A, intConfigNum
  Dim IP_Patrn
  IP_Patrn = "([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)-([\d]+)"
  Set Matches = GetMatche(IP_Patrn, strIP)
  If Matches.Count = 1 Then
    Set SubMatche = Matches(0)
    intStar = Cint(SubMatche.SubMatches(3))
    intEnd = intStar + Cint(SubMatche.SubMatches(4)) - 1
    For A = intStar To intEnd
      IP_4 = A Mod 256
      IP_3 = (Cint(SubMatche.SubMatches(2))+ A\256) Mod 256
      IP_2 = (Cint(SubMatche.SubMatches(1)) + (Cint(SubMatche.SubMatches(2))+ A\256)\256) Mod 256
      IP_1 = Cint(SubMatche.SubMatches(0)) + (Cint(SubMatche.SubMatches(1)) + _
             (Cint(SubMatche.SubMatches(2))+ A\256)\256)\256
      If IP_1 > 223 Or IP_1 = 127 Or IP_1 < 1 Then
        Msgbox strIP & "包含的" & IP_1 & "." & IP_2 & "." & IP_3 & "." & IP_4 & _
               "不是有效IP，此IP及之后的IP已被丢弃"
        Exit Function
      End If
      intConfigNum = (Ubound(arrConfig)+1)\3 + 1
      Redim Preserve arrConfig(intConfigNum*3-1)
      arrConfig(intConfigNum*3-3) = IP_1 & "." & IP_2 & "." & IP_3 & "." & IP_4
      arrConfig(intConfigNum*3-2) = strUser
      arrConfig(intConfigNum*3-1) = strPW
    Next
    Exit Function
  End If
  Dim ComputerName_Patrn, Prefix, intLen
  ComputerName_Patrn = "([\S]+[^0-9]{1})([0]*[\d]+)-([\d]+)"
  Set Matches = GetMatche(ComputerName_Patrn, strIP)
  If Matches.Count = 1 Then
    Set SubMatche = Matches(0)
    Prefix = SubMatche.SubMatches(0)
    intLen = Len(SubMatche.SubMatches(1))
    intStar = Cint(SubMatche.SubMatches(1))
    intEnd = intStar + Cint(SubMatche.SubMatches(2)) - 1
    For A = intStar To intEnd
      intConfigNum = (Ubound(arrConfig)+1)\3 + 1
      Redim Preserve arrConfig(intConfigNum*3-1)
      If Len(A) < intLen Then
        arrConfig(intConfigNum*3-3) = Prefix & String(intLen-Len(A),"0") & A
      Else
        arrConfig(intConfigNum*3-3) = Prefix & A
      End If
      arrConfig(intConfigNum*3-2) = strUser
      arrConfig(intConfigNum*3-1) = strPW
    Next
    Exit Function
  End If
  intConfigNum = (Ubound(arrConfig)+1)\3 + 1
  Redim Preserve arrConfig(intConfigNum*3-1)
  arrConfig(intConfigNum*3-3) = strIP
  arrConfig(intConfigNum*3-2) = strUser
  arrConfig(intConfigNum*3-1) = strPW
End Function

'***********************************************************
'目的：获取操作系统信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为2
'       取操作系统的3种属性：
'   0         1                 2
'   CSName    Caption&CSDVersion   InstallDate
'   计算机名   系统名&SP版本     初装日期
'LastBootUpTime属性表示系统最近一次的启动时间
'***********************************************************
Function GetOSInfo(objConnection)
  Dim arrOSInfo
  Dim objSystemInfos, objSystemInfo, arrOS(2), intNum
  On Error Resume Next
  Set objSystemInfos = objConnection.InstancesOf("win32_operatingsystem")
  For Each objSystemInfo In objSystemInfos
      arrOS(0) = objSystemInfo.CSName
      intNum = InStr(objSystemInfo.Caption,",")
      If intNum = 0 Then
        arrOS(1) = objSystemInfo.Caption & " " & objSystemInfo.CSDVersion
      Else
        arrOS(1) = Left(objSystemInfo.Caption,intNum-1) & _
                   Right(objSystemInfo.Caption,Len(objSystemInfo.Caption)-intNum) & _
                   " " & objSystemInfo.CSDVersion
      End If
      arrOS(2) = Mid(CStr(objSystemInfo.InstallDate),1,4) & "-" & _
                 Mid(CStr(objSystemInfo.InstallDate),5,2) & "-" & _
                 Mid(CStr(objSystemInfo.InstallDate),7,2) '& ", " & _
                 'Mid(CStr(objSystemInfo.InstallDate),9,2) & ":" & _
                 'Mid(CStr(objSystemInfo.InstallDate),11,2) & ":" & _
                 'Mid(CStr(objSystemInfo.InstallDate),13,2)
  Next
  If Err Then
    GetOSInfo = Err
  Else
    GetOSInfo = arrOS
  End If
  On Error Goto 0
End Function

'***********************************************************
'目的：获取主板信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为2
'       取主板的3种属性：
'   0         1              2
'   Product   Manufacturer   Version
'   型号      厂商            版本
'***********************************************************
Function GetBoardInfo(objConnection)
  Dim objboards, objboard, arrBoard(2)
  On Error Resume Next
  Set objboards = objConnection.InstancesOf("Win32_BaseBoard")
  For each objboard In objboards
      arrBoard(0) = Trim(objboard.Product) '型号
      arrBoard(1) = Trim(objboard.Manufacturer) '厂商
      arrBoard(2) = Trim(objboard.Version) '版本
  Next
  If Err Then
    GetBoardInfo = Err
  Else
    GetBoardInfo = arrBoard
  End If
  On Error Goto 0
End Function

'***********************************************************
'目的：获取BIOS信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为1
'       取BIOS的2种属性：
'   0              1
'   Manufacturer   SMBIOSBIOSVersion
'   厂商            版本
'***********************************************************
Function GetBIOSInfo(objConnection)
  Dim objBIOSs, objBIOS, arrBIOS(2)
  On Error Resume Next
  Set objBIOSs = objConnection.InstancesOf("Win32_BIOS")
  For each objBIOS In objBIOSs
      arrBIOS(0) = objBIOS.Manufacturer
      arrBIOS(0) = objBIOS.SMBIOSBIOSVersion
  Next
  If Err Then
    GetBIOSInfo = Err
  Else
    GetBIOSInfo = arrBIOS
  End If
  On Error Goto 0
End Function

'************************************************************
'目的：获取CPU信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为8
'       取CPU的9种属性：
'   0         1     2              3                4        
'             Name  MaxClockSpeed  CurrentVoltage   ExtClock 
'  核心数量    型号  主频           电压              外频   
'  5             6            7             8
'  AddressWidth  L2CacheSize  L2CacheSpeed  SocketDesignation 
'  位宽          L2容量        L2频率        插槽类型
'************************************************************
Function GetCPUInfo(objConnection)
  Dim objCPU, objCPUs
  Redim arrCPU(8)
  On Error Resume Next
  Set objCPUs = objConnection.InstancesOf("win32_processor")
  arrCPU(0) = objCPUs.Count '每个CPU核心都返回一个实例，实例数量即为CPU核心数量
  For each objCPU In objCPUs
    arrCPU(1) = Trim(objCPU.Name) '型号
    arrCPU(2) = objCPU.MaxClockSpeed '主频
    arrCPU(3) = ChangeToDecimal(objCPU.CurrentVoltage, 16)/10 '电压
    arrCPU(4) = objCPU.ExtClock '外频
    arrCPU(5) = objCPU.AddressWidth '位宽
    arrCPU(6) = objCPU.L2CacheSize 'L2容量
    arrCPU(7) = objCPU.L2CacheSpeed 'L2频率
    arrCPU(8) = objCPU.SocketDesignation '插槽类型
  Next
  If Err Then
    GetCPUInfo = Err
  Else
    GetCPUInfo = arrCPU
  End If
  On Error Goto 0
End Function

'********************************************************************************************
'目的：获取内存信息
'输入：SWbemLocator对象的ConnectServer方法连接到远程主机的实例
'返回：数组，上限为(内存条的数量*6)，0=内存条的数量
'       取内存的6种属性：
'       1         2      3              4           5               6
'       capacity  Speed  DeviceLocator  MemoryType  FormFactor      TypeDetail
'       容量      速度   插槽位置        内存类型     封装(接口)类型   详细类型-系统应用类型
'DeviceLocator属性表示这个内存所在的插槽
'                 一般是字符加数字，数字相当于主板上内存插槽的物理位置
'********************************************************************************************
Function GetMemoryInfo(objConnection)
  Dim objMemorys, objMemory, Num
  Num = 0
  On Error Resume Next
  Set objMemorys = objConnection.InstancesOf("Win32_PhysicalMemory")
  Redim arrMemory(objMemorys.Count*6)
  arrMemory(0) = objMemorys.Count '每条内存都返回一个实例，实例项数即内存条数量
  For Each objMemory In objMemorys
    Num = Num + 1
    arrMemory(Num*6-5) = objMemory.capacity/1048576 '容量(M)
    arrMemory(Num*6-4) = objMemory.Speed '速度(MHz)
    arrMemory(Num*6-3) = objMemory.DeviceLocator '插槽位置
    Select Case objMemory.MemoryType '内存类型，
      Case 0 :arrMemory(Num*6-2) = "Unknown" '未知
      Case 1 :arrMemory(Num*6-2) = "Other" '其它
      Case 2 :arrMemory(Num*6-2) = "DRAM" '动态随机存储器
      Case 3 :arrMemory(Num*6-2) = "Synchronous DRAM" '同步动态随机存储器
      Case 4 :arrMemory(Num*6-2) = "Cache DRAM" '同步缓存动态随机存储器,三菱专利技术,插入一个SRAM作为二级CACHE使用
      Case 5 :arrMemory(Num*6-2) = "EDO" '外扩充数据模式存储器(Extended Date Out)
      Case 6 :arrMemory(Num*6-2) = "EDRAM" '增强型动态随机存储器，在DRAM中包括了一小部分的SRAM(Enhanced DRAM)
      Case 7 :arrMemory(Num*6-2) = "VRAM" '视频存储器,专门为图形应用优化的存储器(Video DRAM)
      Case 8 :arrMemory(Num*6-2) = "SRAM" '静态随机存储器
      Case 9 :arrMemory(Num*6-2) = "RAM" '随机存储器
      Case 10 :arrMemory(Num*6-2) = "ROM" '只读存储器
      Case 11 :arrMemory(Num*6-2) = "Flash" '闪速存储器,简称闪存(Flash Memory),具于EEPROM(电擦除可编程只读存储器)类型
      Case 12 :arrMemory(Num*6-2) = "EEPROM" '电可擦写可编程只读存储器
      Case 13 :arrMemory(Num*6-2) = "FEPROM" 'F什么可擦写可编程只读存储器
      Case 14 :arrMemory(Num*6-2) = "EPROM" '可擦写可编程只读存储器(Erasable Programmable ROM)
      Case 15 :arrMemory(Num*6-2) = "CDRAM" '同步缓存动态随机存储器,即Cache DRAM
      Case 16 :arrMemory(Num*6-2) = "3DRAM" '3维视频处理器专用存储器(3 DIMESION RAM)
      Case 17 :arrMemory(Num*6-2) = "SDRAM" '同步动态随机存储器,即Synchronous DRAM
      Case 18 :arrMemory(Num*6-2) = "SGRAM" '单口随机存储器(Signal RAM)
      Case 19 :arrMemory(Num*6-2) = "RDRAM" '总线式动态随机存储器
      Case 20 :arrMemory(Num*6-2) = "DDR" '双倍速率同步动态随机存储器,一个时钟周期内传输二次数据
      Case 21 :arrMemory(Num*6-2) = "DDR-2" '双倍速率同步动态随机存储器2,一个时钟周期内传输二次数据,4bit数据预读取能力
    End Select
    Select Case objMemory.FormFactor '封装类型(接口类型)
      Case 0 :arrMemory(Num*6-1) = "Unknown" '未知
      Case 1 :arrMemory(Num*6-1) = "Other" '其它
      Case 2 :arrMemory(Num*6-1) = "SIP" '单列直插式封装
      Case 3 :arrMemory(Num*6-1) = "DIP" '双列直插式封装(Dual ln-line Package)
      Case 4 :arrMemory(Num*6-1) = "ZIP" '零插拔力封装(Zero Insertion Package)
      Case 5 :arrMemory(Num*6-1) = "SOJ" '小尺寸(小外形)J形引脚封装(Small Out-Line J-Lead)
      Case 6 :arrMemory(Num*6-1) = "Proprietary" '专有封装(有专利权的)
      Case 7 :arrMemory(Num*6-1) = "SIMM" '单列直插式封装(Single Inline Memory Module)
      Case 8 :arrMemory(Num*6-1) = "DIMM" '双列直插式封装(Dual Inline Memory Module)
      Case 9 :arrMemory(Num*6-1) = "TSOP" '薄型小尺寸封装(Thin Small Outline Package)
      Case 10 :arrMemory(Num*6-1) = "PGA" '陈列引脚封装。底面的垂直引脚呈陈列状排列。用于高速大规模逻辑LSI电路。
      Case 11 :arrMemory(Num*6-1) = "RIMM" '总线式封装,RIMM是Rambus公司生产的RDRAM内存所采用的接口类型
      Case 12 :arrMemory(Num*6-1) = "SODIMM" '小尺寸双列直插式封装(Small Outline DIMM Module)
      Case 13 :arrMemory(Num*6-1) = "SRIMM" '小尺寸总线式封装
      Case 14 :arrMemory(Num*6-1) = "SMD" '表面贴装型封装(Surface Mounted Devices),也叫贴片封装
      Case 15 :arrMemory(Num*6-1) = "SSMP" '未搜到此类型的信息，谁知道的请告诉偶，谢谢
      Case 16 :arrMemory(Num*6-1) = "QFP" '方型扁平封装(Quad Flat Package)
      Case 17 :arrMemory(Num*6-1) = "TQFP" '薄方型扁平封装
      Case 18 :arrMemory(Num*6-1) = "SOIC" '小尺寸集成电路封装,SOP(Small Outline Package，小外形封装)之一
      Case 19 :arrMemory(Num*6-1) = "LCC" '无引脚封装,指只有电极接触而无引脚的表面贴装型封装
      Case 20 :arrMemory(Num*6-1) = "PLCC" '塑封J形引脚封装
      Case 21 :arrMemory(Num*6-1) = "BGA" '球栅阵列封装,在背面按陈列方式制作出球形凸点代替引脚
      Case 22 :arrMemory(Num*6-1) = "FPBGA" '方型扁平球栅阵列封装
      Case 23 :arrMemory(Num*6-1) = "LGA" '触点陈列封装。
    End Select
    Select Case objMemory.TypeDetail '详细类型
      Case 1 :arrMemory(Num*6) = "Reserved" '预留
      Case 2 :arrMemory(Num*6) = "Other" '其它
      Case 4 :arrMemory(Num*6) = "Unknown" '未知
      Case 8 :arrMemory(Num*6) = "Fast-paged" '快速分页
      Case 16 :arrMemory(Num*6) = "Static column" '静态列
      Case 32 :arrMemory(Num*6) = "Pseudo-static" '假静态
      Case 64 :arrMemory(Num*6) = "RAMBUS" 'Rambus公司
      Case 128 :arrMemory(Num*6) = "Synchronous" '同步
      Case 256 :arrMemory(Num*6) = "CMOS" '互补
      Case 512 :arrMemory(Num*6) = "EDO" '外扩充
      Case 1024 :arrMemory(Num*6) = "Window DRAM" '视频
      Case 2048 :arrMemory(Num*6) = "Cache DRAM" '缓存
      Case 4096 :arrMemory(Num*6) = "Nonvolatile" '非易失性
    End Select
  Next
  If Err Then
    GetMemoryInfo = Err
  Else
    GetMemoryInfo = arrMemory
  End If
  On Error Goto 0
End Function

'**********************************************************************************
'目的：获取硬盘信息
'输入：SWbemLocator对象的ConnectServer方法连接到远程主机的实例
'返回：数组，上限为(硬盘数量*4)，0=硬盘的数量
'       取硬盘的4种属性：
'       1      2              3     4
'       Model  InterfaceType  Size  MediaType
'       型号   接口           容量  类型
'注意：InterfaceType是指接口类型，有5个值：SCSI、HDC、IDE、USB、1394
'      MediaType属性是指媒体类型：
'         Vista下有四个值： External hard disk media:外接硬盘
'                          Removable media other than floppy:移动媒体或软盘
'                          Fixed hard disk media:固定硬盘
'                          Format is unknown:未知类型
'         NT 4.0/2000/XP/2003下有三个值： Removable media:移动媒体
'                                        Fixed hard disk:固定硬盘
'                                        Unknown:未知类型
'      Size属性是1000进制，返回结果是以1024进制换算成G取小数点后二位数
'PS：还可以取得：每扇区字节数、每磁道扇区数、每柱面磁道数
'                扇区总数、柱面总数、磁头总数、磁道总数
'**********************************************************************************
Function GetDiskInfo(objConnection)
  Dim objDisks, objDisk, Num
  Num = 0
  On Error Resume Next
  Set objDisks = objConnection.InstancesOf("win32_diskdrive")
  Redim  arrDisk(objDisks.Count*4)
  arrDisk(0) = objDisks.Count '每个硬盘都返回一个实例，实例项数即硬盘数量
  For Each objDisk In objDisks
    Num = Num + 1
    arrDisk(Num*4-3) = Trim(objDisk.Model) '型号
    arrDisk(Num*4-2) = objDisk.InterfaceType '接口
    arrDisk(Num*4-1) = Round(objDisk.Size/1073741824,2) '容量(G)，和磁盘管理里看到的相同
    arrDisk(Num*4-0) = objDisk.MediaType '类型
  Next
  If Err Then
    GetDiskInfo = Err
  Else
    GetDiskInfo = arrDisk
  End If
  On Error Goto 0
End Function

'***********************************************************
'目的：获取显卡信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为1
'       取显卡的2种属性：
'       0            1
'       Description  AdapterRAM
'       型号         显存
'注意：AdapterRAM属性的单位是字节，返回结果已换算成M字节
'***********************************************************
Function GetVideoInfo(objConnection)
  Dim objVideos, objVideo
  Dim arrVideo(1)
  On Error Resume Next
  Set objVideos = objConnection.InstancesOf("win32_videocontroller")
  For Each objVideo In objVideos
    If Not IsNull(objVideo.VideoModeDescription) Then
      arrVideo(0) = Trim(objVideo.Description)
      arrVideo(1) = objVideo.AdapterRAM/1048576
    End If
  Next
  If Err Then
    GetVideoInfo = Err
  Else
    GetVideoInfo = arrVideo
  End If
  On Error Goto 0
End Function

'************************************************************************
'目的：获取网卡信息(使用Ethernet 802.3协议的网络适配器，即以太网网卡)
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为(网卡数量*5)，0=网卡的数量
'       取网卡的5种属性：
'       1            2             3           4                    5
'       Description  IPAddress(0)  MACAddress  IPXVirtualNetNumber  NetConnectionID
'       型号         IP            MAC         内部网络号           接口名称
'************************************************************************
Function GetNetworkInfo(objConnection)
  Dim objNetworks, objNetwork, objNetworks_2, objNetwork_2, Num
  Redim arrNetwork(0)
  Num = 0
  On Error Resume Next
  Set objNetworks = objConnection.InstancesOf("Win32_NetworkAdapter")
  Set objNetworks_2 = objConnection.InstancesOf("Win32_NetworkAdapterConfiguration")
  For Each objNetwork In objNetworks
    If objNetwork.Manufacturer <> "Microsoft" And Not Isnull(objNetwork.MACAddress) Then
      Num = Num + 1
      Redim Preserve arrNetwork(Num*5)
      arrNetwork(Num*5-4) = objNetwork.Description
      arrNetwork(Num*5-2) = Replace(objNetwork.MACAddress,":","-")
      arrNetwork(Num*5-0) = objNetwork.NetConnectionID
      If Err.Number = 438 Then
        arrNetwork(Num*5-0) = "未检测到" '2000系统不支持NetConnectionID属性
        Err.Clear
      End If
      For Each objNetwork_2 In objNetworks_2
        If objNetwork_2.Index = objNetwork.Index Then
          arrNetwork(Num*5-3) = objNetwork_2.IPAddress(0)
          arrNetwork(Num*5-1) = objNetwork_2.IPXVirtualNetNumber
          Exit For
        End If
      Next
    End If
  Next
  If Err Then
    GetNetworkInfo = Err
  Else
    arrNetwork(0) = Num
    GetNetworkInfo = arrNetwork
  End If
  On Error Goto 0
End Function

'***********************************************************
'目的：获取声卡信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限1
'      取声卡的二种属性：
'      0            1
'      ProductName  Manufacturer
'      型号         厂商
'***********************************************************
Function GetSoundInfo(objConnection)
  Dim objSounds, objSound
  Dim arrSound(1)
  On Error Resume Next
  Set objSounds = objConnection.InstancesOf("Win32_SoundDevice")
  For Each objSound In objSounds
    arrSound(0) = objSound.ProductName
    arrSound(1) = objSound.Manufacturer
  Next
  If Err Then
    GetSoundInfo = Err
  Else
    GetSoundInfo = arrSound
  End If
  On Error Goto 0
End Function

'*****************************************************************
'目的：获取集成设备的信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为(集成设备数量*3)，0=集成设备的数量
'       取集成设备的3种属性：
'       1             2            3
'       Description   DeviceType   Enabled
'       型号          类型         是否启用
'*****************************************************************
Function GetOnBoardInfo(objConnection)
  Dim objOnBoards, objOnBoard, Num
  Redim arrOnBoard(0)
  Num = 0
  On Error Resume Next
  Set objOnBoards = objConnection.InstancesOf("Win32_OnBoardDevice")
  arrOnBoard(0) = objOnBoards.Count
  Redim Preserve arrOnBoard(objOnBoards.Count*3)
  For Each objOnBoard In objOnBoards
    Num = Num + 1
    arrOnBoard(Num*3-2) = objOnBoard.Description
    Select Case objOnBoard.DeviceType
      Case 1 :arrOnBoard(Num*3-1) = "其它设备"
      Case 2 :arrOnBoard(Num*3-1) = "未知设备"
      Case 3 :arrOnBoard(Num*3-1) = "显示设备"
      Case 4 :arrOnBoard(Num*3-1) = "SCSI设备"
      Case 5 :arrOnBoard(Num*3-1) = "以太网设备"
      Case 6 :arrOnBoard(Num*3-1) = "令牌环网设备"
      Case 7 :arrOnBoard(Num*3-1) = "声音设备"
    End Select
    arrOnBoard(Num*3-0) = objOnBoard.Enabled
  Next
  If Err Then
    GetOnBoardInfo = Err
  Else
    GetOnBoardInfo = arrOnBoard
  End If
  On Error Goto 0
End Function

'**************
'排序硬件信息
'**************
Function Sort(FilePath)
  Dim ReadFile, Num, OutputFile, Item, A, B, strA, strB, Tmp
  Redim arrRead(0)
  Set ReadFile = FSO.OpenTextFile(FilePath)
  Do Until ReadFile.AtEndOfStream
    Num = ReadFile.Line
    Redim Preserve arrRead(Num)
    arrRead(Num-1) = ReadFile.ReadLine
  Loop
  Set ReadFile = Nothing
  For A = 1 To Ubound(arrRead) - 2
    For B = A + 1 To Ubound(arrRead) - 1
      If Not Strcomp(arrRead(A),arrRead(B)) Then
        Tmp = arrRead(A)
        arrRead(A) = arrRead(B)
        arrRead(B) = Tmp
      End If
    Next
  Next
  Set OutputFile = FSO.OpenTextFile(FSO.GetBaseName(FilePath) & "_已排序." & _
                   FSO.GetExtensionName(FilePath),2,True)
  For Each Item In arrRead
    OutputFile.Writeline Item
  Next
  Set OutputFile = Nothing
End Function
 
  '************************************************************************************
  'Version:2.5
  '     增加Sort过程，排序硬件信息
  'Version:2.4
  '     调整输出信息的分类，把同类硬件信息放到一起
  '     查询到的硬件信息如果是空或0，是由于相关驱动不完善或未定义此信息，也可能是未安装驱动
  '     因为WMI查询就代表了系统知道这些硬件的详细信息，查不到信息就是系统不知道
  '     系统不知道硬件的详细信息，代表着性能有所缺失，建议找个好驱动安装
  '     值得注意的是主板驱动
  'Version:2.3
  '     取消2.2版增加输出的硬盘接口类型
  '                由于STAT也归于IDE接口，这会导致误解
  '                PS：脚本只输出搜索到的第一个硬盘
  'Version:2.2
  '     GetMemoryInfo过程增加MemoryType、FormFactor、TypeDetail三个属性
  '                输出增加内存类型、封装类型
  '                输出增加硬盘容量、接口类型
  'Version:2.1
  '     GetOSInfo过程增加去掉Caption属性中带有的逗号“,”的代码
  '                原因：在检测2003系统时，读取到的Caption属性，带有逗号“,”
  '                这会影响输出，因为输出是以逗号“,”为分隔符的
  'Version:2.0 B5发布版
  '     GetNetworkInfo过程改为使用MACAddress属性非空、
  '                Manufacturer属性非"Microsoft"判断网卡
  'Version:2.0 Beta4
  '     GetNetworkInfo过程使用NetConnectionStatus属性判断网络适配器
  '                NetConnectionStatus属性表明连接状态(2000系统不支持此属性)
  '                物理网络适配器才具有此状态(包括停用状态在内)
  'Version:2.0 Beta3
  '     GetNetworkInfo过程增加一个判断
  '                忽略读取IPAddress(0)时会产生Err类型数据的适配器(对战平台)
  'Version:2.0 Beta2
  '     GetOSInfo过程原来使用的Name、ServicePackMajorVersion属性
  '                改为使用Caption、CSDVersion属性
  '     所有GetInfo过程增加错误处理代码，避免正在扫描的时候
  '                脚本遇到运行时错误导致脚本退出
  'Version:2.0 Beta1
  '     增加扫描失败记录，再次运行脚本只读取失败记录，忽略配置信息
  'Version:1.1
  '     GetNetworkInfo过程增加一个判断
  '                忽略NetConnectionID属性(接口名称)为空的适配器
  'Version:1.0
  '     初始版本
  '************************************************************************************