共计 4395 个字符，预计需要花费 11 分钟才能阅读完成。
| 导读 | 本文主要介绍了 VBS 批量 Ping 的项目实现，文中通过示例代码介绍的非常详细，对大家的学习或者工作具有一定的参考学习价值，需要的朋友们下面随着小编来一起学习学习吧 |
本文用 vb 编写的 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到此这篇关于 VBS 批量 Ping 的项目实现的文章就介绍到这了。
正文完
星哥玩云-微信公众号
