' ******************** НАСТРОЙКИ ********************
' Email'ы на которые нужно отправить сообщение об ошибке
arrayEmails = Array("Example1@mail.ru", _
"Example2@mail.ru", _
"Example3@mail.ru")
' Наименование отслеживаемой службы
Const strServiceName = "Fax"
' Имя почтового сервера (например, "smtp.mail.ru" для mail.ru)
Const strSmtpServer = "smtp.mail.ru"
' Порт почтового сервера
Const intSmtpPort = 465
' SMTP через SSL
Const strSmtpSsl = "yes"
' Использовать аутентификацию
Const strSmtpAuth = "yes"
' Email отправителя
Const strSendingEmail = "Example4@mail.ru"
' Пароль отправителя
Const strSmtpPass = "password"
' Путь к каталогу с логами
Const logsDirectoryPath = "c:\logs\"
' ***************** КОНЕЦ НАСТРОЕК ******************
' *************** ОСНОВНАЯ ПРОГРАММА ****************
Const SCRIPT_INFO_LEVEL = 0
Const SCRIPT_ERROR_LEVEL = 1
Const SERVICE_INFO_LEVEL = 2
Const SERVICE_ERROR_LEVEL = 3
Const MAX_ATTEMPTS = 3
Const strServiceRunStatus = "RUNNING"
Call writeInLog(SCRIPT_INFO_LEVEL, "Проверка состояние службы " & strServiceName)
strServiceStatus = getCommandOutput("%COMSPEC% /C sc query " & strServiceName)
intFindSymbol = InStr(1, strServiceStatus, strServiceRunStatus)
If intFindSymbol = 0 Then
Call writeInLog(SCRIPT_INFO_LEVEL, "Cлужба " & strServiceName & " не работает")
Call writeInLog(SERVICE_ERROR_LEVEL, strServiceStatus)
strSubject = "Служба " & _
Chr(34) & strServiceName & Chr(34) & _
" не работает. " & _
Now() & "."
strMessage = strSubject & vbNewLine & strServiceStatus
emailsCounter = 0
Do
Call sendMail(arrayEmails(emailsCounter), strSubject, normalizeToHTML(strMessage))
emailsCounter = emailsCounter + 1
Loop Until (emailsCounter > UBound(arrayEmails))
Else
Call writeInLog(SCRIPT_INFO_LEVEL, "Cлужба " & strServiceName & " работает")
Call writeInLog(SERVICE_INFO_LEVEL, strServiceStatus)
End If
Call writeInLog(SCRIPT_INFO_LEVEL, "Скрипт завершил работу")
' ************ КОНЕЦ ОСНОВНОЙ ПРОГРАММЫ *************
' Процедура для отправки email сообщения
' Параметры:
' strDestinationEmail - email получателя
' strSubject - тема сообщения
' strMessageText - текст сообщения
Sub sendMail(strDestinationEmail, strSubject, strMessageText)
On Error Resume Next
Call writeInLog(SCRIPT_INFO_LEVEL, "Отправляем сообщение об ошибке на " & strDestinationEmail)
Set objMessage = CreateObject("CDO.Message")
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSmtpPort
If strSmtpAuth = "yes" Then
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'use '2' for NTLM authentication
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSendingEmail
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSmtpPass
End If
If strSmtpSsl = "yes" Then
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
objMessage.Configuration.Fields.Update
objMessage.Subject = strSubject
objMessage.From = strSendingEmail
objMessage.To = strDestinationEmail
objMessage.HTMLBody = strMessageText
attempt = 1
Do
Call writeInLog(SCRIPT_INFO_LEVEL, "Попытка отправки № " & attempt)
Err.Clear
objMessage.Send
attempt = attempt + 1
Loop Until ((attempt > MAX_ATTEMPTS) Or (Err.Number = 0))
If Err.Number <> 0 Then
Call writeInLog(SCRIPT_ERROR_LEVEL, "Не удалось отправить сообщение об ошибке на " & strDestinationEmail)
Else
Call writeInLog(SCRIPT_INFO_LEVEL, "Сообщение об ошибке успешно отправлено на " & strDestinationEmail)
End If
Err.Clear
End Sub
' Функция для замены символа переноса строки на "<br>"
' для корректного отображения сообщения.
' Возращает нормализованную строку
Function normalizeToHTML(str)
arrayRows = Split(str, vbNewLine)
normalizeToHTML = ""
rowsCounter = 0
Do
normalizeToHTML = normalizeToHTML & arrayRows(rowsCounter) & "<br>"
rowsCounter = rowsCounter + 1
Loop Until (rowsCounter > UBound(arrayRows))
End Function
' Процедура для записи сообщения в лог
Sub writeInLog(level, str)
On Error Resume Next
Const FOR_APPENDING = 8
Const PATH_NOT_FOUND_ERROR = 76
separator = vbNewLine & _
"********************************************************" & _
vbNewLine
If ((level = SERVICE_ERROR_LEVEL) Or (level = SERVICE_INFO_LEVEL)) Then
strLogPath = logsDirectoryPath & "service_log_" & date & ".txt"
Else
strLogPath = logsDirectoryPath & "script_log_" & date & ".txt"
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strLogPath, FOR_APPENDING, True)
If Err.Number = PATH_NOT_FOUND_ERROR Then
WScript.Echo "Путь " & _
Chr(34) & logsDirectoryPath & Chr(34) & _
" не найден." & vbNewLine & _
"Работа скрипта будет завершена."
WScript.Quit
End If
objFile.Write Now()
Select Case level
Case SCRIPT_INFO_LEVEL
objFile.Write " INFO: " & str
Case SCRIPT_ERROR_LEVEL
objFile.Write " ERROR: " & str
Case SERVICE_INFO_LEVEL
objFile.Write " INFO: " & vbNewLine & str
Case SERVICE_ERROR_LEVEL
objFile.Write " ERROR: " & vbNewLine & str
End Select
If ((level = SERVICE_ERROR_LEVEL) Or (level = SERVICE_INFO_LEVEL)) Then
objFile.WriteLine separator
Else
objFile.WriteLine vbNewLine
End If
objFile.Close
End Sub
' Команда для получения результата выполнения cmd комманды
Function getCommandOutput(Command)
Const Wait = 1
Const Show = 0
Const OutToFile = "TEMP.TXT"
Const DeleteOutput = 1
Const NoQuotes = 1
On Error Resume Next
Set f_objShell = CreateObject("Wscript.Shell")
Set f_objFso = CreateObject("Scripting.FileSystemObject")
'VARIABLES
If OutToFile = "" Then OutToFile = "TEMP.TXT"
tCommand = Command
If Left(Command,1)<>"""" And NoQuotes <> 1 Then tCommand = """" & Command & """"
tOutToFile = OutToFile
If Left(OutToFile,1)<>"""" Then tOutToFile = """" & OutToFile & """"
If Wait = 1 Then tWait = True
If Wait <> 1 Then tWait = False
If Show = 1 Then tShow = 1
If Show <> 1 Then tShow = 0
'RUN PROGRAM
f_objShell.Run tCommand & ">" & tOutToFile, tShow, tWait
Call changeEncoding(OutToFile, "CP866", "windows-1251")
'READ OUTPUT FOR RETURN
Set f_objFile = f_objFso.OpenTextFile(OutToFile, 1)
tMyOutput = f_objFile.ReadAll
f_objFile.Close
Set f_objFile = Nothing
'DELETE FILE AND FINISH FUNCTION
If DeleteOutput = 1 Then
Set f_objFile = f_objFso.GetFile(OutToFile)
f_objFile.Delete
Set f_objFile = Nothing
End If
getCommandOutput = tMyOutput
If Err.Number <> 0 Then getCommandOutput = "<0>"
Err.Clear
On Error Goto 0
Set f_objFile = Nothing
Set f_objShell = Nothing
End Function
Sub changeEncoding(path, fromEnc, toEnc)
Set str = CreateObject("ADODB.Stream")
str.Type = 2
str.Charset = fromEnc
str.Open()
str.LoadFromFile(path)
Text = str.ReadText()
str.Close()
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFile(path)
str.Charset = toEnc
str.Open()
str.WriteText(Text)
str.SaveToFile path, 2
str.Close()
End Sub
Средний
