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

代碼一：

'*******************************************************************************************  '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 
  

   當前1/4頁 
   1234下一頁閱讀全文