vDate = Time
strRComputer = "АдресОсновногоMDaemon"
Rezult = 0
LastRezult = 0
set oShell = CreateObject ("wscript.shell")
Do
if vDate < "22:00:00" or vDate > "09:45:00" then
' Проверка ping-ом Компьютера с MDaemon
Call IsOnline(Rezult,strRComputer)
'Перепроверяю связь в еще 5 раз, если с первого раза соединение не прошло
' ----------------------------------------------------------------------------------------------------------------------
if Rezult = 1 then
iRecheck = 1
Do until iRecheck >= 5
WScript.Sleep 10000
Call IsOnline(Rezult, strRComputer)
if Rezult = 0 then
exit do
end if
iRecheck = IRecheck + 1
loop
if LastRezult = 0 and Rezult = 1 then
oShell.LogEvent 2, "Ping не прошел."
end if
end if
' ----------------------------------------------------------------------------------------------------------------------
' Если Ping прошел успешно, то проверяем работу сервиса.
' ----------------------------------------------------------------------------------------------------------------------
if Rezult = 0 then
' вызов подпрограммы проверки сервиса
Call CheckMdaemon(Rezult, strRComputer)
If Rezult = 1 and LastRezult = 0 then
oShell.LogEvent 2, "MDaemon остановлен или отсутствует"
end if
End if
' ----------------------------------------------------------------------------------------------------------------------
' Подведение итогов запись логов, изменение адреса в DNS, запуск копии MDaemon
' ----------------------------------------------------------------------------------------------------------------------
If Rezult = 1 then
' если почтовый сервис не доступен,а последний раз он был доступен
if LastRezult = 0 then
oShell.LogEvent 1, "Основной почтовый сервис не доступен"
Call ChangeCMailRecord(Rezult)
end if
' если почтовый сервис доступен, а последний раз он был не доступен
else
if LastRezult = 1 then
oShell.LogEvent 4, "Восстановлен доступ к основному почтовому сервису."
Call ChangeCMailRecord(Rezult)
end if
end if
LastRezult= Rezult
End if
WScript.Sleep 30000
Loop
' ==================================================================
' Процедура Ping
' ==================================================================
Sub IsOnline(Answer, strRComputer)
dim wshShell, fso, tfolder, tname, TempFile, results, retString, ts
Const ForReading = 1, TemporaryFolder = 2
reachable = false
set wshShell=wscript.createobject("wscript.shell")
set fso = CreateObject("Scripting.FileSystemObject")
Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
tname = fso.GetTempName
TempFile = tfolder & tname
wshShell.run "cmd /c ping -n 3 " & strRComputer & ">" & TempFile,0,true
set results = fso.GetFile(TempFile)
set ts = results.OpenAsTextStream(ForReading)
do while ts.AtEndOfStream <> True
retString = ts.ReadLine
if instr(retString, "Reply")>0 then
answer = 0
exit do
else
answer = 1
end if
loop
ts.Close
results.delete
end Sub
' ==================================================================
' Процедура проверки сервиса MDaemon
' ==================================================================
Sub CheckMdaemon(Answer, strRComputer)
on error resume next
MDaemonState = "UnKnown"
Set objRWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=Impersonate}!\\" & strRComputer & "\root\cimv2")
Select Case Err.Number
Case 0
Set colStoppedServices = objRWMIService.ExecQuery _
("SELECT DisplayName,State FROM Win32_Service WHERE DisplayName = 'MDaemon'")
For Each objService in colStoppedServices
MDaemonState = objService.State
Next
If MDaemonState <> "Running" then
Answer = 1
else
Answer = 0
end if
Case Else
Answer = 1
End Select
end Sub
' ==================================================================
' Процедура смены DNS записи CMail.domain.ru
' Требуется WMI DNS Provider. Можно взять на
'
ftp://ftp.microsoft.com/reskit/win2000/dnsprov.zip' ==================================================================
Sub ChangeCMailRecord(Answer)
set oShell = CreateObject ("wscript.shell")
' Проверяем доступность основного DNS
Call IsOnline(DNSRezult, "АдресПервогоDNS")
If Answer = 1 then ' если сигнал отказа сервиса
' Меняем на резервном DNS запись CMail
strDNSComputer = "ИмяРезервногоDNS"
Set objWMIService = GetObject("winmgmts:\\" & strDNSComputer & "\root\MicrosoftDNS")
Set colItems = objWMIService.ExecQuery("Select * from MicrosoftDNS_AType where OwnerName = 'CMail.domain.ru'")
For Each objItem in colItems
ErrRezult = objItem.Modify(,"АдресРезервногоMDaemon",RR)
Next
oShell.LogEvent 4, "Запись CMail на резервном DNS изменена"
if DNSRezilt = 0 then ' Если основной DNS доступен
' Меняем на основном DNS запись CMail
strDNSComputer = "ИмяОсновногоDNS"
Set objWMIService = GetObject("winmgmts:\\" & strDNSComputer & "\root\MicrosoftDNS")
Set colItems = objWMIService.ExecQuery("Select * from MicrosoftDNS_AType where OwnerName = 'CMail.domain.ru'")
For Each objItem in colItems
ErrRezult = objItem.Modify(,"АдресРезервногоMDaemon",RR)
Next
oShell.LogEvent 4, "Запись CMail на основном DNS изменена"
end if
Call MDaemonStartStop(Answer)
else ' если сигнал, доступности основного сервера
' Меняем на резервном DNS запись CMail
strDNSComputer = "ИмяРезервногоDNS"
Set objWMIService = GetObject("winmgmts:\\" & strDNSComputer & "\root\MicrosoftDNS")
Set colItems = objWMIService.ExecQuery("Select * from MicrosoftDNS_AType where OwnerName = 'CMail.domain.ru'")
For Each objItem in colItems
ErrRezult = objItem.Modify(,"АдресОсновногоMDaemon",RR)
Next
oShell.LogEvent 4, "Запись CMail на резервном DNS изменена"
if DNSRezilt = 0 then ' Если основной DNS доступен
' Меняем на основном DNS запись CMail
strDNSComputer = "ИмяОсновногоDNS"
Set objWMIService = GetObject("winmgmts:\\" & strDNSComputer & "\root\MicrosoftDNS")
Set colItems = objWMIService.ExecQuery("Select * from MicrosoftDNS_AType where OwnerName = 'CMail.domain.ru'")
For Each objItem in colItems
ErrRezult = objItem.Modify(,"АдресОсновногоMDaemon",RR)
Next
oShell.LogEvent 4, "Запись CMail на основном DNS изменена"
end if
Call MDaemonStartStop(Answer)
end if
end sub
' ================================================================================
=====
' Запуск/остановка сервиса MDaemon
' ================================================================================
=====
Sub MDaemonStartStop(Answer)
strMDaemonComp = "АдресРезервногоMDaemon"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strMDaemonComp & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name='MDaemon'")
if Answer = 1 then
For each objService in colServiceList
errReturn = objService.StartService()
Next
else
For each objService in colServiceList
errReturn = objService.StopService()
Next
end if
end sub