用vbs实现获取电脑硬件信息的脚本_最新版第4/4页

'******************************************************************** '目的：获取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属性(接口名称)为空的适配器 'Version:1.0 ' 初始版本 '*******************************************************************************************

Set wmi=GetObject("winmgmts:\\")Set board=wmi.instancesof("win32_baseboard")For Each b In boardmsg="主板："&b.Manufacturer&vbTab&b.product&vbTab&Chr(13)Nextmsg=msg&Chr(13)&"---"+Chr(13)Set cpus=wmi.instancesof("win32_processor")msg=msg&"CPU 特征:"+Chr(13)For Each cpu In cpusmsg=msg+cpu.deviceid&vbTab&cpu.name&Chr(13) _&vbtab&cpu.SocketDesignation&vbtab&cpu.CurrentClockSpeed&"MHz"&vbtab&cpu.l2cachesize&"Kb_L2"&Chr(13)Nextmsg=msg&Chr(13)&"---"+Chr(13)Set mem=wmi.instancesof("win32_physicalmemory")msg=msg&"内存容量："+Chr(13)For Each  m In memmsg=msg&m.tag&space(10)&m.capacity&+Chr(13)NextSet mem=wmi.instancesof("win32_computersystem")For Each m In memmsg=msg&"内存总容量："&Round((m.totalphysicalmemory/1024^2),2)&"M"+Chr(13)Nextmsg=msg&Chr(13)&"---"+Chr(13)Set display=wmi.instancesof("Win32_videocontroller")msg=msg&"显示系统："+Chr(13)For Each   video In displaymsg=msg&video.deviceid&vbTab&video.name&Chr(13)Nextmsg=msg&Chr(13)&"---"+Chr(13)Set disks=wmi.instancesof("win32_diskdrive")msg=msg&"硬盘容量："+Chr(13)For Each d In disksIf int(d.size/(1024^3))=0 Then n=Round(d.size/(1024^2),2)&"M"Elsen=Round(d.size/(1024^3),2)&"G"End Ifmsg=msg+d.deviceid&"   空间为： "&n&Chr(13)Nextmsg=msg&Chr(13)&"---"+Chr(13)MsgBox msg,0,"电脑基本特征"