'v4.7***************************************************
' File:   pc-ein-test.vbs
' Autor:  dieseyer@gmx.de 
'         dieseyer.de 
'
' Das Script prüft alle 60s per PING, ob ein PC einge-
' schaltet ist. Der Test beendet sich selbst, wenn die 
' .run - Datei gelöscht wird.
'*******************************************************

Option Explicit

Dim PC, Txt, Text, i, Intervall, LogDatei, VBSrun, NetSend
Dim WSHShell, WSHNet, fso

Dim Prog_PP, FSO_PP, FileOut_PP, VBSDatei_PP  
Set Prog_PP = nothing 


Set WSHNet   = WScript.CreateObject("WScript.Network")
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso      = WScript.CreateObject("Scripting.FileSystemObject")

Intervall = 10
Intervall = 20

PC   = "MeinPC"
PC   = wshnet.ComputerName

PC        = InputBox( "Welcher PC soll auf Anwesenheit überprüft werden?", WScript.ScriptName, PC )
PC        = UCase( PC )

If Len( PC ) < 3 then
  PC        = InputBox( "Welcher PC soll auf Anwesenheit überprüft werden?", WScript.ScriptName, PC )
  PC        = UCase( PC )

  If Len( PC ) < 3 then WScript.Quit

End If

NetSend   = "Bitte rufen Sie 0172/74620xx an und verlangen Sie einen Service-Techniker."

LogDatei  = PC & " " & WScript.ScriptName & ".log"
VBSrun    = PC & " " & WScript.ScriptName & ".run"

  fso.OpenTextFile(LogDatei, 8, true).WriteLine ( now() ) 
  fso.OpenTextFile(VBSrun  , 8, true).WriteLine ( now() ) 

Do 
  Txt = ExecHiddenPlus ( "%comspec% /c Ping " & PC & " -n 1" ) ' PING absetzen

    Txt = Split(Txt, vbCrLf )                                  ' alles von PING gelesene in Zeilen aufteilen 
 
    Text = "" 
    for i = 0 to ubound(Txt)                                   ' jede Zeile überprüfen 
        if InStr(Txt(i), "TTL=") > 1 then Text = Txt(i)
    next 

  fso.OpenTextFile(LogDatei, 8, true).WriteLine ( Text & vbTab & PC & vbTab & now() ) 
                                                               ' LOG schreiben

  If InStr( UCase( Text ), "TTL" ) then                        ' enthält PING-Ausgabe TTL?
         Text = MsgBox( now() & vbCRLF & PC & "   reagiert auf PING mit:" & vbCRLF & vbCRLF & Text, 5+4096, WScript.ScriptName )
      If Text = vbCancel Then Exit Do
  End If

  If not fso.FileExists( VBSrun ) then                         ' wurde .run - Datei gelöscht?
       Text = MsgBox( now() & vbCRLF & PC & vbCRLF & vbCRLF & "Nicht erreichbar - Test abgebrochen.", 5+4096, WScript.ScriptName )
    If Text = vbCancel Then WScript.Quit
       fso.OpenTextFile(VBSrun  , 8, true).WriteLine ( now() ) 
  End If

  If not Text = vbRetry Then WScript.Sleep 1000 * Intervall    ' ..Sekunden warten

  If not fso.FileExists( VBSrun ) then                         ' wurde .run - Datei gelöscht?
       Text = MsgBox( now() & vbCRLF & PC & vbCRLF & vbCRLF & "Nicht erreichbar - Test abgebrochen.", 5+4096, WScript.ScriptName )
    If Text = vbCancel Then WScript.Quit
         fso.OpenTextFile(VBSrun  , 8, true).WriteLine ( now() ) 
  End If

Loop 

NetSend = InputBox( "Eine Nachricht an    " & PC & "    senden?", WScript.ScriptName & vbTab & PC, NetSend )
NetSend = " " & NetSend                                        ' ein Leerzeichen einfügen

