注册
登录
比较迅速的获取硬件信息排序后的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:[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 比较迅速的获取硬件信息排序后的txt文件把后缀名改为csv就是表格了，精简、整理后输出打印就OK了。如此详细的信息，给老板看，一定可以让老板对你另眼相看。即使自己看，也能发现很多料想不到的的信息。 '******************************************************* '目的：分析配置信息 '输入：strIP, strUser, strPW：IP[计算机名]、账户、密码 '返回：无，直接把分析结果保存在数组 '******************************************************* Function GetConfig(strIP, strUser, strPW) Dim Matches, SubMatche Dim IP_1, IP_2, IP_3, IP_4, intStar, intEnd, A, intConfigNum Dim IP_Patrn IP_Patrn = "([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)-([\d]+)" Set Matches = GetMatche(IP_Patrn, strIP) If Matches.Count = 1 Then Set SubMatche = Matches(0) intStar = Cint(SubMatche.SubMatches(3)) intEnd = intStar + Cint(SubMatche.SubMatches(4)) - 1 For A = intStar To intEnd IP_4 = A Mod 256 IP_3 = (Cint(SubMatche.SubMatches(2))+ A\256) Mod 256 IP_2 = (Cint(SubMatche.SubMatches(1)) + (Cint(SubMatche.SubMatches(2))+ A\256)\256) Mod 256 IP_1 = Cint(SubMatche.SubMatches(0)) + (Cint(SubMatche.SubMatches(1)) + _ (Cint(SubMatche.SubMatches(2))+ A\256)\256)\256 If IP_1 > 223 Or IP_1 = 127 Or IP_1 < 1 Then Msgbox strIP & "包含的" & IP_1 & "." & IP_2 & "." & IP_3 & "." & IP_4 & _ "不是有效IP，此IP及之后的IP已被丢弃" Exit Function End If intConfigNum = (Ubound(arrConfig)+1)\3 + 1 Redim Preserve arrConfig(intConfigNum*3-1) arrConfig(intConfigNum*3-3) = IP_1 & "." & IP_2 & "." & IP_3 & "." & IP_4 arrConfig(intConfigNum*3-2) = strUser arrConfig(intConfigNum*3-1) = strPW Next Exit Function End If Dim ComputerName_Patrn, Prefix, intLen ComputerName_Patrn = "([\S]+[^0-9]{1})([0]*[\d]+)-([\d]+)" Set Matches = GetMatche(ComputerName_Patrn, strIP) If Matches.Count = 1 Then Set SubMatche = Matches(0) Prefix = SubMatche.SubMatches(0) intLen = Len(SubMatche.SubMatches(1)) intStar = Cint(SubMatche.SubMatches(1)) intEnd = intStar + Cint(SubMatche.SubMatches(2)) - 1 For A = intStar To intEnd intConfigNum = (Ubound(arrConfig)+1)\3 + 1 Redim Preserve arrConfig(intConfigNum*3-1) If Len(A) < intLen Then arrConfig(intConfigNum*3-3) = Prefix & String(intLen-Len(A),"0") & A Else arrConfig(intConfigNum*3-3) = Prefix & A End If arrConfig(intConfigNum*3-2) = strUser arrConfig(intConfigNum*3-1) = strPW Next Exit Function End If intConfigNum = (Ubound(arrConfig)+1)\3 + 1 Redim Preserve arrConfig(intConfigNum*3-1) arrConfig(intConfigNum*3-3) = strIP arrConfig(intConfigNum*3-2) = strUser arrConfig(intConfigNum*3-1) = strPW End Function '*********************************************************** '目的：获取操作系统信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为2 ' 取操作系统的3种属性： ' 0 1 2 ' CSName Caption&CSDVersion InstallDate ' 计算机名 系统名&SP版本 初装日期 'LastBootUpTime属性表示系统最近一次的启动时间 '*********************************************************** Function GetOSInfo(objConnection) Dim arrOSInfo Dim objSystemInfos, objSystemInfo, arrOS(2) Dim Tmp On Error Resume Next Set objSystemInfos = objConnection.InstancesOf("win32_operatingsystem") If Err Then GetOSInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objSystemInfos.Count If Err Then GetOSInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If For Each objSystemInfo In objSystemInfos arrOS(0) = objSystemInfo.CSName arrOS(1) = Replace(objSystemInfo.Caption,",","") & " " & objSystemInfo.CSDVersion arrOS(2) = Mid(CStr(objSystemInfo.InstallDate),1,4) & "-" & _ Mid(CStr(objSystemInfo.InstallDate),5,2) & "-" & _ Mid(CStr(objSystemInfo.InstallDate),7,2) '& ", " & _ 'Mid(CStr(objSystemInfo.InstallDate),9,2) & ":" & _ 'Mid(CStr(objSystemInfo.InstallDate),11,2) & ":" & _ 'Mid(CStr(objSystemInfo.InstallDate),13,2) Next If Err Then GetOSInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetOSInfo = arrOS On Error Goto 0 End Function '*********************************************************** '目的：获取主板信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为2 ' 取主板的3种属性： ' 0 1 2 ' Product Manufacturer Version ' 型号 厂商 版本 '*********************************************************** Function GetBoardInfo(objConnection) Dim objboards, objboard, arrBoard(2) Dim Tmp On Error Resume Next Set objboards = objConnection.InstancesOf("Win32_BaseBoard") If Err Then GetBoardInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objboards.Count If Err Then GetBoardInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If For each objboard In objboards arrBoard(0) = Replace(Trim(objboard.Product),",","") '型号 arrBoard(1) = Replace(Trim(objboard.Manufacturer),",","") '厂商 arrBoard(2) = Replace(Trim(objboard.Version),",","") '版本 Next If Err Then GetBoardInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetBoardInfo = arrBoard On Error Goto 0 End Function '*********************************************************** '目的：获取BIOS信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为2 ' 取BIOS的2种属性： ' 0 1 2 ' Manufacturer SMBIOSBIOSVersion ReleaseDate ' 厂商 版本 发行日期 '*********************************************************** Function GetBIOSInfo(objConnection) Dim objBIOSs, objBIOS, arrBIOS(2) Dim Tmp On Error Resume Next Set objBIOSs = objConnection.InstancesOf("Win32_BIOS") If Err Then GetBIOSInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetBIOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objBIOSs.Count If Err Then GetBIOSInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetBIOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If For each objBIOS In objBIOSs If Isnull(objBIOS.Manufacturer) Then arrBIOS(0) = "BIOS厂商不存在" '请检查主板驱动是否完善或未安装，或BIOS不完善需要刷BIOS Else arrBIOS(0) = Replace(Trim(objBIOS.Manufacturer),",","") End If If Isnull(objBIOS.SMBIOSBIOSVersion) Then arrBIOS(1) = "由SMBIOS汇报的BIOS版本不存在" '请检查主板驱动是否完善或未安装，或BIOS不完善需要刷BIOS Else arrBIOS(1) = Replace(Trim(objBIOS.SMBIOSBIOSVersion),",","") End If If Isnull(objBIOS.ReleaseDate) Then arrBIOS(2) = "BIOS发行日期未知" '请检查主板驱动是否完善或未安装，或BIOS不完善需要刷BIOS Else arrBIOS(2) = Left(Cstr(objBIOS.ReleaseDate),8) End If Next If Err Then GetBIOSInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetBIOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetBIOSInfo = arrBIOS On Error Goto 0 End Function '************************************************************ '目的：获取CPU信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为8 ' 取CPU的9种属性： ' 0 1 2 3 4 ' Name MaxClockSpeed CurrentVoltage ExtClock ' 核心数量 型号 主频 电压 外频 ' 5 6 7 8 ' AddressWidth L2CacheSize L2CacheSpeed SocketDesignation ' 位宽 L2容量 L2频率 插槽类型 '************************************************************ Function GetCPUInfo(objConnection) Dim objCPU, objCPUs, arrCPU(8) On Error Resume Next Set objCPUs = objConnection.InstancesOf("win32_processor") If Err Then GetCPUInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetCPUInfo Function" Err.Clear On Error Goto 0 Exit Function End If arrCPU(0) = objCPUs.Count '每个CPU核心都返回一个实例，实例数量即为CPU核心数量 If Err Then GetCPUInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetCPUInfo Function" Err.Clear On Error Goto 0 Exit Function End If For each objCPU In objCPUs arrCPU(1) = Replace(Trim(objCPU.Name),",","") '型号 arrCPU(2) = objCPU.MaxClockSpeed '主频 arrCPU(3) = ChangeToDecimal(objCPU.CurrentVoltage, 16)/10 '电压 arrCPU(4) = objCPU.ExtClock '外频 arrCPU(5) = objCPU.AddressWidth '位宽 arrCPU(6) = objCPU.L2CacheSize 'L2容量 arrCPU(7) = objCPU.L2CacheSpeed 'L2频率 arrCPU(8) = objCPU.SocketDesignation '插槽类型 Next If Err Then GetCPUInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetCPUInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetCPUInfo = arrCPU On Error Goto 0 End Function '******************************************************************************************** '目的：获取内存信息 '输入：SWbemLocator对象的ConnectServer方法连接到远程主机的实例 '返回：数组，上限为(内存条的数量*6)，0=内存条的数量 ' 取内存的6种属性： ' 1 2 3 4 5 6 ' capacity Speed DeviceLocator MemoryType FormFactor TypeDetail ' 容量 速度 插槽位置 内存类型 封装(接口)类型 详细类型-系统应用类型 'DeviceLocator属性表示这个内存所在的插槽 ' 一般是字符加数字，数字相当于主板上内存插槽的物理位置 '******************************************************************************************** Function GetMemoryInfo(objConnection) Dim objMemorys, objMemory, Num Redim arrMemory(0) On Error Resume Next Set objMemorys = objConnection.InstancesOf("Win32_PhysicalMemory") If Err Then GetMemoryInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetMemoryInfo Function" Err.Clear On Error Goto 0 Exit Function End If arrMemory(0) = objMemorys.Count '每条内存都返回一个实例，实例项数即内存条数量 If Err Then GetMemoryInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetMemoryInfo Function" Err.Clear On Error Goto 0 Exit Function End If Num = 0 For Each objMemory In objMemorys Num = Num + 1 Redim Preserve arrMemory(Num*6) arrMemory(Num*6-5) = objMemory.capacity/1048576 '容量(M) arrMemory(Num*6-4) = objMemory.Speed '速度(MHz) arrMemory(Num*6-3) = objMemory.DeviceLocator '插槽位置 Select Case objMemory.MemoryType '内存类型， Case 0 :arrMemory(Num*6-2) = "Unknown" '未知 Case 1 :arrMemory(Num*6-2) = "Other" '其它 Case 2 :arrMemory(Num*6-2) = "DRAM" '动态随机存储器 Case 3 :arrMemory(Num*6-2) = "Synchronous DRAM" '同步动态随机存储器 Case 4 :arrMemory(Num*6-2) = "Cache DRAM" '同步缓存动态随机存储器,三菱专利技术,插入一个SRAM作为二级CACHE使用 Case 5 :arrMemory(Num*6-2) = "EDO" '外扩充数据模式存储器(Extended Date Out) Case 6 :arrMemory(Num*6-2) = "EDRAM" '增强型动态随机存储器，在DRAM中包括了一小部分的SRAM(Enhanced DRAM) Case 7 :arrMemory(Num*6-2) = "VRAM" '视频存储器,专门为图形应用优化的存储器(Video DRAM) Case 8 :arrMemory(Num*6-2) = "SRAM" '静态随机存储器 Case 9 :arrMemory(Num*6-2) = "RAM" '随机存储器 Case 10 :arrMemory(Num*6-2) = "ROM" '只读存储器 Case 11 :arrMemory(Num*6-2) = "Flash" '闪速存储器,简称闪存(Flash Memory),属于EEPROM(电擦除可编程只读存储器)类型 Case 12 :arrMemory(Num*6-2) = "EEPROM" '电可擦写可编程只读存储器 Case 13 :arrMemory(Num*6-2) = "FEPROM" 'F什么可擦写可编程只读存储器 Case 14 :arrMemory(Num*6-2) = "EPROM" '可擦写可编程只读存储器(Erasable Programmable ROM) Case 15 :arrMemory(Num*6-2) = "CDRAM" '同步缓存动态随机存储器,即Cache DRAM Case 16 :arrMemory(Num*6-2) = "3DRAM" '3维视频处理器专用存储器(3 DIMESION RAM) Case 17 :arrMemory(Num*6-2) = "SDRAM" '同步动态随机存储器,即Synchronous DRAM Case 18 :arrMemory(Num*6-2) = "SGRAM" '单口随机存储器(Signal RAM) Case 19 :arrMemory(Num*6-2) = "RDRAM" '总线式动态随机存储器 Case 20 :arrMemory(Num*6-2) = "DDR" '双倍速率同步动态随机存储器,一个时钟周期内传输二次数据 Case 21 :arrMemory(Num*6-2) = "DDR-2" '双倍速率同步动态随机存储器2,一个时钟周期内传输二次数据,4bit数据预读取能力 End Select Select Case objMemory.FormFactor '封装类型(接口类型) Case 0 :arrMemory(Num*6-1) = "Unknown" '未知 Case 1 :arrMemory(Num*6-1) = "Other" '其它 Case 2 :arrMemory(Num*6-1) = "SIP" '单列直插式封装 Case 3 :arrMemory(Num*6-1) = "DIP" '双列直插式封装(Dual ln-line Package) Case 4 :arrMemory(Num*6-1) = "ZIP" '零插拔力封装(Zero Insertion Package) Case 5 :arrMemory(Num*6-1) = "SOJ" '小尺寸(小外形)J形引脚封装(Small Out-Line J-Lead) Case 6 :arrMemory(Num*6-1) = "Proprietary" '专有封装(有专利权的) Case 7 :arrMemory(Num*6-1) = "SIMM" '单列直插式封装(Single Inline Memory Module) Case 8 :arrMemory(Num*6-1) = "DIMM" '双列直插式封装(Dual Inline Memory Module) Case 9 :arrMemory(Num*6-1) = "TSOP" '薄型小尺寸封装(Thin Small Outline Package) Case 10 :arrMemory(Num*6-1) = "PGA" '陈列引脚封装。底面的垂直引脚呈陈列状排列。用于高速大规模逻辑LSI电路。 Case 11 :arrMemory(Num*6-1) = "RIMM" '总线式封装,RIMM是Rambus公司生产的RDRAM内存所采用的接口类型 Case 12 :arrMemory(Num*6-1) = "SODIMM" '小尺寸双列直插式封装(Small Outline DIMM Module) Case 13 :arrMemory(Num*6-1) = "SRIMM" '小尺寸总线式封装 Case 14 :arrMemory(Num*6-1) = "SMD" '表面贴装型封装(Surface Mounted Devices),也叫贴片封装 Case 15 :arrMemory(Num*6-1) = "SSMP" '未搜到此类型的信息，谁知道的请告诉偶，谢谢 Case 16 :arrMemory(Num*6-1) = "QFP" '方型扁平封装(Quad Flat Package) Case 17 :arrMemory(Num*6-1) = "TQFP" '薄方型扁平封装 Case 18 :arrMemory(Num*6-1) = "SOIC" '小尺寸集成电路封装,SOP(Small Outline Package，小外形封装)之一 Case 19 :arrMemory(Num*6-1) = "LCC" '无引脚封装,指只有电极接触而无引脚的表面贴装型封装 Case 20 :arrMemory(Num*6-1) = "PLCC" '塑封J形引脚封装 Case 21 :arrMemory(Num*6-1) = "BGA" '球栅阵列封装,在背面按陈列方式制作出球形凸点代替引脚 Case 22 :arrMemory(Num*6-1) = "FPBGA" '方型扁平球栅阵列封装 Case 23 :arrMemory(Num*6-1) = "LGA" '触点陈列封装。 End Select Select Case objMemory.TypeDetail '详细类型(系统用于那方面的应用) Case 1 :arrMemory(Num*6) = "Reserved" '预留 Case 2 :arrMemory(Num*6) = "Other" '其它 Case 4 :arrMemory(Num*6) = "Unknown" '未知 Case 8 :arrMemory(Num*6) = "Fast-paged" '快速分页 Case 16 :arrMemory(Num*6) = "Static column" '静态列 Case 32 :arrMemory(Num*6) = "Pseudo-static" '假静态 Case 64 :arrMemory(Num*6) = "RAMBUS" 'Rambus公司 Case 128 :arrMemory(Num*6) = "Synchronous" '同步 Case 256 :arrMemory(Num*6) = "CMOS" '互补 Case 512 :arrMemory(Num*6) = "EDO" '外扩充 Case 1024 :arrMemory(Num*6) = "Window DRAM" '视频 Case 2048 :arrMemory(Num*6) = "Cache DRAM" '缓存 Case 4096 :arrMemory(Num*6) = "Nonvolatile" '非易失性 End Select Next If Err Then GetMemoryInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetMemoryInfo Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrMemory(6) End If GetMemoryInfo = arrMemory On Error Goto 0 End Function '*************************************************************************************** '目的：获取硬盘信息 '输入：SWbemLocator对象的ConnectServer方法连接到远程主机的实例 '返回：数组，上限为(硬盘数量*5)，0=硬盘的数量 ' 取硬盘的4种属性： ' 1 2 3 4 5 ' Model InterfaceType Size MediaType DeviceID ' 型号 接口 容量 类型 设备标识符 '注意：InterfaceType是指接口类型，有5个值：SCSI、HDC、IDE、USB、1394 ' MediaType属性是指媒体类型： ' Vista下有四个值： External hard disk media:外接硬盘 ' Removable media other than floppy:移动媒体或软盘 ' Fixed hard disk media:固定硬盘 ' Format is unknown:未知类型 ' NT 4.0/2000/XP/2003下有三个值： Removable media:移动媒体 ' Fixed hard disk:固定硬盘 ' Unknown:未知类型 ' Size属性是1000进制，返回结果是以1024进制换算成G取小数点后二位数,和磁盘管理里看到的相同 '*************************************************************************************** Function GetDiskInfo(objConnection) Dim objDisks, objDisk, Num Dim Tmp On Error Resume Next Set objDisks = objConnection.InstancesOf("win32_Diskdrive") If Err Then GetDiskInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetDiskInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objDisks.Count If Err Then GetDiskInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetDiskInfo Function" Err.Clear On Error Goto 0 Exit Function End If Redim arrDisk(0) Num = 0 For Each objDisk In objDisks Num = Num + 1 Redim Preserve arrDisk(Num*5) arrDisk(Num*5-4) = Replace(Trim(objDisk.Model),",","") '型号 arrDisk(Num*5-3) = objDisk.InterfaceType '接口 arrDisk(Num*5-2) = Round(objDisk.Size/1073741824,2) '容量(G) arrDisk(Num*5-1) = objDisk.MediaType '类型 arrDisk(Num*5-0) = objDisk.DeviceID Next If Err Then GetDiskInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetDiskInfo Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrDisk(5) End If GetDiskInfo = arrDisk On Error Goto 0 End Function 比较迅速的获取硬件信息排序后的txt文件把后缀名改为csv就是表格了，精简、整理后输出打印就OK了。如此详细的信息，给老板看，一定可以让老板对你另眼相看。即使自己看，也能发现很多料想不到的的信息。 '*********************************************************** '目的：获取显卡信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为2 ' 取显卡的3种属性： ' 0 1 2 ' Description AdapterRAM DeviceID ' 描述 显存 设备标识符 '注意：AdapterRAM属性的单位是字节，返回结果已换算成M字节 '*********************************************************** Function GetVideoInfo(objConnection) Dim objVideos, objVideo, arrVideo(2) Dim Tmp On Error Resume Next Set objVideos = objConnection.InstancesOf("win32_videocontroller") If Err Then GetVideoInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetVideoInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objVideos.Count If Err Then GetVideoInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetVideoInfo Function" Err.Clear On Error Goto 0 Exit Function End If For Each objVideo In objVideos If Not IsNull(objVideo.VideoModeDescription) Then arrVideo(0) = Replace(Trim(objVideo.Description),",","") arrVideo(1) = objVideo.AdapterRAM/1048576 arrVideo(2) = objVideo.DeviceID End If Next If Err Then GetVideoInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetVideoInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetVideoInfo = arrVideo On Error Goto 0 End Function '************************************************************************ '目的：获取网卡信息(使用Ethernet 802.3协议的网络适配器，即以太网网卡) '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为(网卡数量*6)，0=网卡的数量 ' 取网卡的6种属性： ' 1 2 3 4 ' Description IPAddress(0) MACAddress IPXVirtualNetNumber ' 型号 IP MAC 内部网络号 ' 5 6 ' NetConnectionID DeviceID ' 接口名称 设备标识符 '************************************************************************ Function GetNetworkInfo(objConnection) Dim objNetworks, objNetwork, objNetworks_2, objNetwork_2, Num Dim Tmp Redim arrNetwork(0) Num = 0 On Error Resume Next Set objNetworks = objConnection.InstancesOf("Win32_NetworkAdapter") If Err Then GetNetworkInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objNetworks.Count If Err Then GetNetworkInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If Set objNetworks_2 = objConnection.InstancesOf("Win32_NetworkAdapterConfiguration") If Err Then GetNetworkInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objNetworks_2.Count If Err Then GetNetworkInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If For Each objNetwork In objNetworks If objNetwork.Manufacturer <> "Microsoft" And Not Isnull(objNetwork.MACAddress) Then Num = Num + 1 Redim Preserve arrNetwork(Num*6) arrNetwork(Num*6-5) = objNetwork.Description arrNetwork(Num*6-3) = Replace(objNetwork.MACAddress,":","-") arrNetwork(Num*6-0) = objNetwork.DeviceID arrNetwork(Num*6-1) = objNetwork.NetConnectionID If Err.Number = 438 Then arrNetwork(Num*6-1) = "未检测到" '2000系统不支持NetConnectionID属性 Err.Clear End If For Each objNetwork_2 In objNetworks_2 If objNetwork_2.Index = objNetwork.Index Then arrNetwork(Num*6-4) = objNetwork_2.IPAddress(0) 'IPAddress属性返回结果是数组 arrNetwork(Num*6-2) = objNetwork_2.IPXVirtualNetNumber Exit For End If Next End If Next If Err Then GetNetworkInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrNetwork(6) End If arrNetwork(0) = Num GetNetworkInfo = arrNetwork On Error Goto 0 End Function '*********************************************************** '目的：获取声卡信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限2 ' 取声卡的3种属性： ' 0 1 2 ' ProductName Manufacturer DeviceID ' 型号 厂商 设备标识符 '*********************************************************** Function GetSoundInfo(objConnection) Dim objSounds, objSound Dim Tmp Dim arrSound(2) On Error Resume Next Set objSounds = objConnection.InstancesOf("Win32_SoundDevice") If Err Then GetSoundInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetSoundInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objSounds.Count If Err Then GetSoundInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetSoundInfo Function" Err.Clear On Error Goto 0 Exit Function End If For Each objSound In objSounds arrSound(0) = Replace(objSound.ProductName,",","") arrSound(1) = Replace(objSound.Manufacturer,",","") arrSound(2) = objSound.DeviceID Next If Err Then GetSoundInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetSoundInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetSoundInfo = arrSound On Error Goto 0 End Function '***************************************************************** '目的：获取集成设备的信息 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为(集成设备数量*3)，0=集成设备的数量 ' 取集成设备的3种属性： ' 1 2 3 ' Description DeviceType Enabled ' 设备描述 类型 是否启用 '***************************************************************** Function GetOnBoardInfo(objConnection) Dim objOnBoards, objOnBoard, Num Redim arrOnBoard(0) Num = 0 On Error Resume Next Set objOnBoards = objConnection.InstancesOf("Win32_OnBoardDevice") If Err Then GetOnBoardInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetOnBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If arrOnBoard(0) = objOnBoards.Count If Err Then GetOnBoardInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetOnBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If For Each objOnBoard In objOnBoards Num = Num + 1 Redim Preserve arrOnBoard(Num*3) arrOnBoard(Num*3-2) = Replace(objOnBoard.Description,",","") Select Case objOnBoard.DeviceType Case 1 :arrOnBoard(Num*3-1) = "其它设备" Case 2 :arrOnBoard(Num*3-1) = "未知设备" Case 3 :arrOnBoard(Num*3-1) = "显示设备" Case 4 :arrOnBoard(Num*3-1) = "SCSI设备" Case 5 :arrOnBoard(Num*3-1) = "以太网设备" Case 6 :arrOnBoard(Num*3-1) = "令牌环网设备" Case 7 :arrOnBoard(Num*3-1) = "声音设备" End Select arrOnBoard(Num*3-0) = objOnBoard.Enabled Next If Err Then GetOnBoardInfo = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetOnBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrOnBoard(3) End If GetOnBoardInfo = arrOnBoard On Error Goto 0 End Function '*********** '排序硬件信息 '*********** Function Sort(FilePath) Dim ReadFile, Num, OutputFile, Item, A, B, strA, strB, Tmp Redim arrRead(0) Set ReadFile = FSO.OpenTextFile(FilePath) Do Until ReadFile.AtEndOfStream Num = ReadFile.Line Redim Preserve arrRead(Num) arrRead(Num-1) = ReadFile.ReadLine Loop Set ReadFile = Nothing For A = 1 To Ubound(arrRead) - 2 For B = A + 1 To Ubound(arrRead) - 1 If Not Strcomp(arrRead(A),arrRead(B)) Then Tmp = arrRead(A) arrRead(A) = arrRead(B) arrRead(B) = Tmp End If Next Next Set OutputFile = FSO.OpenTextFile(FSO.GetBaseName(FilePath) & "_已排序." & _ FSO.GetExtensionName(FilePath),2,True) For Each Item In arrRead OutputFile.Writeline Item Next Set OutputFile = Nothing End Function 比较迅速的获取硬件信息排序后的txt文件把后缀名改为csv就是表格了，精简、整理后输出打印就OK了。如此详细的信息，给老板看，一定可以让老板对你另眼相看。即使自己看，也能发现很多料想不到的的信息。 '******************************************************************** '目的：获取IDE控制器使用的访问受控设备的协议 '输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例 '返回：数组，上限为(IDE控制器数量*2)，0=IDE控制器数量 ' 取2种属性： ' 1 2 ' DeviceID ProtocolSupported ' 设备标识符 控制协议 '******************************************************************** Function GetIDEProtocol(objConnection) Dim objIDEProtocol, IDEItem, Num Dim Tmp Redim arrIDE(0) Num = 0 On Error Resume Next Set objIDEProtocol = objConnection.InstancesOf("Win32_IDEController") If Err Then GetIDEProtocol = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetIDEProtocol Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objIDEProtocol.Count If Err Then GetIDEProtocol = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetIDEProtocol Function" Err.Clear On Error Goto 0 Exit Function End If For Each IDEItem In objIDEProtocol 'Msgbox IDEItem.DeviceID & vbCrLf & IDEItem.ProtocolSupported Num = Num + 1 Redim Preserve arrIDE(Num*2) arrIDE(Num*2-1) = IDEItem.DeviceID Select Case IDEItem.ProtocolSupported Case 1 :arrIDE(Num*2) = "Other" Case 2 :arrIDE(Num*2) = "Unknown" Case 3 :arrIDE(Num*2) = "EISA" Case 4 :arrIDE(Num*2) = "ISA" Case 5 :arrIDE(Num*2) = "PCI" Case 6 :arrIDE(Num*2) = "ATA/ATAPI" Case 7 :arrIDE(Num*2) = "Flexible Diskette" Case 8 :arrIDE(Num*2) = "1496" Case 9 :arrIDE(Num*2) = "SCSI Parallel Interface" Case 10 :arrIDE(Num*2) = "SCSI Fibre Channel Protocol" Case 11 :arrIDE(Num*2) = "SCSI Serial Bus Protocol" Case 12 :arrIDE(Num*2) = "SCSI Serial Bus Protocol-2 (1394)" Case 13 :arrIDE(Num*2) = "SCSI Serial Storage Architecture" Case 14 :arrIDE(Num*2) = "VESA" Case 15 :arrIDE(Num*2) = "PCMCIA" Case 16 :arrIDE(Num*2) = "Universal Serial Bus" Case 17 :arrIDE(Num*2) = "Parallel Protocol" Case 18 :arrIDE(Num*2) = "ESCON" Case 19 :arrIDE(Num*2) = "Diagnostic" Case 20 :arrIDE(Num*2) = "I2C" Case 21 :arrIDE(Num*2) = "Power" Case 22 :arrIDE(Num*2) = "HIPPI" Case 23 :arrIDE(Num*2) = "MultiBus" Case 24 :arrIDE(Num*2) = "VME" Case 25 :arrIDE(Num*2) = "IPI" Case 26 :arrIDE(Num*2) = "IEEE-488" Case 27 :arrIDE(Num*2) = "RS232" Case 28 :arrIDE(Num*2) = "IEEE 802.3 10BASE5" Case 29 :arrIDE(Num*2) = "IEEE 802.3 10BASE2" Case 30 :arrIDE(Num*2) = "IEEE 802.3 1BASE5" Case 31 :arrIDE(Num*2) = "IEEE 802.3 10BROAD36" Case 32 :arrIDE(Num*2) = "IEEE 802.3 100BASEVG" Case 33 :arrIDE(Num*2) = "IEEE 802.5 Token-Ring" Case 34 :arrIDE(Num*2) = "ANSI X3T9.5 FDDI" Case 35 :arrIDE(Num*2) = "MCA" Case 36 :arrIDE(Num*2) = "ESDI" Case 37 :arrIDE(Num*2) = "IDE" Case 38 :arrIDE(Num*2) = "CMD" Case 39 :arrIDE(Num*2) = "ST506" Case 40 :arrIDE(Num*2) = "DSSI" Case 41 :arrIDE(Num*2) = "QIC2" Case 42 :arrIDE(Num*2) = "Enhanced ATA/IDE" Case 43 :arrIDE(Num*2) = "AGP" Case 44 :arrIDE(Num*2) = "TWIRP (two-way infrared)" Case 45 :arrIDE(Num*2) = "FIR (fast infrared)" Case 46 :arrIDE(Num*2) = "SIR (serial infrared)" Case 47 :arrIDE(Num*2) = "IrBus" End Select Next If Err Then GetIDEProtocol = "错误编号：" & CStr(Err.Number) & _ "，错误原因：" & CStr(Err.Description) & _ "，错误来源：" & CStr(Err.Source) & " By GetIDEProtocol Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrIDE(2) End If arrIDE(0) = Num GetIDEProtocol = arrIDE On Error Goto 0 End Function '******************************************************************************************* '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属性(接口名称)为空的适配器 |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
