VBS 批量Ping的项目实现（vb word批量编辑）深度揭秘

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