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的项目实现的文章就介绍到这了,更多相关VBS 批量Ping内容请搜索我们以前的文章或继续浏览下面的相关文章希望大家以后多多支持我们!

(0)

相关推荐

  • vbs ping实现的两种方式

    对于vbs中ping的实现可以通过两种方式 : 1.调用系统ping命令: 2.使用wmi查询pingstate类处理. 1.调用系统ping命令 Set wshell = CreateObject("WScript.Shell") wshell.run("ping 182.183.101.1",0.true) 对于以上调用,如果想对其进行过滤,可以考虑将运行结果重定向到文件,在读到一个string中,查找其中是否有timeout或超时字符,判断是否超时.本打算直接

  • VBS 批量Ping的项目实现

    本文用vb编写的 ping程序实现,具体如下: '判断当前VBS脚本是否由CScript执行 If InStr(LCase(WScript.FullName), "cscript.exe") = 0 Then     '若不是由CScript执行,则使用CScript重新执行当前脚本     Set objShell = CreateObject("Shell.Application")      objShell.ShellExecute "cscrip

  • python实现本地批量ping多个IP的方法示例

    本文主要利用python的相关模块进行批量ping ,测试IP连通性. 下面看具体代码(python3): ''' 遇到问题没人解答?小编创建了一个Python学习交流QQ群:857662006 寻找有志同道合的小伙伴,互帮互助,群里还有不错的视频学习教程和PDF电子书! ''' #!/usr/bin/env python #-*-coding:utf-8-*- import re import subprocess from io import StringIO import multipro

  • 使用Python实现批量ping操作方法

    在日常的工作中,我们通常会有去探测目标主机是否存活的应用场景,单个的服务器主机可以通过计算机自带的DOS命令来执行,但是业务的存在往往不是单个存在的,通常都是需要去探测C段的主机(同一个网段下的存活主机),这样使用DOS来进行操作是不可取,探测的速度太慢了,不满足实际需要.一般批量的操作需要使用脚本进行一键部署执行,本文主要通过使用Python语言来实现批量ping的操作(使用多线程实现Python批量处理) Python版本 :Python3 使用的第三方库:subprocess, loggi

  • 如何批量测试Mybatis项目中的Sql是否正确详解

    去Oracle行动 最近公司要发展海外项目,所以要将现有的系统全部平移过去,另外数据库也要从原来的Oracle变为Mysql.公司的数据库交互层面使用的是Mybatis,而Oracle与Mysql也有一些语法上的不同.所以在项目中的Sql要改动,但是多个项目中涉及到的Sql非常多,如果仅凭人工一条一条辨别的话,工作量有点大.所以就萌发出了直接将数据源变为Mysql,利用反射批量执行Mapper中的方法,然后如果有参数的话,就设置为默认的初始值,然后记录下来成功的数据和失败的数据,这样就可以根据失

  • vbs 批量修改文件,bat 批处理文件调用执行vbs,并在cmd窗口打印返回值(vbs运行结果)

    示例代码(t.vbs)如下: 复制代码 代码如下: Set fso=Wscript.CreateObject("Scripting.FileSystemObject") flrName="D:\Workspace\src\" 'dir that you need deal with count=0 'get the count of modified files function Traversal(dir) set flr=fso.getfolder(dir) s

  • VBS批量重命名文件并且操作前备份原有文件

    核心函数 '========================================================================== ' ' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0 ' ' NAME: ' ' AUTHOR: Microsoft , Microsoft ' DATE : 2014/7/9 ' ' COMMENT: '批量修改文件夹下对应的所有文件

  • VBS 批量读取文件夹内所有的文本到Excel的脚本

    复制代码 代码如下: 'This code is done by KangKang@ Option explicit 'This is optional, but better to use. Dim FolderPath,Folder Dim fso,File,Files Dim fileNums Dim FileString() Dim i Dim ii i=0 FolderPath="E:\TDDOWNLOAD\aa\" '**********************1.To c

  • 两个批量挂马vbs脚本代码

    scan.vbe cscript scan.vbe web目录 程序代码: '版权信息 br="************************************" & vbCrLf br=br & "* VBS 批量挂马脚本 *" & vbCrLf br=br & "* BY BanLG *" & vbCrLf br=br & "**************************

  • vbs提示没有在该机执行windows脚本宿主的权限。请与系统管理员联系

    最近在项目中使用VBS来实现图片的批量删除和批量导入功能,但不知道为什么,只要在我机器上一运行VBS文件就提示"没有在该机执行windows脚本宿主的权限.请与系统管理员联系."的错误.下面贴出本人的解决方法,并附上图片批量导入及批量删除的VBS代码. 如果只是因为权限问题可以查看这篇文章: 以管理员身份运行程序的vbs命令 1.检查系统是否禁止使用了脚本运行,即打开"INTERNET选项"的"安全"选项卡里"自定义级别",看

随机推荐