'判斷當前VBS腳本是否由CScript執行
If InStr(LCase(WScript.FullName), "cscript.exe") = 0 Then
?? ?'若不是由CScript執行，則使用CScript重新執行當前腳本
?? ?Set objShell = CreateObject("Shell.Application")?
?? ?objShell.ShellExecute "cscript.exe", """" & WScript.ScriptFullName & """", , , 1
?? ?WScript.Quit?? ?'退出當前程序
End If

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

Set?? ??? ?objFSO?? ??? ?= CreateObject("Scripting.FileSystemObject")
'創建日志文件
Set?? ??? ?fileLog?? ??? ?= objFSO.CreateTextFile("Ping運行結果(" &_
?? ??? ??? ??? ??? ??? ??? ??? ?Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & " " &_
?? ??? ??? ??? ??? ??? ??? ??? ?Hour(Now()) & "-" & Minute(Now()) & "-" & Second(Now()) & ").txt", True)

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

'Ping 方案類
Class PingScheme
?? ?Public?? ??? ?Address?? ??? ??? ??? ??? ??? ?'目標地址
?? ?Public?? ??? ?DisconnectionCount?? ?'斷線計數
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?? ??? ??? ??? ??? ??? ??? ?'發送郵件標志
?? ?bEmailFlag?? ??? ??? ??? ??? ?= False


Const?? ?LoopInterval?? ??? ?= 5000?? ?'循環間隔

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

'連接WMI服務
Set?? ??? ?objWMIService = GetObject("winmgmts:\\.\root\cimv2")

Do?
?? ?
?? ?strDisplay?? ?= "----" & Now & "----" & vbCrlf
?? ?strLog?? ??? ??? ?= ""
?? ?'通過WMI調用Ping命令，返回Ping執行結果集合
?? ?Set colPings = objWMIService.ExecQuery("SELECT * FROM Win32_PingStatus WHERE " & strPingQuery)
?? ?'遍歷結果集合
?? ?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 & ?"目標網絡不可達" & vbCrlf
?? ??? ??? ??? ?strLog?? ??? ??? ?= strLog & "目標網絡不可達"
?? ??? ??? ?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返回結果是否執行成功?
?? ??? ?If objPing.StatusCode <> 0 Then
?? ??? ??? ?'若不成功 將相應的 DisconnectionCount 加 1
?? ??? ??? ?dicPingScheme(objPing.Address).DisconnectionCount = dicPingScheme(objPing.Address).DisconnectionCount + 1
?? ??? ??? ?'DisconnectionCount = 10 時 置位 發送郵件標志
?? ??? ??? ?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
?? ?
?? ?'如果 發送郵件標志 被置位 清除標志 并 發送郵件
?? ?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

'標準輸出以換行符結尾
Public Sub PrintLine ( tmp )
?? ?WScript.StdOut.Write tmp & vbCrlf
End Sub

'---------------------------------------------------------------------------------------
'發送郵件
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