fb:porticula NoPaste
Ping Checker fürs Netzwerk
Uploader: | Siedlerchr |
Datum/Zeit: | 27.01.2008 14:04:22 |
'Ein funktionierendes Beispiel für die Verwendung von Open Pipe()
'¸2007 by ytwinky, MD
'Bei Bedarf nach Belieben änderbar :D
'Verändert durch Sebastian St. (26.01.2008)
'Siehe http://forum.qbasic.at/viewtopic.php?t=5281
'Letzte Modifikationen von Siedlerchr (alias Christoph) (27.01.2008)
'Wenn der Router nicht erreichbar ist wird das Programm "OFF (Owner Free Filesystem) " beendet und anschließend neu gestartet
'Es wird jetzt alle 10 Sekunden geprüft, ob eine Verbindung besteht
Const Lf = Chr(10)
Const RouterIP = "192.168.2.1"
Const PruefIntervall = 10 'Sekunden
Declare Function Exists(DateiName As String) As Integer
Dim As String Path2Exe=Environ("windir") &"\System32"
Dim As String ExeDatei="\Ping.Exe"
Dim As String Parameter=" -n 1 -l 1 "+RouterIP
Dim As String Befehlszeile, Zeile, Ausgabe
Dim As Integer DNr=Freefile
Befehlszeile=Path2Exe &ExeDatei &Parameter
If Not Exists(Path2Exe &ExeDatei) Then
Print Path2Exe &ExeDatei &" nicht gefunden oder nicht richtig installiert ;-))"
Sleep
End
End If
Print "ESC zum Beenden druecken."
Do
Ausgabe=""
Open Pipe Befehlszeile For Input As #DNr 'DNr an Konsolenausgabe zuweisen
While Not Eof(DNr) 'lesen der Konsoleausgabe anfangen..
Line Input #DNr, Zeile 'es könnten Kommata in Zeile sein, also ignorieren
If Zeile<>"" Then Ausgabe+=Zeile &Lf 'Leerzeilen auslassen..
Wend 'Ende der Konsolenausgabe prüfen..
Close #DNr 'Beenden der Konsolenausgabe
If (Instr(Lcase(Ausgabe),"antwort von") < 1) Then '"Zeitüberschreitung" gefunden... ^^
Locate 1,1: Print "Keine Verbindung! "
Shell "TASKKILL /F /IM offsystem.exe" 'Prozess beenden
Sleep 10000 'warten bis der prozess erfolgreich beendet ist
Chdir("D:\Programme2\OFFSystem") 'ins Verzeichnis wechseln
Shell "START offsystem.exe" 'Programm starten
Continue Do 'wieder von vorne starten
Sleep: End
Else
Locate 1,1: Print Date+" "+Time+" Verbindung steht."
End If
Sleep PruefIntervall*1000
Loop Until Inkey = Chr(27)
End
Function Exists(FileName As String) As Integer 'Oh, wie ich diese Funktion liebe :D
Dim As Integer FileNumber=Freefile, Missing=Open(FileName For Input As FileNumber) 'Variablen initialisieren..
If Not Missing Then Close FileNumber 'programmieren wie man denkt..
Return Missing=0 'TRUE, wenn es die Datei gibt..
End Function