'判斷當前VBS腳本是否由CScript執(zhí)行
If InStr(LCase(WScript.FullName), "cscript.exe") = 0 Then
?? ?'若不是由CScript執(zhí)行，則使用CScript重新執(zhí)行當前腳本
?? ?Set objShell = CreateObject("Shell.Application")?
?? ?objShell.ShellExecute "cscript.exe", """" & WScript.ScriptFullName & """", , , 1
?? ?WScript.Quit?? ?'退出當前程序
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?? ??? ??? ??? ??? ??? ?'目標地址
?? ?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ā)送郵件標志
?? ?bEmailFlag?? ??? ??? ??? ??? ?= False


Const?? ?LoopInterval?? ??? ?= 5000?? ?'循環(huán)間隔

Dim?? ??? ?strDisplay?? ??? ??? ?'顯示緩存字符串
Dim?? ??? ?strLog?? ??? ??? ??? ??? ?'日志文件緩存字符串

'連接WMI服務
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 & ?"目標網(wǎng)絡不可達" & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "目標網(wǎng)絡不可達"
?? ??? ??? ?Case 11003
?? ??? ??? ??? ?strDisplay?? ?= strDisplay & ?"目標主機不可達 " & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "目標主機不可達"
?? ??? ??? ?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
?? ??? ??? ?'若不成功 將相應的 DisconnectionCount 加 1
?? ??? ??? ?dicPingScheme(objPing.Address).DisconnectionCount = dicPingScheme(objPing.Address).DisconnectionCount + 1
?? ??? ??? ?'DisconnectionCount = 10 時 置位 發(fā)送郵件標志
?? ??? ??? ?If dicPingScheme(objPing.Address).DisconnectionCount = 10 Then
?? ??? ??? ??? ?bEmailFlag = True
?? ??? ??? ?End If
?? ??? ?Else
?? ??? ??? ?'若成功 將相應的 DisconnectionCount 清零
?? ??? ??? ?dicPingScheme(objPing.Address).DisconnectionCount = 0
?? ??? ?End If
?? ??? ?
?? ?Next
?? ?
?? ?'輸出顯示
?? ?PrintLine strDisplay
?? ?'保存日志
?? ?fileLog.WriteLine strLog
?? ?
?? ?'如果 發(fā)送郵件標志 被置位 清除標志 并 發(fā)送郵件
?? ?If bEmailFlag = True Then
?? ??? ?bEmailFlag = False?? ??? ?'清除 標志
?? ??? ?SendEmail "設備斷線 " & Now, strDisplay
?? ?End If
?? ?
?? ?'掛起指定時間，暫停
?? ?WScript.Sleep(LoopInterval)
?? ?
Loop

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

'標準輸出
Public Sub Print ( tmp )
?? ?WScript.StdOut.Write tmp
End Sub

'標準輸出以換行符結(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