VBS批量Ping的项目实现
本文用vb编写的 ping程序实现，具体如下：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | '判断当前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的项目实现的文章就介绍到这了,更多相关VBS 批量Ping内容请搜索代码部落以前的文章或继续浏览下面的相关文章希望大家以后多多支持代码部落！
本文章来源于网络，作者是：技术员puc，由代码部落进行采编，如涉及侵权请联系删除！转载请注明出处：https://daimabuluo.cc/vbs/260.html
