szerver diskspace script probléma.

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.

Hozzászólások

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>

Hogy néz ki a Scheduled task, amivel indítod, továbbá milyen visszatérési értéke van a script-nek?

A tehén egy bonyolult állat, de én megfejtem.

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

Nem lenne egyszerűbb erre kész szoftvert használni, pl zabbix?

Sikerült megtalálni a problémát a

bytesToMB résznél volt gond.

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.