一段简单的VBScript脚本获取系统环境代码 [论坛存档]

心吻

2007-09-27, 02:35 PM

代码

脚本获取系统环境
'Author:小金
'部分代码参考阿江探针，谢谢
'增加在Winsock组件无效的情况下通过ipconfig获取本机网卡IP的代码

'On Error Resume Next
Dim okos, okcpu, okcpus, UserDomain, UserName, ComputerName, strIP, strMAC
ComputerName = "."

Set WshShell = CreateObject("WScript.Shell")
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
Set WshSysEnv = WshShell.Environment("SYSTEM")
Set fsoobj = CreateObject("Scripting.FileSystemObject")
Set wshNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")

GetSystemInfo
GetNetworkInfo
DriversInfo = GetDriversInfo
DriversInfo = Replace(DriversInfo, "|", vbCrLf)
CPU=readreg("HKLM\Hardware\Description\System\CentralProcessor\0\Identifier")
sReturn = "系统平台：" & okos & vbCrLf & "CPU数量：" & okcpus & vbCrLf & "CPU型号：" & okcpu & "(" & CPU & ")" & vbCrLf & "域：" & UserDomain & vbCrLf & "计算机名：" & ComputerName & vbCrLf & "用户名：" & UserName & vbCrLf & "本机IP：" & strIP & vbCrLf & "MAC地址：" & strMAC & vbCrLf & "磁盘信息：" & vbCrLf & DriversInfo & vbcrlf & GetMemoryInfo

MsgBox sReturn '测试输出，具体请自行根据需要更改

Set WshShell = Nothing
Set WshSysEnv = Nothing
Set fsoobj = Nothing
Set wshNetwork = Nothing
Set objWMIService = Nothing

//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
Function GetMemoryInfo()
'内存
Dim temp
GetMemoryInfo = ""
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory", , 48)
For Each objitem In colItems
a = CLng(objitem.capacity)
temp = CLng(temp) + CLng(objitem.capacity)
n = n + 1
Next
If n = 1 Then
GetMemoryInfo = "内存数量:" & n & "条" & vbCrLf & cSize(a)
Else
GetMemoryInfo = "内存数量:" & n & "条" & vbCrLf & vbCrLf & " 总计" & cSize(temp)
End If
End Function

Function cSize(tSize)

If tSize >= 1073741824 Then
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
cSize = Int((tSize / 1073741824) * 1000) / 1000 & " GB"
ElseIf tSize >= 1048576 Then
cSize = Int((tSize / 1048576) * 1000) / 1000 & " MB"
ElseIf tSize >= 1024 Then
cSize = Int((tSize / 1024) * 1000) / 1000 & " KB"
Else
cSize = tSize & "B"
End If

End Function

Function GetDriversInfo()

GetDriversInfo = ""
Set drvObj = fsoobj.Drives
For Each D In drvObj
Err.Clear
If D.DriveLetter <> "A" Then
If D.isReady Then
GetDriversInfo = GetDriversInfo & "DRIVER_LETTER:" & D.DriveLetter & vbCrLf
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
GetDriversInfo = GetDriversInfo & "DRIVER_VOL:" & D.VolumeName & vbCrLf
GetDriversInfo = GetDriversInfo & "DRIVER_SYS:" & D.FileSystem & vbCrLf
GetDriversInfo = GetDriversInfo & "DRIVER_FREESIZE:" & cSize(D.FreeSpace) & vbCrLf
GetDriversInfo = GetDriversInfo & "DRIVER_TOTALSIZE:" & cSize(D.TotalSize) & vbCrLf
GetDriversInfo = GetDriversInfo & "|"
Else
End If
Else
End If
Next

End Function

Function GetMACAddress(strIP)

WshShell.run "cmd.exe /c nbtstat -A " & strIP & " > c:\" & strIP & ".txt", 0, True
Set ts = fsoobj.opentextfile("c:\" & strIP & ".txt")
macaddress = Null
Do While Not ts.AtEndOfStream
Data = UCase(Trim(ts.readline))
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
If InStr(Data, "MAC ADDRESS") Then
macaddress = Trim(Split(Data, "=")(1))
Exit Do
End If
Loop
ts.Close
Set ts = Nothing
fsoobj.deletefile "c:\" & strIP & ".txt"
GetMACAddress = macaddress

End Function

Function GetIP(ComputerName) '取本机IP
Dim colItems,objItem,objAddress
Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
For Each objAddress in objItem.IPAddress
If objAddress <> "" then
GetIP = objAddress
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
Exit For
End If
Next
Next
End Function

Function GetEtherIP()
WshShell.run "cmd.exe /c ipconfig > c:\ipconfig.txt", 0, True
Set ts = fsoobj.opentextfile("c:\ipconfig.txt")
ipaddress = Null
IsEther = False
Do While Not ts.AtEndOfStream
Data = UCase(Trim(ts.readline))
If InStr(UCase(Data), "ETHERNET ADAPTER") Then
IsEther = True
Else
End If
If IsEther And InStr(UCase(Data), "IP ADDRESS") Then
ipaddress = Trim(Split(Data, ":")(1))
Exit Do
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
End If
Loop
ts.Close
Set ts = Nothing
fsoobj.deletefile "c:\ipconfig.txt"
GetEtherIP = ipaddress
End Function

Sub GetNetworkInfo()
UserDomain = wshNetwork.UserDomain
ComputerName = wshNetwork.ComputerName
UserName = wshNetwork.UserName
strIP = GetEtherIP
strMAC = GetMACAddress(strIP)
End Sub

Sub GetSystemInfo()

okos = CStr(WshSysEnv("OS"))
okcpus = CStr(WshSysEnv("NUMBER_OF_PROCESSORS"))
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
okcpu = CStr(WshSysEnv("PROCESSOR_IDENTIFIER"))
If okcpus & "" = "" Then
okcpus = "(未知)"
End If
If okos & "" = "" Then
okos = "(未知)"
End If
End Sub

'检查组件是否被支持及组件版本的子程序
Function ObjTest(strObj)
on error resume next
ObjTest=false
VerObj=""
set TestObj=CreateObject (strObj)
If -2147221005 <> Err then '感谢网友iAmFisher的宝贵建议
ObjTest = True
VerObj = TestObj.version
if VerObj="" or isnull(VerObj) then VerObj=TestObj.about
end if
//文章出处:网络技术论坛(http://bbs.nettf.net) 作者:小金
set TestObj=nothing
End Function

function ReadReg(key)
on error resume next
readreg=cstr(wshshell.regread(key))
if not err.number=0 then
msgbox "不能打开 " & key & " : " & err.description
err.clear
readreg=""
end if
end function