VBS 批量Ping的项目实现

'判断当前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