'******************************************************* '目的：分析配置信息 '輸入：strIP, strUser, strPW：IP[計(jì)算機(jī)名]、賬戶、密碼 '返回：無，直接把分析結(jié)果保存在數(shù)組 '******************************************************* Function GetConfig(strIP, strUser, strPW) Dim Matches, SubMatche Dim IP_1, IP_2, IP_3, IP_4, intStar, intEnd, A, intConfigNum Dim IP_Patrn IP_Patrn = "([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)-([\d]+)" Set Matches = GetMatche(IP_Patrn, strIP) If Matches.Count = 1 Then Set SubMatche = Matches(0) intStar = Cint(SubMatche.SubMatches(3)) intEnd = intStar + Cint(SubMatche.SubMatches(4)) - 1 For A = intStar To intEnd IP_4 = A Mod 256 IP_3 = (Cint(SubMatche.SubMatches(2))+ A\256) Mod 256 IP_2 = (Cint(SubMatche.SubMatches(1)) + (Cint(SubMatche.SubMatches(2))+ A\256)\256) Mod 256 IP_1 = Cint(SubMatche.SubMatches(0)) + (Cint(SubMatche.SubMatches(1)) + _ (Cint(SubMatche.SubMatches(2))+ A\256)\256)\256 If IP_1 > 223 Or IP_1 = 127 Or IP_1 < 1 Then Msgbox strIP & "包含的" & IP_1 & "." & IP_2 & "." & IP_3 & "." & IP_4 & _ "不是有效IP，此IP及之后的IP已被丟棄" Exit Function End If intConfigNum = (Ubound(arrConfig)+1)\3 + 1 Redim Preserve arrConfig(intConfigNum*3-1) arrConfig(intConfigNum*3-3) = IP_1 & "." & IP_2 & "." & IP_3 & "." & IP_4 arrConfig(intConfigNum*3-2) = strUser arrConfig(intConfigNum*3-1) = strPW Next Exit Function End If Dim ComputerName_Patrn, Prefix, intLen ComputerName_Patrn = "([\S]+[^0-9]{1})([0]*[\d]+)-([\d]+)" Set Matches = GetMatche(ComputerName_Patrn, strIP) If Matches.Count = 1 Then Set SubMatche = Matches(0) Prefix = SubMatche.SubMatches(0) intLen = Len(SubMatche.SubMatches(1)) intStar = Cint(SubMatche.SubMatches(1)) intEnd = intStar + Cint(SubMatche.SubMatches(2)) - 1 For A = intStar To intEnd intConfigNum = (Ubound(arrConfig)+1)\3 + 1 Redim Preserve arrConfig(intConfigNum*3-1) If Len(A) < intLen Then arrConfig(intConfigNum*3-3) = Prefix & String(intLen-Len(A),"0") & A Else arrConfig(intConfigNum*3-3) = Prefix & A End If arrConfig(intConfigNum*3-2) = strUser arrConfig(intConfigNum*3-1) = strPW Next Exit Function End If intConfigNum = (Ubound(arrConfig)+1)\3 + 1 Redim Preserve arrConfig(intConfigNum*3-1) arrConfig(intConfigNum*3-3) = strIP arrConfig(intConfigNum*3-2) = strUser arrConfig(intConfigNum*3-1) = strPW End Function '*********************************************************** '目的：獲取操作系統(tǒng)信息 '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為2 ' 取操作系統(tǒng)的3種屬性： ' 0 1 2 ' CSName Caption&CSDVersion InstallDate ' 計(jì)算機(jī)名 系統(tǒng)名&SP版本 初裝日期 'LastBootUpTime屬性表示系統(tǒng)最近一次的啟動(dòng)時(shí)間 '*********************************************************** Function GetOSInfo(objConnection) Dim arrOSInfo Dim objSystemInfos, objSystemInfo, arrOS(2) Dim Tmp On Error Resume Next Set objSystemInfos = objConnection.InstancesOf("win32_operatingsystem") If Err Then GetOSInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objSystemInfos.Count If Err Then GetOSInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If For Each objSystemInfo In objSystemInfos arrOS(0) = objSystemInfo.CSName arrOS(1) = Replace(objSystemInfo.Caption,",","") & " " & objSystemInfo.CSDVersion arrOS(2) = Mid(CStr(objSystemInfo.InstallDate),1,4) & "-" & _ Mid(CStr(objSystemInfo.InstallDate),5,2) & "-" & _ Mid(CStr(objSystemInfo.InstallDate),7,2) '& ", " & _ 'Mid(CStr(objSystemInfo.InstallDate),9,2) & ":" & _ 'Mid(CStr(objSystemInfo.InstallDate),11,2) & ":" & _ 'Mid(CStr(objSystemInfo.InstallDate),13,2) Next If Err Then GetOSInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetOSInfo = arrOS On Error Goto 0 End Function '*********************************************************** '目的：獲取主板信息 '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為2 ' 取主板的3種屬性： ' 0 1 2 ' Product Manufacturer Version ' 型號(hào) 廠商 版本 '*********************************************************** Function GetBoardInfo(objConnection) Dim objboards, objboard, arrBoard(2) Dim Tmp On Error Resume Next Set objboards = objConnection.InstancesOf("Win32_BaseBoard") If Err Then GetBoardInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objboards.Count If Err Then GetBoardInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If For each objboard In objboards arrBoard(0) = Replace(Trim(objboard.Product),",","") '型號(hào) arrBoard(1) = Replace(Trim(objboard.Manufacturer),",","") '廠商 arrBoard(2) = Replace(Trim(objboard.Version),",","") '版本 Next If Err Then GetBoardInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetBoardInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetBoardInfo = arrBoard On Error Goto 0 End Function '*********************************************************** '目的：獲取BIOS信息 '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為2 ' 取BIOS的2種屬性： ' 0 1 2 ' Manufacturer SMBIOSBIOSVersion ReleaseDate ' 廠商 版本 發(fā)行日期 '*********************************************************** Function GetBIOSInfo(objConnection) Dim objBIOSs, objBIOS, arrBIOS(2) Dim Tmp On Error Resume Next Set objBIOSs = objConnection.InstancesOf("Win32_BIOS") If Err Then GetBIOSInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetBIOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objBIOSs.Count If Err Then GetBIOSInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetBIOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If For each objBIOS In objBIOSs If Isnull(objBIOS.Manufacturer) Then arrBIOS(0) = "BIOS廠商不存在" '請(qǐng)檢查主板驅(qū)動(dòng)是否完善或未安裝，或BIOS不完善需要刷BIOS Else arrBIOS(0) = Replace(Trim(objBIOS.Manufacturer),",","") End If If Isnull(objBIOS.SMBIOSBIOSVersion) Then arrBIOS(1) = "由SMBIOS匯報(bào)的BIOS版本不存在" '請(qǐng)檢查主板驅(qū)動(dòng)是否完善或未安裝，或BIOS不完善需要刷BIOS Else arrBIOS(1) = Replace(Trim(objBIOS.SMBIOSBIOSVersion),",","") End If If Isnull(objBIOS.ReleaseDate) Then arrBIOS(2) = "BIOS發(fā)行日期未知" '請(qǐng)檢查主板驅(qū)動(dòng)是否完善或未安裝，或BIOS不完善需要刷BIOS Else arrBIOS(2) = Left(Cstr(objBIOS.ReleaseDate),8) End If Next If Err Then GetBIOSInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetBIOSInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetBIOSInfo = arrBIOS On Error Goto 0 End Function '************************************************************ '目的：獲取CPU信息 '輸入：SWbemLocator對(duì)象ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為8 ' 取CPU的9種屬性： ' 0 1 2 3 4 ' Name MaxClockSpeed CurrentVoltage ExtClock ' 核心數(shù)量 型號(hào) 主頻 電壓 外頻 ' 5 6 7 8 ' AddressWidth L2CacheSize L2CacheSpeed SocketDesignation ' 位寬 L2容量 L2頻率 插槽類型 '************************************************************ Function GetCPUInfo(objConnection) Dim objCPU, objCPUs, arrCPU(8) On Error Resume Next Set objCPUs = objConnection.InstancesOf("win32_processor") If Err Then GetCPUInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetCPUInfo Function" Err.Clear On Error Goto 0 Exit Function End If arrCPU(0) = objCPUs.Count '每個(gè)CPU核心都返回一個(gè)實(shí)例，實(shí)例數(shù)量即為CPU核心數(shù)量 If Err Then GetCPUInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetCPUInfo Function" Err.Clear On Error Goto 0 Exit Function End If For each objCPU In objCPUs arrCPU(1) = Replace(Trim(objCPU.Name),",","") '型號(hào) arrCPU(2) = objCPU.MaxClockSpeed '主頻 arrCPU(3) = ChangeToDecimal(objCPU.CurrentVoltage, 16)/10 '電壓 arrCPU(4) = objCPU.ExtClock '外頻 arrCPU(5) = objCPU.AddressWidth '位寬 arrCPU(6) = objCPU.L2CacheSize 'L2容量 arrCPU(7) = objCPU.L2CacheSpeed 'L2頻率 arrCPU(8) = objCPU.SocketDesignation '插槽類型 Next If Err Then GetCPUInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetCPUInfo Function" Err.Clear On Error Goto 0 Exit Function End If GetCPUInfo = arrCPU On Error Goto 0 End Function '******************************************************************************************** '目的：獲取內(nèi)存信息 '輸入：SWbemLocator對(duì)象的ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為(內(nèi)存條的數(shù)量*6)，0=內(nèi)存條的數(shù)量 ' 取內(nèi)存的6種屬性： ' 1 2 3 4 5 6 ' capacity Speed DeviceLocator MemoryType FormFactor TypeDetail ' 容量 速度 插槽位置 內(nèi)存類型 封裝(接口)類型 詳細(xì)類型-系統(tǒng)應(yīng)用類型 'DeviceLocator屬性表示這個(gè)內(nèi)存所在的插槽 ' 一般是字符加數(shù)字，數(shù)字相當(dāng)于主板上內(nèi)存插槽的物理位置 '******************************************************************************************** Function GetMemoryInfo(objConnection) Dim objMemorys, objMemory, Num Redim arrMemory(0) On Error Resume Next Set objMemorys = objConnection.InstancesOf("Win32_PhysicalMemory") If Err Then GetMemoryInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetMemoryInfo Function" Err.Clear On Error Goto 0 Exit Function End If arrMemory(0) = objMemorys.Count '每條內(nèi)存都返回一個(gè)實(shí)例，實(shí)例項(xiàng)數(shù)即內(nèi)存條數(shù)量 If Err Then GetMemoryInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetMemoryInfo Function" Err.Clear On Error Goto 0 Exit Function End If Num = 0 For Each objMemory In objMemorys Num = Num + 1 Redim Preserve arrMemory(Num*6) arrMemory(Num*6-5) = objMemory.capacity/1048576 '容量(M) arrMemory(Num*6-4) = objMemory.Speed '速度(MHz) arrMemory(Num*6-3) = objMemory.DeviceLocator '插槽位置 Select Case objMemory.MemoryType '內(nèi)存類型， Case 0 :arrMemory(Num*6-2) = "Unknown" '未知 Case 1 :arrMemory(Num*6-2) = "Other" '其它 Case 2 :arrMemory(Num*6-2) = "DRAM" '動(dòng)態(tài)隨機(jī)存儲(chǔ)器 Case 3 :arrMemory(Num*6-2) = "Synchronous DRAM" '同步動(dòng)態(tài)隨機(jī)存儲(chǔ)器 Case 4 :arrMemory(Num*6-2) = "Cache DRAM" '同步緩存動(dòng)態(tài)隨機(jī)存儲(chǔ)器,三菱專利技術(shù),插入一個(gè)SRAM作為二級(jí)CACHE使用 Case 5 :arrMemory(Num*6-2) = "EDO" '外擴(kuò)充數(shù)據(jù)模式存儲(chǔ)器(Extended Date Out) Case 6 :arrMemory(Num*6-2) = "EDRAM" '增強(qiáng)型動(dòng)態(tài)隨機(jī)存儲(chǔ)器，在DRAM中包括了一小部分的SRAM(Enhanced DRAM) Case 7 :arrMemory(Num*6-2) = "VRAM" '視頻存儲(chǔ)器,專門為圖形應(yīng)用優(yōu)化的存儲(chǔ)器(Video DRAM) Case 8 :arrMemory(Num*6-2) = "SRAM" '靜態(tài)隨機(jī)存儲(chǔ)器 Case 9 :arrMemory(Num*6-2) = "RAM" '隨機(jī)存儲(chǔ)器 Case 10 :arrMemory(Num*6-2) = "ROM" '只讀存儲(chǔ)器 Case 11 :arrMemory(Num*6-2) = "Flash" '閃速存儲(chǔ)器,簡(jiǎn)稱閃存(Flash Memory),屬于EEPROM(電擦除可編程只讀存儲(chǔ)器)類型 Case 12 :arrMemory(Num*6-2) = "EEPROM" '電可擦寫可編程只讀存儲(chǔ)器 Case 13 :arrMemory(Num*6-2) = "FEPROM" 'F什么可擦寫可編程只讀存儲(chǔ)器 Case 14 :arrMemory(Num*6-2) = "EPROM" '可擦寫可編程只讀存儲(chǔ)器(Erasable Programmable ROM) Case 15 :arrMemory(Num*6-2) = "CDRAM" '同步緩存動(dòng)態(tài)隨機(jī)存儲(chǔ)器,即Cache DRAM Case 16 :arrMemory(Num*6-2) = "3DRAM" '3維視頻處理器專用存儲(chǔ)器(3 DIMESION RAM) Case 17 :arrMemory(Num*6-2) = "SDRAM" '同步動(dòng)態(tài)隨機(jī)存儲(chǔ)器,即Synchronous DRAM Case 18 :arrMemory(Num*6-2) = "SGRAM" '單口隨機(jī)存儲(chǔ)器(Signal RAM) Case 19 :arrMemory(Num*6-2) = "RDRAM" '總線式動(dòng)態(tài)隨機(jī)存儲(chǔ)器 Case 20 :arrMemory(Num*6-2) = "DDR" '雙倍速率同步動(dòng)態(tài)隨機(jī)存儲(chǔ)器,一個(gè)時(shí)鐘周期內(nèi)傳輸二次數(shù)據(jù) Case 21 :arrMemory(Num*6-2) = "DDR-2" '雙倍速率同步動(dòng)態(tài)隨機(jī)存儲(chǔ)器2,一個(gè)時(shí)鐘周期內(nèi)傳輸二次數(shù)據(jù),4bit數(shù)據(jù)預(yù)讀取能力 End Select Select Case objMemory.FormFactor '封裝類型(接口類型) Case 0 :arrMemory(Num*6-1) = "Unknown" '未知 Case 1 :arrMemory(Num*6-1) = "Other" '其它 Case 2 :arrMemory(Num*6-1) = "SIP" '單列直插式封裝 Case 3 :arrMemory(Num*6-1) = "DIP" '雙列直插式封裝(Dual ln-line Package) Case 4 :arrMemory(Num*6-1) = "ZIP" '零插拔力封裝(Zero Insertion Package) Case 5 :arrMemory(Num*6-1) = "SOJ" '小尺寸(小外形)J形引腳封裝(Small Out-Line J-Lead) Case 6 :arrMemory(Num*6-1) = "Proprietary" '專有封裝(有專利權(quán)的) Case 7 :arrMemory(Num*6-1) = "SIMM" '單列直插式封裝(Single Inline Memory Module) Case 8 :arrMemory(Num*6-1) = "DIMM" '雙列直插式封裝(Dual Inline Memory Module) Case 9 :arrMemory(Num*6-1) = "TSOP" '薄型小尺寸封裝(Thin Small Outline Package) Case 10 :arrMemory(Num*6-1) = "PGA" '陳列引腳封裝。底面的垂直引腳呈陳列狀排列。用于高速大規(guī)模邏輯LSI電路。 Case 11 :arrMemory(Num*6-1) = "RIMM" '總線式封裝,RIMM是Rambus公司生產(chǎn)的RDRAM內(nèi)存所采用的接口類型 Case 12 :arrMemory(Num*6-1) = "SODIMM" '小尺寸雙列直插式封裝(Small Outline DIMM Module) Case 13 :arrMemory(Num*6-1) = "SRIMM" '小尺寸總線式封裝 Case 14 :arrMemory(Num*6-1) = "SMD" '表面貼裝型封裝(Surface Mounted Devices),也叫貼片封裝 Case 15 :arrMemory(Num*6-1) = "SSMP" '未搜到此類型的信息，誰(shuí)知道的請(qǐng)告訴偶，謝謝 Case 16 :arrMemory(Num*6-1) = "QFP" '方型扁平封裝(Quad Flat Package) Case 17 :arrMemory(Num*6-1) = "TQFP" '薄方型扁平封裝 Case 18 :arrMemory(Num*6-1) = "SOIC" '小尺寸集成電路封裝,SOP(Small Outline Package，小外形封裝)之一 Case 19 :arrMemory(Num*6-1) = "LCC" '無引腳封裝,指只有電極接觸而無引腳的表面貼裝型封裝 Case 20 :arrMemory(Num*6-1) = "PLCC" '塑封J形引腳封裝 Case 21 :arrMemory(Num*6-1) = "BGA" '球柵陣列封裝,在背面按陳列方式制作出球形凸點(diǎn)代替引腳 Case 22 :arrMemory(Num*6-1) = "FPBGA" '方型扁平球柵陣列封裝 Case 23 :arrMemory(Num*6-1) = "LGA" '觸點(diǎn)陳列封裝。 End Select Select Case objMemory.TypeDetail '詳細(xì)類型(系統(tǒng)用于那方面的應(yīng)用) Case 1 :arrMemory(Num*6) = "Reserved" '預(yù)留 Case 2 :arrMemory(Num*6) = "Other" '其它 Case 4 :arrMemory(Num*6) = "Unknown" '未知 Case 8 :arrMemory(Num*6) = "Fast-paged" '快速分頁(yè) Case 16 :arrMemory(Num*6) = "Static column" '靜態(tài)列 Case 32 :arrMemory(Num*6) = "Pseudo-static" '假靜態(tài) Case 64 :arrMemory(Num*6) = "RAMBUS" 'Rambus公司 Case 128 :arrMemory(Num*6) = "Synchronous" '同步 Case 256 :arrMemory(Num*6) = "CMOS" '互補(bǔ) Case 512 :arrMemory(Num*6) = "EDO" '外擴(kuò)充 Case 1024 :arrMemory(Num*6) = "Window DRAM" '視頻 Case 2048 :arrMemory(Num*6) = "Cache DRAM" '緩存 Case 4096 :arrMemory(Num*6) = "Nonvolatile" '非易失性 End Select Next If Err Then GetMemoryInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetMemoryInfo Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrMemory(6) End If GetMemoryInfo = arrMemory On Error Goto 0 End Function '*************************************************************************************** '目的：獲取硬盤信息 '輸入：SWbemLocator對(duì)象的ConnectServer方法連接到遠(yuǎn)程主機(jī)的實(shí)例 '返回：數(shù)組，上限為(硬盤數(shù)量*5)，0=硬盤的數(shù)量 ' 取硬盤的4種屬性： ' 1 2 3 4 5 ' Model InterfaceType Size MediaType DeviceID ' 型號(hào) 接口 容量 類型 設(shè)備標(biāo)識(shí)符 '注意：InterfaceType是指接口類型，有5個(gè)值：SCSI、HDC、IDE、USB、1394 ' MediaType屬性是指媒體類型： ' Vista下有四個(gè)值： External hard disk media:外接硬盤 ' Removable media other than floppy:移動(dòng)媒體或軟盤 ' Fixed hard disk media:固定硬盤 ' Format is unknown:未知類型 ' NT 4.0/2000/XP/2003下有三個(gè)值： Removable media:移動(dòng)媒體 ' Fixed hard disk:固定硬盤 ' Unknown:未知類型 ' Size屬性是1000進(jìn)制，返回結(jié)果是以1024進(jìn)制換算成G取小數(shù)點(diǎn)后二位數(shù),和磁盤管理里看到的相同 '*************************************************************************************** Function GetDiskInfo(objConnection) Dim objDisks, objDisk, Num Dim Tmp On Error Resume Next Set objDisks = objConnection.InstancesOf("win32_Diskdrive") If Err Then GetDiskInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetDiskInfo Function" Err.Clear On Error Goto 0 Exit Function End If Tmp = objDisks.Count If Err Then GetDiskInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetDiskInfo Function" Err.Clear On Error Goto 0 Exit Function End If Redim arrDisk(0) Num = 0 For Each objDisk In objDisks Num = Num + 1 Redim Preserve arrDisk(Num*5) arrDisk(Num*5-4) = Replace(Trim(objDisk.Model),",","") '型號(hào) arrDisk(Num*5-3) = objDisk.InterfaceType '接口 arrDisk(Num*5-2) = Round(objDisk.Size/1073741824,2) '容量(G) arrDisk(Num*5-1) = objDisk.MediaType '類型 arrDisk(Num*5-0) = objDisk.DeviceID Next If Err Then GetDiskInfo = "錯(cuò)誤編號(hào)：" & CStr(Err.Number) & _ "，錯(cuò)誤原因：" & CStr(Err.Description) & _ "，錯(cuò)誤來源：" & CStr(Err.Source) & " By GetDiskInfo Function" Err.Clear On Error Goto 0 Exit Function End If If Num = 0 Then Redim Preserve arrDisk(5) End If GetDiskInfo = arrDisk On Error Goto 0 End Function

最新評(píng)論