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

'*********************************************************** '目的：获取显卡信息 '输入：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

最新评论