Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Ping Test
| Uploader: |  Siedlerchr |
| Datum/Zeit: | 26.01.2008 19:25:18 |
'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
Const Lf = CHR(10)
Const RouterIP = "192.168.0.1"
Const PruefIntervall = 8 '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
'shell "CD /D D:\Programme2\OFFSystem " 'arbeitsverzeichnis dorthin legen, bringt leider nix
Shell "START D:\Programme2\OFFSystem\offsystem.exe" 'Program starten: funktioniert,
'wird allerdings in dem Ordner gestartet, in dem ich den Code hier liegen hab
Exit do 'schleife beenden
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
'TODO:
'Prog rekursiv aufrufen
'Arbeitsverzeichnis ändern