Einzelnen Beitrag anzeigen

RainerO

Registriert seit: 25. Sep 2006
Ort: Duisburg
17 Beiträge
 
Delphi 2007 Professional
 
#15

Re: Pingen funktioniert nicht

  Alt 26. Apr 2007, 12:23
Ich hatte das gleiche Problem - Ping mit cmd geht, aus dem Programm heraus kommt immer 0.
Um nicht allzulange zu suchen, hab ich die Unit "DosCommand" genommen (von maxime collomb, hab ich glaub ich hier oder beim Delphi-Forum gefunden, an dieser Stelle ein herzliches Danke schön!!) und mit dieser Funktion

Delphi-Quellcode:
... uses DosCommand;
... Var dosCommandReady : Boolean;

procedure Tkdtinst.onterminatedDosCommand(Sender : TObject);
begin
  dosCommandReady := True;
end;

function _IsConnectedToInternet: Boolean;
var
 output : TStringList;
 DosCommand : TDosCommand;
begin
  RESULT:=FALSE;
  TRY
    OutPut:=TStringlist.Create;
    DosCommand := TDosCommand.Create(NIL);
    DosCommand.MaxTimeAfterBeginning:=30; // max. 30 Sek. versuchen
    DosCommand.OutputLines:=output;
    DosCommand.InputToOutput:=TRUE;
    DosCommand.CommandLine:='ping www.3d-raumplan.com';
    DosCommand.OnTerminated:=kdtinst.onterminatedDosCommand; // Setzt nur die Globale Var dosCommandReady auf true
    DosCommand.Execute;
    While NOT dosCommandready do
      Application.ProcessMessages;
    DosCommand.Free;
    TRY // wenn der ping schiefgeht, hat OutPut keine 18 Zeilen
       if POS('(100%',OutPut[18])=0 then // so hoffe ich, das es auch auf nicht deutschen Windows-Systemen richtig ist
         Result:=TRUE;
    Except
     Result:=FALSE;
    end; // Try ping

  except
    Result:=FALSE;
  end; // Try DosCommand
    if not result then
     if MessageDlg(output.text+#13#10+'Es scheint keine Internetverbindung zu bestehen. Trotzdem weiter ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        Result := TRUE
      else
        Result := FALSE;
end;
abgefragt. Wenn die Antwortzeiten wichtig sind, können diese aus OutPut geparst werden.

Ich hoffe, das hilft
Rainer Osselmann
  Mit Zitat antworten Zitat