用vbs实现获取电脑硬件信息的脚本_最新版


  本文标签:收集,硬件信息,vbs

主板驱动****************************************************************************************
  Version:3.1
       调整错误处理方法,错误信息输出到LogFile文件,可以查看扫描失败原因
           如果出现“RPC 服务器不可用”错误,是因为远程主机没开机
           如果出现“RPC 服务器不可用”之外的错误,可能是由于正在运行的程序造成,请你把此信息告诉我
           重启后再次扫描就可以排除非“RPC 服务器不可用 。”的错误
           如果扫描到的硬件信息为空,应该是驱动问题(或BIOS不完善),请自行解决
  Version:3.0
       增加输出BIOS的发行日期,和主板信息放在一起
  Version:2.9
       修正所有GetInfo过程遇错的处理方法,避免返回的数组上限不符合输出要求导致脚本报错 。
           之所以为出现这种情况,是因为Win32类检索不到硬件或连接到Win32类失败;
           原来判断是否出现Err,忽略了检索不到硬件的情况(连接成功无Err,Count为0)
           检索不到硬件多数是因为驱动没装好
  Version:2.8
       增加GetIDEProtocol过程,获取IDE控制器使用的协议,只是增加了代码,没有调用
       计划增加检索其它存储器控制器的过程
  Version:2.7
       检索硬盘/显卡/网卡/声卡的过程增加 DeviceID 属性(设备标识符)
           此属性不被输出,用于脚本内部判断
  Version:2.6
       原来输出搜索到的第一个硬盘
       改为输出搜索到的第一个InterfaceType属性为IDE的硬盘的信息
  Version:2.5
       增加Sort过程,排序硬件信息
  Version:2.4
       调整输出信息的分类,同类信息尽可能的只使用一个逗号分隔,以便导入xls后在同一列
       查询到的硬件信息如果是空或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
       初始版本 

  Option Explicit
  **************************************
  作 者: LZ-MyST QQ:8450919
  http://hi.baidu.com/lzmyst
  http://www.clxp.net.cn
  E-Mail:lzmyst@163.com
  你可以任意编辑、引用脚本的全部或部分代码
  转贴、引用脚本的全部或部分代码请保留版权
  **************************************

  ********************************说明开始*************************************
  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 = "pc021=administrator=cylslynetbar"
  Input = "PC001-109=administrator=cylslynetbar;pc110-85=administrator=LYjfnetbaradmin"
  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过程
        如果返回Err信息(字符串类型)输出计算机名[IP]、用户名、密码及错误信息到LogFile文件
传递:SWbemLocator对象ConnectServer方法的实例传递给OutInfo过程
      计算机名[IP]、命名空间、用户名、密码传递给LinkServer过程
*********************************************************************************
Function LinkRemoteServer(arrArray)
  Dim objErrLog, E, objLinkServer, objConnection, objWbemLocator, objErr
  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) & "=" & _
                          "错误编号:" & CStr(Err.Number) & _
                          ",错误原因:" & CStr(Err.Description) & _
                          ",错误来源:" & CStr(Err.Source) & " By LinkServer Function"
      intCount2 = intCount2 + 1
      Err.Clear
    Else
      objErr = OutInfo(objLinkServer)
      If Vartype(objErr) = 8 Then
        objErrLog.Writeline arrArray(E) & "=" & arrArray(E+1) & "=" & arrArray(E+2) & "=" & objErr
        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 Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    Exit Function
  End If
  strOutInfo = arrInfo(0) & "," & arrInfo(1) & "(" & arrInfo(2) & "),"
  主板
  arrInfo = GetBoardInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(0) & "(" & arrInfo(1) & ")"
  BIOS
  arrInfo = GetBIOSInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    Exit Function
  End If
  strOutInfo = strOutInfo & "(" & arrInfo(2) & "),"
  CPU
  arrInfo = GetCPUInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(1) & "(" & arrInfo(8) & ")," & arrInfo(4) & "," & _
               arrInfo(6) & "(" & arrInfo(7) & "),"
  内存
  arrInfo = GetMemoryInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    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
  硬盘
  Tmp = ""
  arrInfo = GetDiskInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    Exit Function
  End If
  For A = 1 To Ubound(arrInfo) Step 5
    If arrInfo(A+1) = "IDE" Then
      Tmp = arrInfo(A) & "(" & arrInfo(A+2) & "G),"
      Exit For
    End If
  Next
  If Tmp = "" Then
    strOutInfo = strOutInfo & "硬盘型号未检索到,"
  Else
    strOutInfo = strOutInfo & Tmp
  End If
  显卡
  arrInfo = GetVideoInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    Exit Function
  End If
  strOutInfo = strOutInfo & arrInfo(0) & "(" & arrInfo(1) & "M),"
  网卡
  arrInfo = GetNetworkInfo(objRemote)
  If Vartype(arrInfo) = 8 Then
    OutInfo = arrInfo
    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