'*********************************************************** '目的：獲取顯卡信息 '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為2 ' 取顯卡的3種屬性： ' 0 1 2 ' Description AdapterRAM DeviceID ' 描述 顯存 設(shè)備標(biāo)識(shí)符 '注意：AdapterRAM屬性的單位是字節(jié)，返回結(jié)果已換算成M字節(jié) '*********************************************************** Function GetVideoInfo(objConnection) Dim objVideos, objVideo, arrVideo(2) Dim Tmp On Error Resume Next Set objVideos = objConnection.InstancesOf("win32_videocontroller") If Err Then GetVideoInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetVideoInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objVideos.Count If Err Then GetVideoInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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 = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetVideoInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetVideoInfo = arrVideo On Error Goto 0 End Function '************************************************************************ '目的：獲取網(wǎng)卡信息(使用Ethernet 802.3協(xié)議的網(wǎng)絡(luò)適配器，即以太網(wǎng)網(wǎng)卡) '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為(網(wǎng)卡數(shù)量*6)，0=網(wǎng)卡的數(shù)量 ' 取網(wǎng)卡的6種屬性： ' 1 2 3 4 ' Description IPAddress(0) MACAddress IPXVirtualNetNumber ' 型號(hào) IP MAC 內(nèi)部網(wǎng)絡(luò)號(hào) ' 5 6 ' NetConnectionID DeviceID ' 接口名稱 設(shè)備標(biāo)識(shí)符 '************************************************************************ 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 = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objNetworks.Count If Err Then GetNetworkInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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 = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetNetworkInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objNetworks_2.Count If Err Then GetNetworkInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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系統(tǒng)不支持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屬性返回結(jié)果是數(shù)組 arrNetwork(Num*6-2) = objNetwork_2.IPXVirtualNetNumber Exit For End If Next End If Next If Err Then GetNetworkInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限2 ' 取聲卡的3種屬性： ' 0 1 2 ' ProductName Manufacturer DeviceID ' 型號(hào) 廠商 設(shè)備標(biāo)識(shí)符 '*********************************************************** 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 = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetSoundInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objSounds.Count If Err Then GetSoundInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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 = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetSoundInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetSoundInfo = arrSound On Error Goto 0 End Function '***************************************************************** '目的：獲取集成設(shè)備的信息 '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為(集成設(shè)備數(shù)量*3)，0=集成設(shè)備的數(shù)量 ' 取集成設(shè)備的3種屬性： ' 1 2 3 ' Description DeviceType Enabled ' 設(shè)備描述 類型 是否啟用 '***************************************************************** 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 = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetOnBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If arrOnBoard(0) = objOnBoards.Count If Err Then GetOnBoardInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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) = "其它設(shè)備" Case 2 :arrOnBoard(Num*3-1) = "未知設(shè)備" Case 3 :arrOnBoard(Num*3-1) = "顯示設(shè)備" Case 4 :arrOnBoard(Num*3-1) = "SCSI設(shè)備" Case 5 :arrOnBoard(Num*3-1) = "以太網(wǎng)設(shè)備" Case 6 :arrOnBoard(Num*3-1) = "令牌環(huán)網(wǎng)設(shè)備" Case 7 :arrOnBoard(Num*3-1) = "聲音設(shè)備" End Select arrOnBoard(Num*3-0) = objOnBoard.Enabled Next If Err Then GetOnBoardInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & 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

最新評(píng)論