'判斷當(dāng)前VBS腳本是否由CScript執(zhí)行
If InStr(LCase(WScript.FullName), "cscript.exe") = 0 Then
?? ?'若不是由CScript執(zhí)行，則使用CScript重新執(zhí)行當(dāng)前腳本
?? ?Set objShell = CreateObject("Shell.Application")?
?? ?objShell.ShellExecute "cscript.exe", """" & WScript.ScriptFullName & """", , , 1
?? ?WScript.Quit?? ?'退出當(dāng)前程序
End If
'----------------------------------------------------------------------------------------------
Set?? ??? ?objFSO?? ??? ?= CreateObject("Scripting.FileSystemObject")
'創(chuàng)建日志文件
Set?? ??? ?fileLog?? ??? ?= objFSO.CreateTextFile("Ping運行結(jié)果(" &_
?? ??? ??? ??? ??? ??? ??? ??? ?Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & " " &_
?? ??? ??? ??? ??? ??? ??? ??? ?Hour(Now()) & "-" & Minute(Now()) & "-" & Second(Now()) & ").txt", True)
'----------------------------------------------------------------------------------------------
'Ping 方案類
Class PingScheme
?? ?Public?? ??? ?Address?? ??? ??? ??? ??? ??? ?'目標(biāo)地址
?? ?Public?? ??? ?DisconnectionCount?? ?'斷線計數(shù)
End Class
Dim?? ??? ?dicPingScheme?? ??? ??? ??? ??? ?'配置方案集合
Set?? ??? ?dicPingScheme?? ?= CreateObject("Scripting.Dictionary")
Dim?? ??? ?strPingQuery?? ??? ??? ??? ??? ??? ?'Ping查詢條件語句
?? ?strPingQuery?? ??? ??? ??? ?= Null
'添加Ping方案到方案集合
Public Sub AddPingScheme ( addr )
?? ?
?? ?Set newPingScheme = New PingScheme
?? ??? ?newPingScheme.Address = addr
?? ??? ?newPingScheme.DisconnectionCount = 0
?? ?
?? ?dicPingScheme.Add addr, newPingScheme
?? ?'合成Ping查詢條件語句
?? ?If IsNull( strPingQuery ) Then
?? ??? ?strPingQuery = "Address='" & addr & "'"
?? ?Else
?? ??? ?strPingQuery = strPingQuery & "OR Address='" & addr & "'"
?? ?End If
?? ?
End Sub
'----------------------------------------------------------------------------------------------
AddPingScheme ( "8.8.8.8" )
AddPingScheme ( "8.8.4.4" )
AddPingScheme ( "192.168.1.8" )

'----------------------------------------------------------------------------------------------

Dim?? ??? ?bEmailFlag?? ??? ??? ??? ??? ??? ??? ?'發(fā)送郵件標(biāo)志
?? ?bEmailFlag?? ??? ??? ??? ??? ?= False

