文章详情

短信预约-IT技能 免费直播动态提醒

请输入下面的图形验证码

提交验证

短信预约提醒成功

怎么用vbs实现获取电脑硬件信息

2023-06-08 12:15

关注

这篇文章主要为大家展示了“怎么用vbs实现获取电脑硬件信息”,内容简而易懂,条理清晰,希望能够帮助大家解决疑惑,下面让小编带领大家一起研究并学习一下“怎么用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    '********************************说明开始*************************************  '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

以上是“怎么用vbs实现获取电脑硬件信息”这篇文章的所有内容,感谢各位的阅读!相信大家都有了一定的了解,希望分享的内容对大家有所帮助,如果还想学习更多知识,欢迎关注编程网行业资讯频道!

阅读原文内容投诉

免责声明:

① 本站未注明“稿件来源”的信息均来自网络整理。其文字、图片和音视频稿件的所属权归原作者所有。本站收集整理出于非商业性的教育和科研之目的,并不意味着本站赞同其观点或证实其内容的真实性。仅作为临时的测试数据,供内部测试之用。本站并未授权任何人以任何方式主动获取本站任何信息。

② 本站未注明“稿件来源”的临时测试数据将在测试完成后最终做删除处理。有问题或投稿请发送至: 邮箱/279061341@qq.com QQ/279061341

软考中级精品资料免费领

  • 历年真题答案解析
  • 备考技巧名师总结
  • 高频考点精准押题
  • 2024年上半年信息系统项目管理师第二批次真题及答案解析(完整版)

    难度     807人已做
    查看
  • 【考后总结】2024年5月26日信息系统项目管理师第2批次考情分析

    难度     351人已做
    查看
  • 【考后总结】2024年5月25日信息系统项目管理师第1批次考情分析

    难度     314人已做
    查看
  • 2024年上半年软考高项第一、二批次真题考点汇总(完整版)

    难度     433人已做
    查看
  • 2024年上半年系统架构设计师考试综合知识真题

    难度     221人已做
    查看

相关文章

发现更多好内容

猜你喜欢

AI推送时光机
位置:首页-资讯-后端开发
咦!没有更多了?去看看其它编程学习网 内容吧
首页课程
资料下载
问答资讯