用vbs实现获取电脑硬件信息的脚本-1
2011年11月19日
比较迅速的获取硬件信息排序后的txt文件把后缀名改为csv就是表格了,精简、整理后输出打印就OK了。如此详细的信息,给老板看,一定可以让老板对你另眼相看。即使自己看,也能发现很多料想不到的的信息。
'*******************************************************************************************
'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
详细出处参考:http://www.jb51.net/article/14344.htm
发表评论
-
[转]命令行创建快捷方式的批处理脚本
2012-01-20 10:02 918[转]命令行创建快捷方式的批处理脚本 2010年10月27日 ... -
自动化测试规范小结
2012-01-20 10:02 867自动化测试规范小结 20 ... -
自动获取CPU使用率的脚本
2012-01-20 10:02 1102自动获取CPU使用率的脚本 2011年04月28日 一个 ... -
业务组件学习资料
2012-01-20 10:01 639业务组件学习资料 2011 ... -
批量修改多个文件内容的脚本
2012-01-20 10:01 1018批量修改多个文件内容的脚本 2010年07月30日 如果 ... -
【黑客】利用VBS脚本让QQ永远在线,等级速升
2012-01-19 15:03 548【黑客】利用VBS脚本让QQ永远在线,等级速升 2010年0 ... -
Adsutil.vbs在脚本入侵中的妙用
2012-01-19 15:03 521Adsutil.vbs在脚本入侵中的妙用 2011年03月0 ... -
利用VBS脚本让qq永远在线
2012-01-19 15:03 603利用VBS脚本让qq永远在线 2011年06月07日 让 ... -
vbs脚本实例
2012-01-19 15:03 732vbs脚本实例 2011年02月28日 rem 结束QQ ... -
FLTK简介
2012-01-17 04:49 886FLTK简介 2011年11月22日 ... -
J2SE简介与J2EE、J2ME的比较
2012-01-17 04:49 471J2SE简介与J2EE、J2ME的比较 2010年06月15 ... -
cegui基础
2012-01-17 04:49 1209cegui基础 2010年11月12日 ... -
perfHUD使用说明
2012-01-17 04:49 647perfHUD使用说明 2011年04月14日 perf ... -
数学二分法解方程vbs脚本――超简单的
2012-01-16 03:40 767数学二分法解方程vbs脚本――超简单的 2009年10月31 ... -
VBS脚本
2012-01-16 03:40 684VBS脚本 2011年06月30日 我用VBS写的往EX ... -
xp、2003开3389+非net创建管理用户+Shift后门+自删除脚本+提权VBS 整理收集
2012-01-16 03:40 920xp、2003开3389+非net创建管理用户+Shift后门 ... -
Trojan.DL.VBS.Agent.r 脚本病毒 ASP解密
2012-01-16 03:40 593Trojan.DL.VBS.Agent.r 脚本病毒 ASP解 ... -
双击盘符提示“Windows脚本宿主”无法找到脚本文件autorun.vbs的解决办法
2012-01-16 03:40 853双击盘符提示“Windows脚本宿主”无法找到脚本文件auto ...
相关推荐
126邮箱页 html源码 单页源码 网站后台登陆界面HTML源码
武汉开放数据创新大赛——烽火杯文件
mmexport1713881481676.png
Digital currency trading platform landing pageAdobeXD源码下载设计素材UI设计
了解Java及环境搭建
专业实习-三创赛
第三届全国大学生服务外包创新创业大赛(智能楼宇能耗管理系统)
allPort Design SystemAdobeXD源码下载设计素材UI设计
系统介绍 本系统根据企业的需求进行设计,具有以下特点:界面友好,采用人机对话方式,操作简单。信息查询灵活、快捷、数据存储安全。实现用户管理功能,主要包括用户登录与注册功能。对用户输入的数据,系统进行严格的数据检查,尽可能排除人为错误。要实现模糊查询功能,允许用户查询一类的文章。系统运行稳定,安全可靠。 操作注意事项 本系统的后台用户名为:mr,密码为:mrsoft 操作流程 (1)通过首页提供的数据可实现搜索数据。 (2)可通过首页的“进入论坛”超链接进入论坛区,此时用户可以浏览文章,并为文章添加评论。 (3)访客可登录系统来发表文章。
【资源说明】 【备注】 1、该项目是高分毕业设计项目源码,已获导师指导认可通过,答辩评审分达到95分 2、该资源内项目代码都经过mac/window10/11/linux测试运行成功,功能ok的情况下才上传的,请放心下载使用! 3、本项目适合计算机相关专业(如软件工程、计科、人工智能、通信工程、自动化、电子信息等)的在校学生、老师或者企业员工下载使用,也可作为毕业设计、课程设计、作业、项目初期立项演示等,当然也适合小白学习进阶。 4、如果基础还行,可以在此代码基础上进行修改,以实现其他功能,也可直接用于毕设、课设、作业等。 欢迎下载,沟通交流,互相学习,共同进步!
hikvision-find-info.yaml
Portfolio_Responsive_Landing_PageAdobeXD源码下载设计素材UI设计
【资源说明】 高分毕业设计 基于Python+Flas+微信小程序的教室空间可视化分析系统源码+部署文档+全部数据资料高分毕业设计 基于Python+Flas+微信小程序的教室空间可视化分析系统源码+部署文档+全部数据资料 【备注】 1、该项目是高分毕业设计项目源码,已获导师指导认可通过,答辩评审分达到95分 2、该资源内项目代码都经过mac/window10/11/linux测试运行成功,功能ok的情况下才上传的,请放心下载使用! 3、本项目适合计算机相关专业(如软件工程、计科、人工智能、通信工程、自动化、电子信息等)的在校学生、老师或者企业员工下载使用,也可作为毕业设计、课程设计、作业、项目初期立项演示等,当然也适合小白学习进阶。 4、如果基础还行,可以在此代码基础上进行修改,以实现其他功能,也可直接用于毕设、课设、作业等。 欢迎下载,沟通交流,互相学习,共同进步!
Bakery_Responsive_Landing_PageAdobeXD源码下载设计素材UI设计
Crypto_Responsive_Landing_PageAdobeXD源码下载设计素材UI设计
code-aipaca
DailyRecipeAdobeXD源码下载设计素材UI设计
数据手册
算法 堆排序12.java 使用java代码实现 堆排序12.java 使用java代码实现 堆排序12.java 使用java代码实现 堆排序12.java 使用java代码实现 堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.java 使用java代码实现堆排序12.jav
微信小程序