[问题求助] [已解决]vbs怎样监控ping的返回信息，并做出判断

gmwd18

本人经常要进行服务器远程维护，现想做个脚本，监控一下维护机到服务器的网络连通状况，具体功能如下：（希望大家给点思路）
1.脚本可以一直ping一个或多个ip地址，并监控ping的返回信息，如果发现有大于等于3个连续的丢包(即3个连续的request timeout）的情况时，记录一条日志到一个txt文件中，格式为“年月日 时间： 到某某Ip网络有丢包”
2.如果发现有超过10个连续的丢包，则发送一封电子邮件，到指定的邮箱，邮件内容为“网络丢包严重，请检查网络”
由于本人vbs接触不多，最近正在学习，对于这种监控代码没有什么头绪，所以想请各位高手指点一下，给点思路和一些代码示例参考一下，不胜感谢！

zhangop9

回复 2# powerbat
老大能不能也给我写一个代码,问题在这个帖子上:
http://bbs.bathome.net/thread-18341-1-1.html

gmwd18

回复 6# powerbat
谢谢了，脚本可以使用了，大家有兴趣的可以收藏一下，powerbat的代码拿来就能用，也可以根据自己的需要再修改一下，注：上面代码中的“_”符号是续行符，脚本里面要去掉哦~

powerbat

代码明显是两行（为了不使一行太长影响阅读和维护，因而用了续行符“_”分成了两行）。
要合成一行得把续行符“_”去掉。

gmwd18

回复 4# powerbat


    谢谢powerbat，代码大部分搞懂了，又让我学习了不少，不过上述代码中的

WQL = "Select * from Win32_PingStatus Where Address='" _    & Join(arrIP, "' OR Address='") & "'" 
复制代码

这一句有报错，说什么不符合的字符，我把where 条件后面的改为address='单个ip'  就可以了，是不是上面这句有笔误，顺带求解一下上面这句SQL查询是什么意思，谢谢了哈！

powerbat

不是监控，而是用do循环不停地ping。

gmwd18

回复 2# powerbat

感谢powerbat，代码有许多看不懂，我自己再琢磨一下~
    不过我怎么没看出那些是用来实时监控的语句呢，求解答~

powerbat

arrIP = Array("192.168.0.1", "www.baidu.com", "74.125.71.14")
Dim arrCnt() : Redim arrCnt(UBound(arrIP))

WQL = "Select * from Win32_PingStatus Where Address='" _
    & Join(arrIP, "' OR Address='") & "'"

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("netstat.log", 8, true)
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Do
  i = 0
  Set colItems = objWMIService.ExecQuery(WQL, , 48)
  For Each objItem in colItems
    If objItem.StatusCode = 11010 Then
      arrCnt(i) = arrCnt(i) + 1
      if arrCnt(i)=3 then ts.WriteLine Now() & "  " & objItem.Address & " 有丢包"
      if arrCnt(i)=10 then
        SendMail "MyAccount@163.com", "password", "SendTo@163.com", _
            "网络丢包", objItem.Address & " 丢包严重，请检查网络"
      end if
    Else
      arrCnt(i) = 0
    End If
    i = i + 1
  Next
Loop

'SendMail "MyAccount@163.com", "password", "SendTo@163.com", "邮件主题", "邮件内容"
Sub SendMail(Account, Password, SendTo, Subject, Body)
    'http://www.cnblogs.com/cxy521/archive/2008/01/22/1048802.html
    On Error Resume Next
    const MsSpace = "http://schemas.microsoft.com/cdo/configuration/"
    dim CDO, Server
    Set CDO = CreateObject("CDO.Message")
    CDO.From = Account                                    '发送邮件的帐号
    CDO.To = SendTo                                       '主送邮件地址
    CDO.Subject = Subject                                 '邮件主题
    CDO.Textbody = Body                                   '邮件内容
    Server = Split(Account, "@", -1, vbTextCompare)
    With CDO.Configuration.Fields
        .Item(MsSpace&"sendusing") = 2                    '发信端口
        .Item(MsSpace&"smtpserver") = "smtp." & Server(1) 'SMTP服务器地址
        .Item(MsSpace&"smtpserverport") = 25              'SMTP服务器端口
        .Item(MsSpace&"smtpauthenticate") = 1             'Basic验证方式
        .Item(MsSpace&"sendusername") = Server(0)         '邮件帐号
        .Item(MsSpace&"sendpassword") = Password          '邮件密码
        .Update
    End With
    CDO.Send()
End Sub
复制代码