VBS 批量Ping的项目实现

admin VBS

2023-12-01 0 446

本文用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内容请搜索悠久资源网以前的文章或继续浏览下面的相关文章希望大家以后多多支持悠久资源网！

您可能感兴趣的文章: