使用 Ping 指令來檢查網路品質

最近為了客戶移機的事，又寫了一支WSH，它是用ping來檢測網路品質，將結果存到CSV File，然後寄到指定的信箱裡。

當我收到這個CSV File時，就可以把它匯入SQL Server，利用Excel來繪製網路品質的圖表。

On Error Resume Next ' Open File Mode (Read/Write) Const ForAppending = 2 ' 8 (hrs) * 60 (Minutes) * 60 (Seconds) = 28800 Const nTimes = 28800 ' 1 Second = 1000 Const nSleep = 1000 ' Branch Office Name ' 因為客戶有多個辦公室，所以加上一個Location欄位，以便日後分析 Const strLocation = "上海" ' Ping Server Public IP ' 這邊請輸入您自己要測試的端點 Public  IP Const strPingServer = "123.123.123.123" ' 設定 SMTP Server Const strSMTP = "xxx.xxx.xxx" ' 設定供 SMTP驗證的帳號 Const strUser = "UserName" ' 設定供 SMTP驗證的帳號密碼 Const strPasswd = "12345678" ' Initialize Variables 設定變數初始值 ' Ping Status nStatus = 0 strIP = "" nResponseTime = 0 strAttachFile = "" strMonth = Month(Date()) If Len(strMonth) = 1 Then   strMonth = "0" & strMonth End If strDay = Day(Date()) If Len(strDay) = 1 Then   strDay = "0" & strDay End If strYear = Year(Date()) strHour = Hour(Time()) If Len(strHour) = 1 Then   strHour = "0" & strHour End If strMinute = Minute(Time()) If Len(strMinute) = 1 Then   strMinute = "0" & strMinute End If strSecond = Second(Time()) If Len(strSecond) = 1 Then   strSecond = "0" & strSecond End If strLogFile = "C:\" & strLocation & "_" & strYear & strMonth & strDay & "_" & strHour & strMinute & strSecond & ".txt" ' 檢查是否還存在 Log File，如果存在，就把它寄出去，然後刪掉(有可能之前 Ping 程式執行到一半就被中斷，例如關機或當機 strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colFileList = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='C:\'} Where " & "ResultClass = CIM_DataFile") For Each objFile In colFileList   If InStr(objFile.FileName, strLocation) Then   strAttachFile = "C:\" & objFile.FileName & ".txt"   ' 寄出 Log 檔案   Set objEmail = CreateObject("CDO.Message")   objEmail.From = "tombo@ms13.url.com.tw"   objEmail.To = "tombo.katherine@gmail.com"   objEmail.Subject = "Ping Status from" & strLocation & "@" & now()   objEmail.Textbody = "Ping Status from " & strLocation   objEmail.Addattachment strAttachFile   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser   objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPasswd   objEmail.Configuration.Fields.Update   objEmail.Send   ' 刪除已寄出的 Log File   Set objFSO = CreateObject("Scripting.FileSystemObject")   objFSO.DeleteFile(strAttachFile)   End If Next ' Check IP strPublicIP = "xxx.xxx.xxx.xxx" strURL="http://briian.com/files/act/myip-widget.php" Set objHTTP = CreateObject("MSXML2.XMLHTTP") Set objRegEx = CreateObject("VBScript.RegExp") objRegEx.Global = True objRegEx.Pattern = "\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}" objHTTP.Open "GET", strURL, FALSE objHTTP.Send Set colMatches = objRegEx.Execute(objHTTP.ResponseText) For Each strMatch in colMatches strPublicIP = strMatch.Value Next Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile ( strLogFile , ForAppending , True) Set colServices = GetObject("winmgmts:").ExecQuery ("Select * from Win32_Service") objTextFile.WriteLine( "Location" & "," & "Public IP" & "," & "Date" & "," & "Time" & "," & "Count" & "," & "Status Code" & "," & "Address" & "," & "ResponseTime") Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") for nLoop = 1 to nTimes Set colItems = objWMIService.ExecQuery ("Select * from Win32_PingStatus " & "Where Address = '" & strPingServer & "'") For Each objItem in colItems   if objItem.StatusCode = 0 then   nStatus = objItem.StatusCode   strIP = objItem.Address   nResponseTime = objItem.ResponseTime   objTextFile.WriteLine( strLocation & "," & strPublicIP & "," & Date() & "," & Time() & "," & nLoop & "," & nStatus & "," & strIP & "," & nResponseTime )   else ' Ping 不到的狀況   objTextFile.WriteLine( strLocation & "," & strPublicIP & "," & Date() & "," & Time() & "," & nLoop & "," & nStatus & "," & strIP & "," & "-1" )   end if Next Wscript.Sleep nSleep Next  objTextFile.Close Set objEmail = CreateObject("CDO.Message") objEmail.From = "tombo@ms13.url.com.tw" objEmail.To = "tombo.katherine@gmail.com" objEmail.Subject = "Ping Status from" & strLocation & "@" & now() objEmail.Textbody = "Ping Status from " & strLocation objEmail.Addattachment strLogFile objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPasswd objEmail.Configuration.Fields.Update objEmail.Send ' 刪除已寄出的 Log File Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.DeleteFile(strLogFile)

其實這個功能跟我之前介紹的 ping commander很類似，只是我用WSH寫的，沒有 GUI 介面，而且多了個寄送 Log的功能。但是沒有支援 ping 多個目標的功能。

也許改天有空再改用 HTA來寫 GUI 介面的程式。

後記：

如果該程式的 strLocation最好使用英文，最好不要用中文，以免用戶端如果非繁中語系程式就會出問題！