VBS 批量Ping的项目实现

2026-04-06 06:26:01发布 2次浏览

详情描述

一、基础版批量Ping工具

' batch_ping.vbs
Option Explicit

' 主函数
Sub Main()
    Dim objShell, objFSO, objFile
    Dim strComputer, strResult, strOutputFile
    Dim arrComputers, i

    ' 要测试的计算机列表（可以改为从文件读取）
    arrComputers = Array("192.168.1.1", "192.168.1.100", "192.168.1.200", _
                         "www.google.com", "www.baidu.com", "localhost")

    ' 输出文件
    strOutputFile = "ping_results.txt"

    ' 创建对象
    Set objShell = CreateObject("WScript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' 创建或清空输出文件
    Set objFile = objFSO.CreateTextFile(strOutputFile, True)

    ' 写入标题
    objFile.WriteLine "批量Ping测试结果"
    objFile.WriteLine "测试时间: " & Now()
    objFile.WriteLine String(60, "=")

    ' 遍历所有计算机
    For i = LBound(arrComputers) To UBound(arrComputers)
        strComputer = arrComputers(i)
        strResult = PingComputer(objShell, strComputer)

        ' 输出到屏幕
        WScript.Echo strResult

        ' 写入文件
        objFile.WriteLine strResult
    Next

    ' 关闭文件
    objFile.Close

    ' 提示完成
    WScript.Echo vbCrLf & "测试完成！结果已保存到: " & strOutputFile

    ' 清理对象
    Set objFile = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
End Sub

' Ping单个计算机的函数
Function PingComputer(objShell, strComputer)
    Dim strCommand, strOutput, objExec
    Dim bPingSuccess, strStatus

    ' 构造Ping命令（ping 4次）
    strCommand = "ping -n 4 " & strComputer

    ' 执行命令
    Set objExec = objShell.Exec(strCommand)

    ' 读取输出
    Do While Not objExec.StdOut.AtEndOfStream
        strOutput = strOutput & objExec.StdOut.ReadLine() & vbCrLf
    Loop

    ' 检查是否Ping通（查找"TTL="字符串）
    If InStr(strOutput, "TTL=") > 0 Then
        bPingSuccess = True
        strStatus = "[在线]"
    Else
        bPingSuccess = False
        strStatus = "[离线]"
    End If

    ' 提取平均延迟
    Dim avgPing
    avgPing = ExtractAveragePing(strOutput)

    ' 返回格式化结果
    PingComputer = FormatResult(strComputer, strStatus, avgPing, bPingSuccess)

    Set objExec = Nothing
End Function

' 提取平均延迟时间
Function ExtractAveragePing(strOutput)
    Dim arrLines, i, strLine, pos

    arrLines = Split(strOutput, vbCrLf)
    For i = 0 To UBound(arrLines)
        strLine = arrLines(i)
        If InStr(strLine, "平均 = ") > 0 Then
            pos = InStr(strLine, "平均 = ")
            ExtractAveragePing = Trim(Mid(strLine, pos + 4))
            Exit Function
        End If
    Next
    ExtractAveragePing = "N/A"
End Function

' 格式化输出结果
Function FormatResult(computer, status, pingTime, isOnline)
    Dim strResult
    strResult = "主机: " & Left(computer & Space(20), 20)
    strResult = strResult & " 状态: " & status
    If isOnline Then
        strResult = strResult & " 延迟: " & pingTime
    End If
    FormatResult = strResult
End Function

' 执行主程序
Call Main

二、高级版（带GUI界面）

' batch_ping_gui.vbs
Option Explicit

' 创建GUI界面
Sub CreateGUI()
    Dim objIE, html
    Dim strComputers

    ' 创建IE对象
    Set objIE = CreateObject("InternetExplorer.Application")

    ' 隐藏IE窗口（后台运行）
    objIE.Visible = False

    ' 创建HTML界面
    html = "<html>" & _
           "<head>" & _
           "<title>批量Ping工具</title>" & _
           "<style>" & _
           "body {font-family: Arial; padding: 20px;}" & _
           "textarea {width: 500px; height: 150px;}" & _
           "button {padding: 8px 16px; margin: 5px;}" & _
           ".online {color: green;}" & _
           ".offline {color: red;}" & _
           ".result {margin: 5px 0;}" & _
           "</style>" & _
           "</head>" & _
           "<body>" & _
           "<h2>批量Ping工具</h2>" & _
           "<p>请输入要测试的IP地址或域名（每行一个）:</p>" & _
           "<textarea id='txtComputers'>192.168.1.1" & vbCrLf & "www.baidu.com" & vbCrLf & "www.google.com</textarea>" & _
           "<br><br>" & _
           "<button onclick='StartPing()'>开始测试</button>" & _
           "<button onclick='ClearResults()'>清空结果</button>" & _
           "<button onclick='ExportResults()'>导出结果</button>" & _
           "<hr>" & _
           "<div id='results'></div>" & _
           "</body>" & _
           "</html>"

    ' 写入HTML并显示
    objIE.Document.Write html
    objIE.Visible = True
    objIE.FullScreen = True
    objIE.Width = 600
    objIE.Height = 700

    ' 等待用户操作
    While objIE.Visible
        WScript.Sleep 1000
    Wend
End Sub

' 开始Ping测试
Sub StartPing()
    Dim objShell, objExec, arrComputers, strComputer
    Dim strOutput, strResult, i, countOnline, countOffline

    ' 获取输入的计算机列表
    arrComputers = Split(document.getElementById("txtComputers").value, vbCrLf)

    ' 初始化计数
    countOnline = 0
    countOffline = 0

    ' 清空结果区域
    document.getElementById("results").innerHTML = ""

    Set objShell = CreateObject("WScript.Shell")

    ' 遍历测试
    For i = 0 To UBound(arrComputers)
        strComputer = Trim(arrComputers(i))
        If strComputer <> "" Then
            strResult = TestSingleComputer(objShell, strComputer)

            ' 更新结果区域
            document.getElementById("results").innerHTML = _
                document.getElementById("results").innerHTML & _
                strResult & "<br>"

            ' 计数
            If InStr(strResult, "在线") > 0 Then
                countOnline = countOnline + 1
            Else
                countOffline = countOffline + 1
            End If
        End If
    Next

    ' 显示统计信息
    document.getElementById("results").innerHTML = _
        document.getElementById("results").innerHTML & _
        "<hr><b>统计结果:</b><br>" & _
        "在线: " & countOnline & " 台<br>" & _
        "离线: " & countOffline & " 台<br>" & _
        "总计: " & (countOnline + countOffline) & " 台"

    Set objShell = Nothing
End Sub

' 测试单个计算机
Function TestSingleComputer(objShell, strComputer)
    Dim strCommand, strOutput, objExec, bOnline

    strCommand = "ping -n 2 -w 1000 " & strComputer
    Set objExec = objShell.Exec(strCommand)

    ' 读取输出
    Do While Not objExec.StdOut.AtEndOfStream
        strOutput = strOutput & objExec.StdOut.ReadLine() & " "
    Loop

    ' 判断是否在线
    bOnline = (InStr(strOutput, "TTL=") > 0)

    ' 生成结果HTML
    If bOnline Then
        TestSingleComputer = "<div class='result online'>✓ " & _
                            strComputer & " - 在线</div>"
    Else
        TestSingleComputer = "<div class='result offline'>✗ " & _
                            strComputer & " - 离线</div>"
    End If

    Set objExec = Nothing
End Function

' 清空结果
Sub ClearResults()
    document.getElementById("results").innerHTML = ""
End Sub

' 导出结果
Sub ExportResults()
    Dim objFSO, objFile, strContent
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("ping_report_" & _
                  Replace(Now(), ":", "-") & ".txt", True)

    strContent = "批量Ping测试报告" & vbCrLf & _
                 "测试时间: " & Now() & vbCrLf & vbCrLf & _
                 document.getElementById("results").innerText

    objFile.Write strContent
    objFile.Close

    MsgBox "结果已导出到当前目录！", vbInformation
End Sub

' 主程序入口
Call CreateGUI

三、增强功能版（带配置文件）

' config_batch_ping.vbs
' 配置文件: ping_config.ini
' [Settings]
' Computers=192.168.1.1,192.168.1.2,192.168.1.3
' PingCount=4
' Timeout=1000
' LogFile=ping_log.txt

Option Explicit

' 读取配置
Function ReadConfig()
    Dim objFSO, objFile, strLine, strSection
    Dim config
    Set config = CreateObject("Scripting.Dictionary")

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    If objFSO.FileExists("ping_config.ini") Then
        Set objFile = objFSO.OpenTextFile("ping_config.ini", 1)

        While Not objFile.AtEndOfStream
            strLine = Trim(objFile.ReadLine)

            ' 跳过注释和空行
            If strLine <> "" And Left(strLine, 1) <> ";" Then
                ' 处理节
                If Left(strLine, 1) = "[" And Right(strLine, 1) = "]" Then
                    strSection = Mid(strLine, 2, Len(strLine) - 2)
                ' 处理键值对
                ElseIf InStr(strLine, "=") > 0 Then
                    Dim arrKeyValue
                    arrKeyValue = Split(strLine, "=", 2)
                    config(strSection & "." & Trim(arrKeyValue(0))) = Trim(arrKeyValue(1))
                End If
            End If
        Wend

        objFile.Close
    End If

    Set ReadConfig = config
    Set objFSO = Nothing
End Function

' 批量Ping主程序
Sub BatchPingWithConfig()
    Dim config, objShell, objFSO, objLogFile
    Dim arrComputers, strComputer, i
    Dim nPingCount, nTimeout, strLogFile

    ' 读取配置
    Set config = ReadConfig()

    ' 获取配置值
    arrComputers = Split(config("Settings.Computers"), ",")
    nPingCount = CInt(config("Settings.PingCount"))
    nTimeout = CInt(config("Settings.Timeout"))
    strLogFile = config("Settings.LogFile")

    ' 创建对象
    Set objShell = CreateObject("WScript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' 创建日志文件
    Set objLogFile = objFSO.OpenTextFile(strLogFile, 8, True)

    ' 写入日志头
    objLogFile.WriteLine "=" & String(60, "=")
    objLogFile.WriteLine "批量Ping测试开始: " & Now()
    objLogFile.WriteLine "=" & String(60, "=")

    ' 遍历测试
    For i = 0 To UBound(arrComputers)
        strComputer = Trim(arrComputers(i))

        If strComputer <> "" Then
            Dim strResult
            strResult = PingWithParameters(objShell, strComputer, nPingCount, nTimeout)

            ' 输出到屏幕
            WScript.Echo strResult

            ' 写入日志
            objLogFile.WriteLine strResult
        End If
    Next

    ' 写入日志尾
    objLogFile.WriteLine "=" & String(60, "=")
    objLogFile.WriteLine "批量Ping测试结束: " & Now()
    objLogFile.WriteLine "=" & String(60, "=") & vbCrLf

    ' 关闭文件
    objLogFile.Close

    ' 清理
    Set objLogFile = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
    Set config = Nothing

    WScript.Echo "测试完成！"
End Sub

' 带参数的Ping函数
Function PingWithParameters(objShell, strComputer, nCount, nTimeout)
    Dim strCommand, strOutput, objExec
    Dim strResult, bOnline

    ' 构造命令
    strCommand = "ping -n " & nCount & " -w " & nTimeout & " " & strComputer

    ' 执行命令
    Set objExec = objShell.Exec(strCommand)

    ' 读取输出
    Do While Not objExec.StdOut.AtEndOfStream
        strOutput = strOutput & objExec.StdOut.ReadLine() & vbCrLf
    Loop

    ' 分析结果
    bOnline = (InStr(strOutput, "TTL=") > 0)

    If bOnline Then
        ' 提取统计信息
        Dim arrLines, j, strLine, posMin, posMax, posAvg
        Dim minTime, maxTime, avgTime

        arrLines = Split(strOutput, vbCrLf)
        For j = 0 To UBound(arrLines)
            strLine = arrLines(j)

            ' 查找最小延迟
            If InStr(strLine, "最小值 = ") > 0 Then
                posMin = InStr(strLine, "最小值 = ")
                minTime = Trim(Mid(strLine, posMin + 5))
            End If

            ' 查找最大延迟
            If InStr(strLine, "最大值 = ") > 0 Then
                posMax = InStr(strLine, "最大值 = ")
                maxTime = Trim(Mid(strLine, posMax + 5))
            End If

            ' 查找平均延迟
            If InStr(strLine, "平均 = ") > 0 Then
                posAvg = InStr(strLine, "平均 = ")
                avgTime = Trim(Mid(strLine, posAvg + 4))
            End If
        Next

        strResult = Format(Now(), "yyyy-mm-dd hh:mm:ss") & " - " & _
                   strComputer & " - 在线 - " & _
                   "最小: " & minTime & " 最大: " & maxTime & " 平均: " & avgTime
    Else
        strResult = Format(Now(), "yyyy-mm-dd hh:mm:ss") & " - " & _
                   strComputer & " - 离线"
    End If

    PingWithParameters = strResult
    Set objExec = Nothing
End Function

' 主程序
Call BatchPingWithConfig