Sziasztok!
A következő problémával kapcsolatban szeretnék segítséget kérni.
Van egy VBS scriptem ami annyit csinál, hogy szervereket pingel és az eredményt kilistázza egy html lapra. Ezt sikerült megoldanom.
Most tovább szeretném fejleszteni, és azt szeretném megoldani, hogy nézze a szerverek lemezméretét is és jelezzen html felületen, ha telik a lemez.
Az előző scriptet továbbírva eddig annyit sikerült elérnem, hogy a pingek után beolvassa a server ipt, de utána megakad.
Valakinek van ötlete, hogy mi lehet a probléma? Köszönöm a segítséget.
- 596 megtekintés
Hozzászólások
Hogy néz ki a script?
- A hozzászóláshoz be kell jelentkezni
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>
- A hozzászóláshoz be kell jelentkezni
így néz ki az egész.
gépen egyszer fut csak le és szépen minden kilistáz, a szerveren pedig folyamatosan újraindul.
- A hozzászóláshoz be kell jelentkezni
Hogy néz ki a Scheduled task, amivel indítod, továbbá milyen visszatérési értéke van a script-nek?
( •̀ᴗ•́)╭∩╮
"speciel a blockchain igenis hogy jó megoldás, ezért nagy erőkkel keressük hozzá a problémát"
"A picsat, az internet a porno es a macskas kepek tarolorandszere! : HJ"
Az élet ott kezdődik, amikor rájössz, hogy szart sem kell bizonyítanod senkinek
Ha meg akarod nevettetni Istent, készíts tervet!
- A hozzászóláshoz be kell jelentkezni
így néz ki az egész script és a
strBody = strBody & "<b>Helyi lemezek állapota: " & arrServers(i) & "</b><br><table border=""1"">"
részig fut le.
van esetleg ötleted, hogy miért nem listázza ki a hddket? hibát nem dob.
- A hozzászóláshoz be kell jelentkezni
Itt van a teljes script már a diskspace résszel:
eddig fut le és utána elakad, de hibaüzenet nincs:
strBody = strBody & "<b>Helyi lemezek állapota: " & arrServers(i) & "</b><br><table border=""1"">"
if len(time) = 7 then
mytime = "0" & time
else
mytime = time
end If
dim http: set http = CreateObject("MSXML2.XMLHTTP")
strBody = ""
strBody2 = ""
HDDKuszob = 5
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 )
' *** PING CHECK ***
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
'HDD küszöb ***********************************************************************************************************************************************************
strBody = strBody & "<font color=grey>HDD riasztási küszöb: " & HDDKuszob & "%<br><font color=black>"
arrServers = Array("0.0.0.0.0") //serverip//
'The WMI query bit...
For i = LBound(arrServers) To UBound(arrServers)
strBody = strBody & "<b>Helyi lemezek állapota: " & arrServers(i) & "</b><br><table border=""1"">"
On Error Resume Next
Set objWMI = GetObject("winmgmts:\\" & arrServers(i) & "\root\cimv2")
Set colDisks = objWMI.ExecQuery("Select * from Win32_LogicalDisk Where DriveType=3")' Where DeviceID = '" & strDiskLetter & "'")
If Err.Number = 0 Then
For Each objDisk in colDisks
If round( bytesToMB(objDisk.FreeSpace) / bytesToMB(objDisk.Size) * 100 , 2 ) < HDDKuszob then
strBody = strBody & "<tr><td><font color=red>Drive " & objDisk.DeviceID & "</td><td><font color=red>Kapacitás(MB): " & bytesToMB(objDisk.Size) _
& "</td><td><font color=red>Szabad hely(MB): " & bytesToMB(objDisk.FreeSpace) & vbtab & "</td><td><font color=red>Szabad hely(%): " & round( bytesToMB(objDisk.FreeSpace) / bytesToMB(objDisk.Size) * 100 , 2 ) & "</td></tr>"
subject4 = "<b>Converge: <font color=red><big>Hiba!</big><font color=black></b>"
else
strBody = strBody & "<tr><td>Drive " & objDisk.DeviceID & "</td><td>Kapacitás(MB): " & bytesToMB(objDisk.Size) _
& "</td><td>Szabad hely(MB): " & bytesToMB(objDisk.FreeSpace) & vbtab & "</td><td>Szabad hely(%): " & round( bytesToMB(objDisk.FreeSpace) / bytesToMB(objDisk.Size) * 100 , 2 ) & "</td></tr>"
end if
Next
Else
strBody = strBody & "<font color=red>!ERROR! connecting to " & arrServers(i) & ". " & Err.Number & " - " & Err.Description & "<font color=black>"
Err.Clear
subject4 = "<b>Converge: <font color=red><big>Hiba!</big><font color=black></b>"
End If
strBody = strBody & "<font color=black></table><hr>"
Next
strBody = strBody & StrFileInfo
Err.Clear
' ***********************************************************************************************************************************************************
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""align=center>" & "<h1 align = center><b><font color=red>Szerver Checking<b><br></h1><hr>"& strBody & "</table></body></html>"
strHMenu1="<a href=""content1.html"" target=""main"">" & subject1 & "</a><br>"
'content1 write
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile="elérési út\content1.html"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write Now & "<br><br>" & strHContent1 & "<br>"
objFile.Close
- A hozzászóláshoz be kell jelentkezni
Nem lenne egyszerűbb erre kész szoftvert használni, pl zabbix?
- A hozzászóláshoz be kell jelentkezni
de gondoltunk rá de belső munkahelyi környezetben nem engedélyezték.....
- A hozzászóláshoz be kell jelentkezni
Sikerült megtalálni a problémát a
bytesToMB résznél volt gond.
- A hozzászóláshoz be kell jelentkezni
Erre ez is segítség lehet:
- A hozzászóláshoz be kell jelentkezni
Legközelebb kérlek, hogy kódrészleteket valami erre alkalmasabb helyre (pl.: pastebin.com, vagy github-on új gist-be) tegyél fel, és csak linkeld be.
Elég rossz practice rögtön a szkript elejére On Error Resume Next-et tenni, mert így az összes hibát el fogja nyelni az interpreter. Anno mindig csak azt a kódot vettük körbe On Error Resume Next-tel, és On Error Goto 0-val, ahol számítottunk hibára. Ahol nem számítunk hibára, ott pedig nyugodtan hasaljon csak el a szkript ahelyett, hogy nem ír ki semmit.
Hasra ütésre egyébként jogosultság probléma lesz egyébként: a scheduled taskot futtató felhasználónak nincs jogosultsága WMI query-t futtatni a távoli gépeken. Amikor kézzel futtatod, a saját usered nevében fut (és gondolom Active Directory van), addig ez nem tűnhet fel.
- A hozzászóláshoz be kell jelentkezni