用vbs實現擷取電腦硬體資訊的指令碼_最新版第1/4頁

來源:互聯網
上載者:User

'*******************************************************************************************
'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
' 初始版本

Option Explicit
'**************************************
'作 者: LZ-MyST QQ:8450919
'http://hi.baidu.com/lzmyst
'http://www.clxp.net.cn
'E-Mail:lzmyst@163.com
'你可以任意編輯、引用指令碼的全部或部分代碼
'轉貼、引用指令碼的全部或部分代碼請保留著作權
'**************************************

'********************************說明開始*************************************
'Input格式:起始IP-數量=使用者名稱=密碼;起始電腦名稱-數量=使用者名稱=密碼
' 多個配置項用“;”隔開
'例:192.168.0.1-10指明IP範圍為192.168.0.1~192.168.0.10,支援跨網段
'例:PC001-10指明範圍為PC001~PC010(電腦名稱可以包含-號)
'與指定格式不相同的,預設為單IP[電腦名稱],也可以在"未掃描的電腦.txt"裡配置
'"硬體資訊.txt"是以逗號分隔各項硬體資訊,你需要自己匯入XLS整理、精簡
'未掃描到的電腦,會把機號、使用者名稱、密碼儲存到"未掃描的電腦.txt"
'再次運行指令碼將唯讀取"未掃描的電腦.txt"裡的資訊(如果存在並且大小不為0)
'********************************說明結束*************************************

Dim Input, InfoOutFile, LogFile '請按格式給Input賦值
'Input = "pc021=administrator=cylslynetbar"
Input = "PC001-109=administrator=cylslynetbar;pc110-85=administrator=LYjfnetbaradmin"
InfoOutFile = "硬體資訊.txt"
LogFile = "未掃描的電腦.txt"

Redim arrConfig(0)
Dim WshShell, FSO, intCount1, intCount2
intCount1 = 0
intCount2 = 0
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = WScript.Createobject("Scripting.Filesystemobject")
ReadConfig
WshShell.Popup "掃描過程會很慢,請耐心等待,完成後會給出提示",,"掃描開始"
LinkRemoteServer arrConfig
Dim LenNum1, LenNum2
If intCount1 > intCount2 Then
LenNum1 = 0
LenNum2 = Len(intCount1) - Len(intCount2)
Else
LenNum1 = Len(intCount2) - Len(intCount1)
LenNum2 = 0
End If
Sort InfoOutFile
WshShell.Popup "掃描結果:" & _
vbCrLf & vbTab & "掃描成功:" & Space(LenNum1) & intCount1 & " 台" & _
vbCrLf & vbTab & "掃描失敗:" & Space(LenNum2) & intCount2 & " 台" & _
vbCrLf & "掃描失敗的電腦已做記錄,再次運行指令碼只掃描記錄裡的電腦",,"掃描完成"

Function ReadConfig
Dim objMatches, objMatche,objLogFile, arrLog, intUBarrConfig
If FSO.FileExists(LogFile) Then
If FSO.GetFile(LogFile).Size = 0 Then
Set objMatches = GetMatche("([^;=]+)=([^;=]+)=([^;=]+)", Input)
For Each objMatche In objMatches
GetConfig objMatche.SubMatches(0), objMatche.SubMatches(1), objMatche.SubMatches(2)
Next
If objMatches.Count = 0 Then
Msgbox "配置資訊格式不正確,請修改"
WScript.Quit
End If
Else
Set objLogFile = FSO.OpenTextFile(LogFile)
Do Until objLogFile.AtEndOfStream
arrLog = Split(objLogFile.ReadLine,"=")
intUBarrConfig = ((Ubound(arrConfig)+1)\3+1)*3-1
Redim Preserve arrConfig(intUBarrConfig)
arrConfig(intUBarrConfig-2) = arrLog(0)
arrConfig(intUBarrConfig-1) = arrLog(1)
arrConfig(intUBarrConfig-0) = arrLog(2)
Loop
End If
Else
Set objMatches = GetMatche("([^;=]+)=([^;=]+)=([^;=]+)", Input)
For Each objMatche In objMatches
GetConfig objMatche.SubMatches(0), objMatche.SubMatches(1), objMatche.SubMatches(2)
Next
If objMatches.Count = 0 Then
Msgbox "配置資訊格式不正確,請修改"
WScript.Quit
End If
End If
End Function

