'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   

'**************************************************************