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