'*********************************************************************************
'目的:串連到遠程主機的WMI命名空間
'輸入:arrArray數組,包含有電腦名稱[IP]、使用者名稱、密碼
'調用:LinkServer過程
' 如果返回SWbemLocator對象ConnectServer方法的執行個體,調用OutInfo過程
' 如果返回Err資訊(字串類型),輸出電腦名稱[IP]、使用者名稱、密碼及錯誤資訊到LogFile檔案
' OutInfo過程
' 如果返回Err資訊(字串類型)輸出電腦名稱[IP]、使用者名稱、密碼及錯誤資訊到LogFile檔案
'傳遞:SWbemLocator對象ConnectServer方法的執行個體傳遞給OutInfo過程
' 電腦名稱[IP]、命名空間、使用者名稱、密碼傳遞給LinkServer過程
'*********************************************************************************
Function LinkRemoteServer(arrArray)
Dim objErrLog, E, objLinkServer, objConnection, objWbemLocator, objErr
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objErrLog = FSO.CreateTextFile(LogFile,True)
For E = 0 To Ubound(arrArray) Step 3
Set objLinkServer = LinkServer(arrConfig(E),"root\cimv2",arrConfig(E+1),arrConfig(E+2))
If Err Then
objErrLog.Writeline arrArray(E) & "=" & arrArray(E+1) & "=" & arrArray(E+2) & "=" & _
"錯誤編號:" & CStr(Err.Number) & _
",錯誤原因:" & CStr(Err.Description) & _
",錯誤來源:" & CStr(Err.Source) & " By LinkServer Function"
intCount2 = intCount2 + 1
Err.Clear
Else
objErr = OutInfo(objLinkServer)
If Vartype(objErr) = 8 Then
objErrLog.Writeline arrArray(E) & "=" & arrArray(E+1) & "=" & arrArray(E+2) & "=" & objErr
intCount2 = intCount2 + 1
End If
End If
Next
End Function

