Welcome 微信登录
编程资源 图片资源库

首页 / 编程脚本 / 用vbs实现获取电脑硬件信息的脚本_最新版第1/4页

"*******************************************************************************************
  "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）,"rootcimv2",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
当前1/4页 1234下一页
版权所有©石家庄振强科技有限公司2024 冀ICP备08103738号-5 网站地图