html在线硬件信息,HTML_用vbs实现获取电脑硬件信息的脚本_最新版，'*************************************** - phpStudy...

用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相关阅读:

windows文件夹管理list视图方式

使用函数自动生成n层目录

如何快速找到CSS的BUG

Ctrl + Enter提交前检测的代码

(二)字的艺术

VBS教程：VBScript 语句-With 语句

ExtJS4 组件化编程，动态加载，面向对象，Direct

js怎样实现下拉框改变，它旁边的图像也改变

跨浏览器的设置innerHTML方法

javascript 闭包函数做显隐内容

Windows NT/2000操作系统认证方法

Oracle表空间恢复让你不再担心数据库出现错误

IE7新支持的CSS属性和属性选择符

SQL2008中SQL应用之－阻塞(Blocking)应用分析