strScriptStart = Now
On Error Resume Next
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
if len(time) = 7 then
mytime = "0" & time
else
mytime = time
end If
dim http: set http = CreateObject("MSXML2.XMLHTTP")
strBody = ""
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut
strInputPath = "elérési út\pinger.cfg" '- location of input
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
'Menu1 - Ping
' *** PING CHECK ***
strBody = ""
subject1 = "<b>Ping: <font color=green><big>Rendben</big><font color=black></b>"
Do until objTextIn.AtEndOfStream = True
strOlvas = objTextIn.ReadLine
IntVesszo = inStr(strOlvas,",")
strComputer = Left(strOlvas,IntVesszo-1)
if fPingTest( strComputer ) then
strStatus = "<tr><td><font color=green>OK</td><td>"
else
strStatus = "<tr><td><font color=red>KO</td><td>"
subject1 = "<b>Ping: <font color=red><big>Hiba!</big><font color=black></b>"
SendEmail = True
end if
strBody = strBody & strStatus & strOlvas & "<font color=black></td></tr>"
' objTextOut.WriteLine(strStatus & " - " & strOlvas)
loop
function fPingTest( strComputer )
dim objShell,objPing
dim strPingOut, flag
set objShell = CreateObject("Wscript.Shell")
set objPing = objShell.Exec("ping -n 1 " & strComputer)
strPingOut = objPing.StdOut.ReadAll
if instr(LCase(strPingOut), "reply") then
flag = TRUE
else
flag = FALSE
end if
fPingTest = flag
end function
strHContent1 = "<html lang=""hu""><meta http-equiv=""Content-Type"" content=""text/html; charset=iso-8859-2"" /> <meta http-equiv=""refresh"" content=""60"" ><body><table border=""1"">" & "<h1><b>Pingelt szerverek<b><br></h1><hr>" & strBody & "</table></body></html>