'********************************************************************************
'Script to ping servers and send an email
'to a group of people if it is not reachable
'7/26/12 Jeff Berndsen
'********************************************************************************
Option Explicit
On Error Resume Next
Dim strServerName, oFSO, WSHShell, strServerFile, PINGFlag, i, ServerPingFlag
Dim strLogFileName, strLogFolderName, strLogPath, objLogFolderName
Dim objLogFileName, objLogTextFile, strMyDate
Const ForAppending = 8
Public strMailTo, strSMTP, strSubject, strBody, strSMTPUserName, strSMTPPassword, strSMTPPort
'SMTP Settings
strSMTPUserName = ""
strSMTPPassword = ""
strSMTP = ""
strSMTPPort = ""
strMailTo = ""
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WSHShell = CreateObject("WScript.Shell")
'Keep looping back through the script so that it stays running
i = 0
Do While i = 0
Set strServerFile = oFSO.OpenTextFile("ServerList.txt")
'Convert date to a more readable format
strMyDate = Date
strMyDate = Replace(strMyDate,"/","_")
'Log settings
strLogFolderName = ""
strLogFileName = "\" & strMyDate & ".log"
strLogPath = strLogFolderName & strLogFileName
'Check that the log folder exists
If oFSO.FolderExists(strlogFolderName) Then
Set objLogFolderName = oFSO.GetFolder(strLogFolderName)
Else
Set objLogFolderName = oFSO.CreateFolder(strLogFolderName)
End If
'Check that the log file exists
If oFSO.FileExists(strLogFolderName & strLogFileName) Then
Set objLogFolderName = oFSO.GetFolder(strLogFolderName)
Else
Set objLogFileName = oFSO.CreateTextFile(strLogFolderName & strLogFileName, True)
objLogFileName.Close 'Log file has to be closed before it can be appended to
End If
'Open the log file for appending
Set objLogTextFile = oFSO.OpenTextFile(strLogPath, ForAppending, True)
objLogTextFile.WriteLine(Now & vbCrLf)
Do While Not (strServerFile.AtEndOfStream)
strServerName = strServerFile.ReadLine
If ServerPing(strServerName) Then
ServerPingFlag = "Online"
'Ping was successful
Logger strServerName, ServerPingFlag
Else
'Ping was not successful
ServerPingFlag = "***Offline***"
EmailAdmins strServerName
Logger strServerName, ServerPingFlag
End If
Loop
objLogTextFile.WriteLine("----------------------------------------------")
WScript.Sleep 300000
Loop
'********************************************************************************
'ServerPing Function
'Ping the server and if available return true, otherwise false
'********************************************************************************
Function ServerPing(strServerName)
Set WSHShell = CreateObject("WScript.Shell")
PINGFlag = Not CBool(WSHShell.Run("ping -n 1 " & strServerName, 0, True))
If PINGFlag = True Then
'Ping was successful
ServerPing = True
Else
'Ping not successful
ServerPing = False
End If
End Function
'********************************************************************************
'EmailAdmins Sub-Routine
'Send email to the admins
'********************************************************************************
Sub EmailAdmins (strServerName)
Dim oMsg, oFlds, oConf
Const cdoSendUsingPort = 2
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oFlds = oConf.Fields
strBody = strServerName & " is not able to be pinged on " & Now
With oFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSMTPUserName
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSMTPPassword
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
With oMsg
Set .Configuration = oConf
.Fields("urn:schemas:httpmail:importance").Value = 2 ' Set mail importance to HIGH
.Fields.Update
.To = strMailTo
.From = ""
.Sender = strSMTPUserName
.Subject = strServerName & ": Not Pingable"
.TextBody = strBody
.Send
End With
End Sub
'********************************************************************************
'Logger Sub-Routine
'Log successes and failures in pinging
'********************************************************************************
Sub Logger(strServerName, ServerPingFlag)
objLogTextFile.WriteLine(strServerName & ";" & ServerPingFlag)
End Sub
ping&send$mail
精选 转载
提问和评论都可以,用心的回复会被更多人看到
评论
发布评论
相关文章
-
python send mail
plese find www.baidu.com
python send mail