溫馨提示×
您好，登錄后才能下訂單哦！
點擊 登錄注冊 即表示同意《億速云用戶服務條款》
您好，登錄后才能下訂單哦！
這篇文章主要介紹“VBS批量Ping的項目怎么實現”，在日常操作中，相信很多人在VBS批量Ping的項目怎么實現問題上存在疑惑，小編查閱了各式資料，整理出簡單好用的操作方法，希望對大家解答”VBS批量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的項目怎么實現”的學習就結束了，希望能夠解決大家的疑惑。理論與實踐的搭配能更好的幫助大家學習，快去試試吧！若想繼續學習更多相關知識，請繼續關注億速云網站，小編會繼續努力為大家帶來更多實用的文章！
免責聲明：本站發布的內容（圖片、視頻和文字）以原創、轉載和分享為主，文章觀點不代表本網站立場，如果涉及侵權請聯系站長郵箱：is@yisu.com進行舉報，并提供相關證據，一經查實，將立刻刪除涉嫌侵權內容。
