用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:[email protected] 
'你可以任意编辑、引用脚本的全部或部分代码 
'转贴、引用脚本的全部或部分代码请保留版权 
'************************************** 
'********************************说明开始************************************* 
'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 
1
2
3
4
下一页
阅读全文
您可能感兴趣的文章:

用VBS控制鼠标的实现代码（获取鼠标坐标、鼠标移动、鼠标单击、鼠标双击、鼠标右击）
获取外网IP并发送到指定邮箱的vbs代码[已测]
vbs 获取当前目录的实现代码
VBS获取当前目录下所有文件夹名字的代码
vbs获取当前时间日期的代码
vbscript获取文件的创建时间、最后修改时间和最后访问时间的方法
vbs中获取脚本当前路径的2个方法
通过vbs获取远程host文件并保存到指定目录
VBScript获取CPU使用率的方法
使用vbs获取雅虎汇率

HTA文件去除html控件认证和接收命令行参数

最近看vbscript程序员参考手册第三版，讲到hta的两个应用 2009-07-07
VBS教程：属性-IsRootFolder 属性

VBS教程：属性-IsRootFolder 属性... 2006-11-11
拖拽文件显示文件路径的vbs代码

这篇文章主要介绍了拖拽文件显示文件路径的vbs代码,需要的朋友可以参考下 2019-12-12
WScript.Shell对象SpecialFolders属性未公开文档分享

WshShell对象的SpecialFolders属性返WshSpecialFolders 对象，该对象是一个特殊文件夹集合，其中包含整套Windows特殊文件夹 2013-01-01
VBS中的SetLocale函数到底有什么用？

写了这么多VBS，从来都没有使用过SetLocale函数，似乎也没有见过谁的代码使用过，这个SetLocale函数到底有什么用呢 2013-05-05
用vbs通过135端口执行命令的脚本

还是高手强通过下面的代码实现远程执行计算机的exe文件 2008-06-06
VBScript 算一算你从出生到现在共计多少天

VBScript 算一算你从出生到现在共计多少天，呵呵，努力奋斗吧 2009-11-11
用vbs实现禁用服务

用vbs实现禁用服务... 2007-03-03
用vbs模拟的一个asp的分页显示功能

用vbs模拟的一个asp的分页显示功能... 2007-03-03
用vbs确定用户的登录名的代码

用vbs确定用户的登录名的代码... 2007-03-03