Const?? ?LoopInterval?? ??? ?= 5000?? ?'循環(huán)間隔
Dim?? ??? ?strDisplay?? ??? ??? ?'顯示緩存字符串
Dim?? ??? ?strLog?? ??? ??? ??? ??? ?'日志文件緩存字符串
'連接WMI服務(wù)
Set?? ??? ?objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Do?
?? ?
?? ?strDisplay?? ?= "----" & Now & "----" & vbCrlf
?? ?strLog?? ??? ??? ?= ""
?? ?'通過WMI調(diào)用Ping命令，返回Ping執(zhí)行結(jié)果集合
?? ?Set colPings = objWMIService.ExecQuery("SELECT * FROM Win32_PingStatus WHERE " & strPingQuery)
?? ?'遍歷結(jié)果集合
?? ?For Each objPing in colPings
?? ??? ?
?? ??? ?strLog = strLog & FormatDateTime(Now()) & vbTab &_
?? ??? ??? ??? ??? ??? ?objPing.Address & vbTab & objPing.StatusCode & vbTab
?? ??? ?strDisplay = strDisplay & "[" & objPing.Address & "] - "
?? ??? ?
?? ??? ?Select Case objPing.StatusCode
?? ??? ??? ?Case 0
?? ??? ??? ??? ?strDisplay?? ?= strDisplay & objPing.ProtocolAddress &_
?? ??? ??? ??? ??? ??? ??? ??? ??? ?", Size: " & objPing.ReplySize &_
?? ??? ??? ??? ??? ??? ??? ??? ??? ?", Time: " & objPing.ResponseTime &_
?? ??? ??? ??? ??? ??? ??? ??? ??? ?", TTL: " & objPing.ResponseTimeToLive & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & objPing.ProtocolAddress & vbTab & objPing.ReplySize & vbTab &_
?? ??? ??? ??? ??? ??? ??? ??? ??? ?objPing.ResponseTime & vbTab & objPing.ResponseTimeToLive
?? ??? ??? ?Case 11002
?? ??? ??? ??? ?strDisplay?? ?= strDisplay & ?"目標(biāo)網(wǎng)絡(luò)不可達" & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "目標(biāo)網(wǎng)絡(luò)不可達"
?? ??? ??? ?Case 11003
?? ??? ??? ??? ?strDisplay?? ?= strDisplay & ?"目標(biāo)主機不可達 " & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "目標(biāo)主機不可達"
?? ??? ??? ?Case 11010
?? ??? ??? ??? ?strDisplay?? ?= strDisplay & ?"等待超時" & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "等待超時"
?? ??? ??? ?Case Else
?? ??? ??? ??? ?If IsNull(objPing.StatusCode) Then
?? ??? ??? ??? ??? ?strDisplay?? ?= strDisplay & ?"找不到主機 " & objPing.Address & vbCrlf
?? ??? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "找不到主機 " & objPing.Address
?? ??? ??? ??? ?Else
?? ??? ??? ??? ??? ?strDisplay?? ?= strDisplay & ?"錯誤：" & objPing.StatusCode & vbCrlf
?? ??? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "錯誤：" & objPing.StatusCode
?? ??? ??? ??? ?End If
?? ??? ?End Select
?? ??? ?
?? ??? ?strLog = strLog & vbCrlf
?? ??? ?
?? ??? ?'判斷 Ping返回結(jié)果是否執(zhí)行成功?
?? ??? ?If objPing.StatusCode <> 0 Then
?? ??? ??? ?'若不成功 將相應(yīng)的 DisconnectionCount 加 1
?? ??? ??? ?dicPingScheme(objPing.Address).DisconnectionCount = dicPingScheme(objPing.Address).DisconnectionCount + 1
?? ??? ??? ?'DisconnectionCount = 10 時 置位 發(fā)送郵件標(biāo)志
?? ??? ??? ?If dicPingScheme(objPing.Address).DisconnectionCount = 10 Then
?? ??? ??? ??? ?bEmailFlag = True
?? ??? ??? ?End If
?? ??? ?Else
?? ??? ??? ?'若成功 將相應(yīng)的 DisconnectionCount 清零
?? ??? ??? ?dicPingScheme(objPing.Address).DisconnectionCount = 0
?? ??? ?End If
?? ??? ?
?? ?Next
?? ?
?? ?'輸出顯示
?? ?PrintLine strDisplay
?? ?'保存日志
?? ?fileLog.WriteLine strLog
?? ?
?? ?'如果 發(fā)送郵件標(biāo)志 被置位 清除標(biāo)志 并 發(fā)送郵件
?? ?If bEmailFlag = True Then
?? ??? ?bEmailFlag = False?? ??? ?'清除 標(biāo)志
?? ??? ?SendEmail "設(shè)備斷線 " & Now, strDisplay
?? ?End If
?? ?
?? ?'掛起指定時間，暫停
?? ?WScript.Sleep(LoopInterval)
?? ?
Loop
'---------------------------------------------------------------------------------------
'標(biāo)準輸出
Public Sub Print ( tmp )
?? ?WScript.StdOut.Write tmp
End Sub
'標(biāo)準輸出以換行符結(jié)尾
Public Sub PrintLine ( tmp )
?? ?WScript.StdOut.Write tmp & vbCrlf
End Sub
'---------------------------------------------------------------------------------------
'發(fā)送郵件
Public Sub SendEmail(title, textbody)
?? ?Set objCDO?? ??? ??? ?= CreateObject("CDO.Message")
?? ?objCDO.Subject?? ??? ?= title
?? ?objCDO.From?? ??? ??? ?= "XXX@qq.com"
?? ?objCDO.To?? ??? ??? ??? ?= "XXX@qq.com"
?? ?objCDO.TextBody?? ?= textbody
?? ?cdoConfigPrefix?? ??? ?= "http://schemas.microsoft.com/cdo/configuration/"
?? ?Set objCDOConfig?? ?= objCDO.Configuration
?? ?With objCDOConfig
?? ??? ?.Fields(cdoConfigPrefix & "smtpserver")?? ??? ??? ??? ?= "smtp.qq.com"
?? ??? ?.Fields(cdoConfigPrefix & "smtpserverport")?? ??? ?= 465
?? ??? ?.Fields(cdoConfigPrefix & "sendusing")?? ??? ??? ??? ?= 2 ?
?? ??? ?.Fields(cdoConfigPrefix & "smtpauthenticate")?? ?= 1 ?
?? ??? ?.Fields(cdoConfigPrefix & "smtpusessl")?? ??? ??? ?= true?
?? ??? ?.Fields(cdoConfigPrefix & "sendusername")?? ??? ?= "XXX"
?? ??? ?.Fields(cdoConfigPrefix & "sendpassword")?? ??? ?= "XXX"
?? ??? ?.Fields.Update
?? ?End With
?? ?objCDO.Send
?? ?
?? ?Set objCDOConfig = Nothing
?? ?Set objCDO = Nothing
?? ?
End Sub