铁雪资源网 Design By www.gsvan.com
代码一:
'******************************************************************************************* '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 1234下一页阅读全文
标签:
收集,硬件信息,vbs
铁雪资源网 Design By www.gsvan.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
铁雪资源网 Design By www.gsvan.com
暂无用vbs实现获取电脑硬件信息的脚本_最新版第1/4页的评论...
稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!
昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。
这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。
而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?