VBS批量Ping的项目怎么实现

这篇文章主要介绍"VBS批量Ping的项目怎么实现"，在日常操作中，相信很多人在VBS批量Ping的项目怎么实现问题上存在疑惑，小编查阅了各式资料，整理出简单好用的操作方法，希望对大家解答"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 ClassDim        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                    = FalseConst    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 tmpEnd Sub'标准输出以换行符结尾Public Sub PrintLine ( tmp )    WScript.StdOut.Write tmp & vbCrlfEnd 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的项目怎么实现"的学习就结束了，希望能够解决大家的疑惑。理论与实践的搭配能更好的帮助大家学习，快去试试吧！若想继续学习更多相关知识，请继续关注网站，小编会继续努力为大家带来更多实用的文章！