用vbs实现获取电脑硬件信息的脚本
导读：收集整理的这篇文章主要介绍了用vbs实现获取电脑硬件信息的脚本_最新版第1/4页，觉得挺不错的，现在分享给大家，也给大家做个参考。 代码一：'**********************...
收集整理的这篇文章主要介绍了用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 @R_777_1387@ ' 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 1234下一页阅读全文 您可能感兴趣的文章:- 用VBS控制鼠标的实现代码（获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击）
- 获取外网IP并发送到指定邮箱的vbs代码[已测]
- vbs 获取当前目录的实现代码
- VBS获取当前目录下所有文件夹名字的代码
- vbs获取当前时间日期的代码
- vbscript获取文件的创建时间、最后修改时间和最后访问时间的方法
- vbs中获取脚本当前路径的2个方法
- 通过vbs获取远程host文件并保存到指定目录
- VBScript获取CPU使用率的方法
- 使用vbs获取雅虎汇率
相关文章
-
vbs后台运行bat删除自身的代码
在VBS最后加上以下语句即可删除批处理和脚本本身（假设运行的批处理为 run.cmd ，启动批处理的脚本为 run.vbs ） 2008-08-08 -
VBS MD5加密算法代码
VBS MD5加密算法代码，需要的朋友可以参考下。 2009-12-12 -
百度空间备份脚本baidublogbak.vbs代码分析
cscript bak.vbs 百度用户名 第I页 至第n页 目录列表.htm 用户名 密码 2008-08-08 -
VBS合并一个文件夹里的TXT的实现代码
有时从网上的电子书网站上下载解压后。得到的是多个TXT文本。有没有办法把多个TXT合在一起看呢？写了个代码。不是很完美，欢迎高手批评指教。 我只是个菜鸟，需要大家的关怀才能进步哇 2013-01-01 -
使用 Iisftpdr.vbs 删除FTP虚拟目录(支持本地与远程)
这篇文章主要介绍了如何通过 iisftpdr.vbs 删除本地或远程计算机上的 FTP 虚拟目录的方法,需要的朋友可以参考下 2014-07-07 -
VBS教程：函数-WeekDayName 函数
VBS教程：函数-WeekDayName 函数... 2006-11-11 -
VBS教程：方法-DriveExists 方法
VBS教程：方法-DriveExists 方法... 2006-11-11 -
用VBS模拟实现PHP的sha1_file函数效果代码
用VBS模拟实现PHP的sha1_file函数效果代码,需要的朋友可以参考下。 2011-01-01 -
用vbs实现取消隐藏文件夹中的所有文件
用vbs实现取消隐藏文件夹中的所有文件... 2007-04-04 -
VBS教程：方法-GetSpecialFolder 方法
VBS教程：方法-GetSpecialFolder 方法... 2006-11-11
最新评论
声明：本文内容由网友自发贡献，本站不承担相应法律责任。对本内容有异议或投诉，请联系2913721942#qq.com核实处理，我们将尽快回复您，谢谢合作！
若转载请注明出处： 用vbs实现获取电脑硬件信息的脚本
本文地址： https://pptw.com/jishu/609566.html