'*******************************************************
'目的：分析配置信息
'输入：strIP, strUser, strPW：IP[计算机名]、账户、密码
'返回：无，直接把分析结果保存在数组
'*******************************************************
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
'***********************************************************
'目的：获取操作系统信息
'输入：SWbemLocator对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为2
' 取操作系统的3种属性：
' 0 1 2
' CSName Caption&CSDVersion InstallDate
' 计算机名 系统名&SP版本 初装日期
'LastBootUpTime属性表示系统最近一次的启动时间
'***********************************************************
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 = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetOSInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
Tmp = objSystemInfos.Count
If Err Then
GetOSInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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 = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为2
' 取主板的3种属性：
' 0 1 2
' Product Manufacturer Version
' 型号 厂商 版本
'***********************************************************
Function GetBoardInfo(objConnection)
Dim objboards, objboard, arrBoard(2)
Dim Tmp
On Error Resume Next
Set objboards = objConnection.InstancesOf("Win32_BaseBoard")
If Err Then
GetBoardInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetBoardInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
Tmp = objboards.Count
If Err Then
GetBoardInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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),",","") '型号
arrBoard(1) = Replace(Trim(objboard.Manufacturer),",","") '厂商
arrBoard(2) = Replace(Trim(objboard.Version),",","") '版本
Next
If Err Then
GetBoardInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为2
' 取BIOS的2种属性：
' 0 1 2
' Manufacturer SMBIOSBIOSVersion ReleaseDate
' 厂商 版本 发行日期
'***********************************************************
Function GetBIOSInfo(objConnection)
Dim objBIOSs, objBIOS, arrBIOS(2)
Dim Tmp
On Error Resume Next
Set objBIOSs = objConnection.InstancesOf("Win32_BIOS")
If Err Then
GetBIOSInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetBIOSInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
Tmp = objBIOSs.Count
If Err Then
GetBIOSInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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厂商不存在" '请检查主板驱动是否完善或未安装，或BIOS不完善需要刷BIOS
Else
arrBIOS(0) = Replace(Trim(objBIOS.Manufacturer),",","")
End If
If Isnull(objBIOS.SMBIOSBIOSVersion) Then
arrBIOS(1) = "由SMBIOS汇报的BIOS版本不存在" '请检查主板驱动是否完善或未安装，或BIOS不完善需要刷BIOS
Else
arrBIOS(1) = Replace(Trim(objBIOS.SMBIOSBIOSVersion),",","")
End If
If Isnull(objBIOS.ReleaseDate) Then
arrBIOS(2) = "BIOS发行日期未知" '请检查主板驱动是否完善或未安装，或BIOS不完善需要刷BIOS
Else
arrBIOS(2) = Left(Cstr(objBIOS.ReleaseDate),8)
End If
Next
If Err Then
GetBIOSInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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对象ConnectServer方法连接到远程主机的实例
'返回：数组，上限为8
' 取CPU的9种属性：
' 0 1 2 3 4
' Name MaxClockSpeed CurrentVoltage ExtClock
' 核心数量 型号 主频 电压 外频
' 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 = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetCPUInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
arrCPU(0) = objCPUs.Count '每个CPU核心都返回一个实例，实例数量即为CPU核心数量
If Err Then
GetCPUInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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),",","") '型号
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 = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetCPUInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
GetCPUInfo = arrCPU
On Error Goto 0
End Function
'********************************************************************************************
'目的：获取内存信息
'输入：SWbemLocator对象的ConnectServer方法连接到远程主机的实例
'返回：数组，上限为(内存条的数量*6)，0=内存条的数量
' 取内存的6种属性：
' 1 2 3 4 5 6
' capacity Speed DeviceLocator MemoryType FormFactor TypeDetail
' 容量 速度 插槽位置 内存类型 封装(接口)类型 详细类型-系统应用类型
'DeviceLocator属性表示这个内存所在的插槽
' 一般是字符加数字，数字相当于主板上内存插槽的物理位置
'********************************************************************************************
Function GetMemoryInfo(objConnection)
Dim objMemorys, objMemory, Num
Redim arrMemory(0)
On Error Resume Next
Set objMemorys = objConnection.InstancesOf("Win32_PhysicalMemory")
If Err Then
GetMemoryInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetMemoryInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
arrMemory(0) = objMemorys.Count '每条内存都返回一个实例，实例项数即内存条数量
If Err Then
GetMemoryInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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 '内存类型，
Case 0 :arrMemory(Num*6-2) = "Unknown" '未知
Case 1 :arrMemory(Num*6-2) = "Other" '其它
Case 2 :arrMemory(Num*6-2) = "DRAM" '动态随机存储器
Case 3 :arrMemory(Num*6-2) = "Synchronous DRAM" '同步动态随机存储器
Case 4 :arrMemory(Num*6-2) = "Cache DRAM" '同步缓存动态随机存储器,三菱专利技术,插入一个SRAM作为二级CACHE使用
Case 5 :arrMemory(Num*6-2) = "EDO" '外扩充数据模式存储器(Extended Date Out)
Case 6 :arrMemory(Num*6-2) = "EDRAM" '增强型动态随机存储器，在DRAM中包括了一小部分的SRAM(Enhanced DRAM)
Case 7 :arrMemory(Num*6-2) = "VRAM" '视频存储器,专门为图形应用优化的存储器(Video DRAM)
Case 8 :arrMemory(Num*6-2) = "SRAM" '静态随机存储器
Case 9 :arrMemory(Num*6-2) = "RAM" '随机存储器
Case 10 :arrMemory(Num*6-2) = "ROM" '只读存储器
Case 11 :arrMemory(Num*6-2) = "Flash" '闪速存储器,简称闪存(Flash Memory),属于EEPROM(电擦除可编程只读存储器)类型
Case 12 :arrMemory(Num*6-2) = "EEPROM" '电可擦写可编程只读存储器
Case 13 :arrMemory(Num*6-2) = "FEPROM" 'F什么可擦写可编程只读存储器
Case 14 :arrMemory(Num*6-2) = "EPROM" '可擦写可编程只读存储器(Erasable Programmable ROM)
Case 15 :arrMemory(Num*6-2) = "CDRAM" '同步缓存动态随机存储器,即Cache DRAM
Case 16 :arrMemory(Num*6-2) = "3DRAM" '3维视频处理器专用存储器(3 DIMESION RAM)
Case 17 :arrMemory(Num*6-2) = "SDRAM" '同步动态随机存储器,即Synchronous DRAM
Case 18 :arrMemory(Num*6-2) = "SGRAM" '单口随机存储器(Signal RAM)
Case 19 :arrMemory(Num*6-2) = "RDRAM" '总线式动态随机存储器
Case 20 :arrMemory(Num*6-2) = "DDR" '双倍速率同步动态随机存储器,一个时钟周期内传输二次数据
Case 21 :arrMemory(Num*6-2) = "DDR-2" '双倍速率同步动态随机存储器2,一个时钟周期内传输二次数据,4bit数据预读取能力
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" '专有封装(有专利权的)
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" '陈列引脚封装。底面的垂直引脚呈陈列状排列。用于高速大规模逻辑LSI电路。
Case 11 :arrMemory(Num*6-1) = "RIMM" '总线式封装,RIMM是Rambus公司生产的RDRAM内存所采用的接口类型
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" '未搜到此类型的信息，谁知道的请告诉偶，谢谢
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" '球栅阵列封装,在背面按陈列方式制作出球形凸点代替引脚
Case 22 :arrMemory(Num*6-1) = "FPBGA" '方型扁平球栅阵列封装
Case 23 :arrMemory(Num*6-1) = "LGA" '触点陈列封装。
End Select
Select Case objMemory.TypeDetail '详细类型(系统用于那方面的应用)
Case 1 :arrMemory(Num*6) = "Reserved" '预留
Case 2 :arrMemory(Num*6) = "Other" '其它
Case 4 :arrMemory(Num*6) = "Unknown" '未知
Case 8 :arrMemory(Num*6) = "Fast-paged" '快速分页
Case 16 :arrMemory(Num*6) = "Static column" '静态列
Case 32 :arrMemory(Num*6) = "Pseudo-static" '假静态
Case 64 :arrMemory(Num*6) = "RAMBUS" 'Rambus公司
Case 128 :arrMemory(Num*6) = "Synchronous" '同步
Case 256 :arrMemory(Num*6) = "CMOS" '互补
Case 512 :arrMemory(Num*6) = "EDO" '外扩充
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 = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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对象的ConnectServer方法连接到远程主机的实例
'返回：数组，上限为(硬盘数量*5)，0=硬盘的数量
' 取硬盘的4种属性：
' 1 2 3 4 5
' Model InterfaceType Size MediaType DeviceID
' 型号 接口 容量 类型 设备标识符
'注意：InterfaceType是指接口类型，有5个值：SCSI、HDC、IDE、USB、1394
' MediaType属性是指媒体类型：
' Vista下有四个值： External hard disk media:外接硬盘
' Removable media other than floppy:移动媒体或软盘
' Fixed hard disk media:固定硬盘
' Format is unknown:未知类型
' NT 4.0/2000/XP/2003下有三个值： Removable media:移动媒体
' Fixed hard disk:固定硬盘
' Unknown:未知类型
' Size属性是1000进制，返回结果是以1024进制换算成G取小数点后二位数,和磁盘管理里看到的相同
'***************************************************************************************
Function GetDiskInfo(objConnection)
Dim objDisks, objDisk, Num
Dim Tmp
On Error Resume Next
Set objDisks = objConnection.InstancesOf("win32_Diskdrive")
If Err Then
GetDiskInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & CStr(Err.Source) & " By GetDiskInfo Function"
Err.Clear
On Error Goto 0
Exit Function
End If
Tmp = objDisks.Count
If Err Then
GetDiskInfo = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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),",","") '型号
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 = "错误编号：" & CStr(Err.Number) & _
"，错误原因：" & CStr(Err.Description) & _
"，错误来源：" & 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
文章评论
共有 位脚本之家网友发表了评论我来说两句