导读 | 本文主要介绍了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 = " 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的项目实现的文章就介绍到这了。