刚刚经过Steven的指点，现在推出更新，如果大家有意见可以和我联系。'***********************************
'* Network Testing for Mcse.org.cn *
'* NAME: QuShengrong *
'* DATE: 2007-10-12 *
'* Mail: [email]lingluo18@gmail.com[/email] *
'* COMMENT: Mcse.org.cn *
'***********************************
On Error Resume Next
StrComputer = "."
UserName = ""
Password = ""
Dim strComputer
Dim objWMIService
Dim propValue
Dim objItem
Dim SWBemlocator
Dim UserName
Dim Password
Dim colItems
Dim lanString
Dim WlanString
Dim Cmd
Dim fso
Dim cList
Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = SWBemlocator.ConnectServer(strComputer,"root\CIMV2",UserName,Password)
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration",,48)
For Each objItem in colItems
For each propValue In objItem.DefaultIPGateway
If propValue<>"" Then
'lan
lanString = propValue
Cmd = "%comspec% /c ping "& lanString &" -a -n 1 -w 400 > c:\pinglan.txt"
CreateObject("Wscript.Shell").Run Cmd, 0, True
Set fso = CreateObject("Scripting.FileSystemObject")
Set cList = fso.OpenTextFile ("c:\pinglan.txt")
lanString = cList.ReadAll
WScript.Echo lanString
if instr(lanString,"TTL") > 0 then
'wlan
WlanString = "202.96.209.133"
Cmd = "%comspec% /c ping "& WlanString &" -a -n 1 -w 400 > c:\pingwlan.txt"
CreateObject("Wscript.Shell").Run Cmd, 0, True
Set fso = CreateObject("Scripting.FileSystemObject")
Set cList = fso.OpenTextFile ("c:\pingwlan.txt")
WlanString = cList.ReadAll
WScript.Echo WlanString
cList.close
set cList = nothing
fso.GetFile("c:\pinglan.txt").delete
if instr(WlanString,"TTL") > 0 then
'wlan_successful
WScript.Echo "您的内网、外网访问一切正常"
set cList = nothing
fso.GetFile("c:\pingwlan.txt").delete
else
'wlan_failed
WScript.Echo "对不起，您的外网出现问题，请与信息部联系，并请将c:\pingwlan.txt文件内容告诉系统管理员以便于把帮助您解决问题！"
end if
'lan_failed
else
WScript.Echo "对不器，您的内网出现问题，请与信息部联系，并请将c:\pinglan.txt文件内容告诉系统管理员以便于把帮助您解决问题！"
end If
End If
set fso = nothing
Next
Next