'******************************************************
'目的:輸出硬體資訊
'輸入:SWbemLocator對象ConnectServer方法的執行個體
'調用:擷取硬體資訊的GetXXXInfo過程
'傳遞:SWbemLocator對象ConnectServer方法的執行個體
'返回:所有調用的GetInfo過程都未返回Err對象,則返回True
' 某個GetInfo過程返回Err對象,則返回False
'******************************************************
Function OutInfo(objRemote)
Dim OutFile, arrInfo, strOutInfo, Tmp, A
If FSO.FileExists(InfoOutFile) Then
Set OutFile = FSO.OpenTextFile(InfoOutFile,8)
Else
Set OutFile = FSO.CreateTextFile(InfoOutFile)
OutFile.Writeline "電腦名稱,系統(初裝日期),主板型號(廠商)(發行日期),CPU型號(介面類型),外頻,L2容量(速度)," & _
"記憶體總量,記憶體速度(位置),記憶體類型(封裝類型),硬碟型號(容量),顯卡型號(顯存),網卡,IP/MAC"
End If
'系統
arrInfo = GetOSInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
strOutInfo = arrInfo(0) & "," & arrInfo(1) & "(" & arrInfo(2) & "),"
'主板
arrInfo = GetBoardInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
strOutInfo = strOutInfo & arrInfo(0) & "(" & arrInfo(1) & ")"
'BIOS
arrInfo = GetBIOSInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
strOutInfo = strOutInfo & "(" & arrInfo(2) & "),"
'CPU
arrInfo = GetCPUInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
strOutInfo = strOutInfo & arrInfo(1) & "(" & arrInfo(8) & ")," & arrInfo(4) & "," & _
arrInfo(6) & "(" & arrInfo(7) & "),"
'記憶體
arrInfo = GetMemoryInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
Tmp = 0
For A = 1 To Ubound(arrInfo) Step 6
Tmp = Tmp + Cint(arrInfo(A))
Next
strOutInfo = strOutInfo & arrInfo(0) & "條,共" & Tmp & "M,"
Tmp = ""
For A = 2 To Ubound(arrInfo) Step 6
If A = Ubound(arrInfo) - 4 Then
Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & "),"
Else
Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & ") "
End If
Next
strOutInfo = strOutInfo & Tmp
Tmp = ""
For A = 4 To Ubound(arrInfo) Step 6
If A = Ubound(arrInfo) - 2 Then
Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & "),"
Else
Tmp = Tmp & arrInfo(A) & "(" & arrInfo(A+1) & ") "
End If
Next
strOutInfo = strOutInfo & Tmp
'硬碟
Tmp = ""
arrInfo = GetDiskInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
For A = 1 To Ubound(arrInfo) Step 5
If arrInfo(A+1) = "IDE" Then
Tmp = arrInfo(A) & "(" & arrInfo(A+2) & "G),"
Exit For
End If
Next
If Tmp = "" Then
strOutInfo = strOutInfo & "硬碟型號未檢索到,"
Else
strOutInfo = strOutInfo & Tmp
End If
'顯卡
arrInfo = GetVideoInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
strOutInfo = strOutInfo & arrInfo(0) & "(" & arrInfo(1) & "M),"
'網卡
arrInfo = GetNetworkInfo(objRemote)
If Vartype(arrInfo) = 8 Then
OutInfo = arrInfo
Exit Function
End If
strOutInfo = strOutInfo & arrInfo(1) & "," & arrInfo(2) & Space(17-Len(arrInfo(2))) & arrInfo(3)
'輸出
OutFile.Writeline strOutInfo
intCount1 = intCount1 + 1
OutInfo = True
End Function

'*********************************************************
'目的:串連到遠程主機的WMI命名空間
'輸入:strComputer:遠程主機的電腦名稱或IP
' strNamespace:命令空間
' strUserName:使用者名稱
' strPassword:密碼
'返回:串連成功,返回SWbemLocator類串連遠程主機後的對象的執行個體
' 串連失敗,返回錯誤對象
'*********************************************************
Function LinkServer(strComputer,strNamespace,strUserName,strPassword)
Dim objWbemLocator
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Dim objConnection
On Error Resume Next
Set objConnection = objwbemLocator.ConnectServer _
(strComputer, strNamespace, strUserName, strPassword)
If Err Then
Set LinkServer = Err
Exit Function
End If
On Error Goto 0
objConnection.Security_.ImpersonationLevel = 3
Set LinkServer = objConnection
End Function

'******************************************
'目的:Regex
'輸入:strPatrn:Regex模式
' strString:要執行Regex的字串
'返回:Match對象
'******************************************
Function GetMatche(strPatrn, strString)
Dim RegEx
Set RegEx = New Regexp
RegEx.Global = True
RegEx.IgnoreCase =True
RegEx.Pattern = strPatrn
Set GetMatche = RegEx.Execute(strString)
End Function

'***************************************
'目的:2、8、16進位轉10進位
'輸入:strString:2、8、16進位數
' intNum:進位(2|8|16)
'返回:10進位數
'***************************************
Function ChangeToDecimal(strString, intNum)
ChangeToDecimal = 0
If Isnull(strString) Then ChangeToDecimal = 0 : Exit Function
Dim A, M
For A = 1 To Len(strString)
M = LCase(Mid(strString, A, 1))
Select Case M
Case "a" :M = 10
Case "b" :M = 11
Case "c" :M = 12
Case "d" :M = 13
Case "e" :M = 14
Case "f" :M = 15
End Select
ChangeToDecimal = ChangeToDecimal + M * intNum^(Len(strString)-A)
Next
End Function

相關文章

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.