主要功能
1.当对于一个IP、10次无法Ping通后发送一份邮件。（不重复发送）
2.当网络恢复后、ping通一次后发一份恢复邮件（不重复发送）
3.在Ping通状态的时候的Ping间隔时间为1秒
4.循环监视PingIP，直到手动取消停止脚本

 

 

 
  
  1. '********************************************************************* 
  2. '* File: PingIP 
  3. '* Created:        OCT , 2011 
  4. '* Last Modified:        OCT 30, 2011 
  5. '* Version:                1.0 
  6. '* 
  7. '* Main Function: Ping an IP and Mail the result 
  8. '* 
  9. '* 
  10. '* Create by Mark.Xu 
  11. '* 
  12. '********************************************************************** 
  13. Option Explicit 
  14. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  15. 'Declare variables 
  16. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  17. Dim intPingStatusCode 
  18. Dim intPingCount 
  19. Dim strIPaddress 
  20. Dim strErr,strErrTop 
  21. Dim blSendMail,blPingErr 
  22.  
  23.  
  24. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  25. 'Give Value to variables 
  26. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  27. strIPaddress = "192.168.1.1" 
  28. intPingCount = 0 
  29. blSendMail = False 
  30. blPingErr = False 
  31.  
  32. strErrtop = "Ping " & strIPaddress & vbCr 
  33.  
  34. 'The Variables about Mail 
  35. Dim strSMTP,strSender,strSendto,strTitle,strContext,strAttachment1 
  36. Dim strSendmail 
  37. Dim mailarray(5,0) 'The mail information to array 
  38. strSMTP = "192.168.10.1" 
  39. strSender = "abc@abc.com" 
  40. strSendto = "abc@abc.com" 
  41. strTitle = "" 
  42. strContext = "" 
  43. strAttachment1 = "" 
  44.  
  45.  
  46.  
  47. Do Until intPingStatusCode = 100 
  48. intPingStatusCode = PingCheck(strIPaddress) 
  49. If intPingStatusCode <> 0 Then 
  50. intPingCount = intPingCount + 1 
  51. If blSendMail = false then 
  52.         strErr = strErr & intPingCount & ": " & PingErrDescript(intPingStatusCode) & vbCr 
  53. End if 
  54. If intPingCount = 10 Then 
  55.         blPingErr = True 
  56.         intPingCount = 0 
  57. End If 
  58. Else 
  59.         intPingCount = 0 
  60.         blPingErr = False 
  61.         WScript.Sleep 1000 
  62. End If 
  63.  
  64. If blPingErr = true Then 
  65.         If blSendMail = False Then 
  66.  
  67. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  68. 'To Send Mail 
  69. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  70.         strTitle = "Ping " & strIPaddress 
  71.         strContext = strErrtop & strErr 
  72.                 mailarray(0,0) = strSMTP 
  73.                 mailarray(1,0) = strSender 
  74.                 mailarray(2,0) = strSendto 
  75.                 mailarray(3,0) = strTitle 
  76.                 mailarray(4,0) = strContext 
  77.                 mailarray(5,0) = strAttachment1 
  78.                 strSendmail = SendMail(mailarray) 
  79.         blSendMail = True 
  80.         strErr = "" 
  81.         End If 
  82. Else 
  83.         If blSendMail = True Then 
  84.         strTitle = "PingRecover " & strIPaddress 
  85.         strContext = "PingRecover " & strIPaddress 
  86.                 mailarray(0,0) = strSMTP 
  87.                 mailarray(1,0) = strSender 
  88.                 mailarray(2,0) = strSendto 
  89.                 mailarray(3,0) = strTitle 
  90.                 mailarray(4,0) = strContext 
  91.                 mailarray(5,0) = strAttachment1 
  92.                 strSendmail = SendMail(mailarray) 
  93.         blSendMail = false 
  94.         End If 
  95. End if 
  96. Loop 
  97.  
  98.  
  99.  
  100.  
  101.  
  102. '******************************************************************** 
  103. '* 
  104. '* Function PingErrDescript(intPing) 
  105. '* Purpose: Change the WMI Win32_PingStatus StatusCode 
  106. '* Input: intStatusCode 
  107. '*                 
  108. '* Output:  strResult 
  109. '* Notes: 
  110. '******************************************************************** 
  111. Function PingErrDescript(intPing) 
  112. Select Case intPing 
  113. Case 0: 
  114.         PingErrDescript = "Success" 
  115. Case 11001: 
  116.         PingErrDescript = "Buffer Too Small" 
  117. Case 11002: 
  118.         PingErrDescript = "Destination Net Unreachable" 
  119. Case 11003: 
  120.         PingErrDescript = "Destination Host Unreachable" 
  121. Case 11004: 
  122.         PingErrDescript = "Destination Protocol Unreachable" 
  123. Case 11005: 
  124.         PingErrDescript = "Destination Port Unreachable" 
  125. Case 11006: 
  126.         PingErrDescript = "No Resources" 
  127. Case 11007: 
  128.         PingErrDescript = "Bad Option" 
  129. Case 11008: 
  130.         PingErrDescript = "Hardware Error" 
  131. Case 11009: 
  132.         PingErrDescript = "Packet Too Big" 
  133. Case 11010: 
  134.         PingErrDescript = "Request Timed Out" 
  135. Case 11011: 
  136.         PingErrDescript = "Bad Request" 
  137. Case 11012: 
  138.         PingErrDescript = "Bad Route" 
  139. Case 11013: 
  140.         PingErrDescript = "TimeToLive Expired Transit" 
  141. Case 11014: 
  142.         PingErrDescript = "TimeToLive Expired Reassembly" 
  143. Case 11015: 
  144.         PingErrDescript = "Parameter Problem" 
  145. Case 11016: 
  146.         PingErrDescript = "Source Quench" 
  147. Case 11017: 
  148.         PingErrDescript = "Option Too Big" 
  149. Case 11018: 
  150.         PingErrDescript = "Bad Destination" 
  151. Case 11032: 
  152.         PingErrDescript = "Negotiating IPSEC" 
  153. Case 11050: 
  154.         PingErrDescript = "General Failure" 
  155. End Select 
  156. End function 
  157.  
  158. '******************************************************************** 
  159. '* 
  160. '* Function PingCheck(strServer) 
  161. '* Purpose: Use WMI to Ping an IP 
  162. '* Input: strIPaddress 
  163. '*                 
  164. '* Output:intStatusCode 
  165. '* Notes: 
  166. '******************************************************************** 
  167. Function PingCheck(strServer) 
  168. Dim objWMIService,objItem 
  169. Dim colItems 
  170. Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") 
  171. Set colItems = objWMIService.ExecQuery("Select * From Win32_PingStatus Where Address='" & strServer & "'") 
  172. For Each objItem In colItems 
  173. PingCheck = objItem.StatusCode 
  174. Exit For 
  175. Next 
  176. End Function 
  177.  
  178.  
  179. '******************************************************************** 
  180. '* 
  181. '* Function SendMail(arrayMail2d) 
  182. '* Purpose: To Send mail 
  183. '* Input:    
  184. '*                 
  185. '* Output:   
  186. '* Notes: 
  187. '******************************************************************** 
  188. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  189. 'mailarray format 
  190. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  191. 'mailarray(0,0) is SMTP 
  192. 'mailarray(1,0) is Sender 
  193. 'mailarray(2,0) is Sendto 
  194. 'mailarray(3,0) is Title 
  195. 'mailarray(4,0) is Textbody 
  196. 'mailarray(5,0) is Attachment,if nothing then be null 
  197. 'Dim mailarray(5,1) 
  198. 'mailarray(0,0) = "smtp.mailtest.local" 
  199. 'mailarray(1,0) = "ServerAlert@mailtest.local" 
  200. 'mailarray(2,0) = "mailadmin@mailtest.local" 
  201. 'mailarray(3,0) = "Server ReStart" 
  202. 'mailarray(4,0) = "OK ReStart" 
  203. 'mailarray(5,1) = "D:\script_center.exe" 
  204. '*                        
  205. '* 
  206. '******************************************************************** 
  207.  
  208. Function SendMail(arrayMail2d) 
  209. On Error Resume Next 
  210. Dim objMessage 
  211. Dim y 
  212. Set objMessage = CreateObject("CDO.Message") 
  213. objMessage.Subject = arrayMail2d(3,0) 
  214. objMessage.Sender = arrayMail2d(1,0) 
  215. objMessage.To = arrayMail2d(2,0) 
  216. objMessage.TextBody = arrayMail2d(4,0) 
  217. For y = 0 To UBound(arraymail2d,2) 
  218. If Trim(arraymail2d(5,y)) <> "" Then 
  219. objMessage.AddAttachment arraymail2d(5,y) 
  220. Else 
  221. 'WScript.Echo arraymail2d(5,y) 
  222. End If 
  223. Next 
  224.  
  225. '==This section provides the configuration information for the remote SMTP server. 
  226. objMessage.Configuration.Fields.Item _ 
  227.     ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
  228. 'Name or IP of Remote SMTP Server 
  229. objMessage.Configuration.Fields.Item _ 
  230.     ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = arrayMail2d(0,0) 
  231. 'Server port (typically 25) 
  232. objMessage.Configuration.Fields.Item _ 
  233.     ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
  234. objMessage.Configuration.Fields.Update   
  235. objMessage.Send 
  236. If Err.Number = 0 then 
  237. SendMail = Err.Number 
  238. Else 
  239. SendMail = Err.Number & "," & Err.Description 
  240. Err.Clear 
  241. End If 
  242. On Error Goto 0 
  243. End Function