If not NetSend = "" Then 

  WSHShell.Run "net send " & PC & NetSend 
  fso.OpenTextFile(LogDatei, 8, true).WriteLine ( "net send " & PC & NetSend & vbTab & now() ) 
                                                               ' LOG schreiben
Else

  wshshell.Popup "net send " & PC & NetSend & vbCRLF & ". . . wurde nicht abgesetzt." , 12, WScript.ScriptName
  fso.OpenTextFile(LogDatei, 8, true).WriteLine ( "KEIN    net send " & PC & NetSend & vbTab & now() ) 

End If

  If fso.FileExists( VBSrun ) Then fso.DeleteFile( VBSrun )
  wshshell.Popup "Ende" , 5, WScript.ScriptName


WScript.Quit 




'**************************************************************  
Function ExecHiddenPlus ( CMD ) ' v3.A - http://dieseyer.de  
'**************************************************************  
 
Dim FileOut, oWsh, Tmp 
 
Tmp = WScript.CreateObject("WScript.Shell").ExpandEnvironmentStrings("%Temp%") & "\" & PC & "-ExecHiddenPlus.VBS" 
 
If not WScript.CreateObject("Scripting.FileSystemObject").FileExists( Tmp ) Then 
 
'   zum Test nächste Zeile frei geben 
' MsgBox Tmp & vbCRLF & "F E H L T" 
 
  Set FileOut  = WScript.CreateObject("Scripting.FileSystemObject").OpenTextFile( Tmp , 8, true)  
 
      FileOut.WriteLine( " set oArgs = Wscript.Arguments " ) 
      FileOut.WriteLine( " For i = 0 to oArgs.Count - 1 " ) 
 
'   zum Test nächste Zeile frei geben 
'     FileOut.WriteLine( " MsgBox oArgs.item(i) , , WScript.ScriptName & "" - oArgs "" " ) 
 
      FileOut.WriteLine( "   if     Instr( oArgs.item(i), "" "" ) > 0 Then  CMD = CMD & """""""" & oArgs.item(i) & """""""" & "" "" " ) 
      FileOut.WriteLine( "   if not Instr( oArgs.item(i), "" "" ) > 0 Then  CMD = CMD        & oArgs.item(i)        & "" "" " ) 
      FileOut.WriteLine( " Next " ) 
 
'   zum Test nächste Zeile frei geben 
'     FileOut.WriteLine( " MsgBox CMD , , WScript.ScriptName & "" Anfang "" " ) 
 
      FileOut.WriteLine( " Set      oExec = WScript.CreateObject(""WScript.Shell"").Exec( CMD ) " ) 
      FileOut.WriteLine( " Do Until oExec.status : WScript.Sleep 100 : Loop " ) 
      FileOut.WriteLine( " WScript.CreateObject(""WScript.Shell"").Environment( ""volatile"" )( ""Eregbnis"" ) = oExec.StdOut.ReadAll() " ) 
 
'   zum Test nächste Zeile frei geben 
'     FileOut.WriteLine( " MsgBox WScript.CreateObject(""WScript.Shell"").Environment( ""volatile"" )( ""Eregbnis"" ), , WScript.ScriptName & "" Ende "" " ) 
 
      FileOut.Close 
  Set FileOuT  = nothing 
 
End If 
 
               Set oWsh = WScript.CreateObject("WScript.Shell") 
                   oWsh.Run "CScript.exe //NOLOGO " & Tmp & " " & CMD , 0, true 
  ExecHiddenPlus = oWsh.Environment("volatile")( "Eregbnis" )  
 
 
'   zum Test nächste Zeile frei geben - Löschen der 'Tmp-Datei  
   WScript.CreateObject("Scripting.FileSystemObject").DeleteFile( Tmp )  
 
End Function ' ExecHiddenPlus ( CMD ) ' v3.A - http://dieseyer.de  
'**************************************************************