'********************************************************************
'目的：获取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
' 初始版本
'*******************************************************************************************
文章评论
共有 位脚本之家网友发表了评论我来说两句