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
 '合成Pinhttp://www.devze.comg查询条件语句
 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" )

AddPingSchemkzmbgWIiyMe ( "192.168.1.8" )


'--------------------------------------------------------------------http://www.devze.com--------------------------


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 & "找不到主机 " & objP开发者_Go入门ing.Address
    Else
     strDisplay = strDisplay & "错误：" & objPing.StatusCode & vbCrlf
     strLog   = strLog & "错误：" & objPing.StatusCodehttp://www.devze.com
    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).Discon编程客栈nectionCount = 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内容请搜索我们以前的文章或继续浏览下面的相关文章希望大家以后多多支持我们！