PING als If-Abfrage

[scrat1979]

Hallo zusammen,

mir ist bekannt, dass dieses Thema schon zigmal durchgekaut wurde. Trotzdem hilft mir die SuFu leider nicht weiter. Ich sollte in meinem Programm einen PING durchführen und - falls erfolgreich - eine Codepassage durchführen. Also quasi (Pseudocode)

Delphi-Quellcode:

if Ping_Erfolgreich('xxx.xxx.xxx.xxx') then begin
[...}
end;

alle Lösungen der SuFu (sofern ich nichts übersehen habe) arbeiten mit verschiedenen Komponenten, wobei das Resultat in einem Onblablabla-Event ausgegeben wird. Das verhindert das Verwenden in einer If-Abfrage. Die einzige Lösung war unter Ping-Unit zu finden, allerdings bekomme ich die Unit wegen inkompatiblen Typen bei der Umwandlung (PChar) nicht zum laufen.

Vielleicht kennt jemand eine funktionierende Lösung für ein Ping in einer if-Abfrage oder kann mir sagen, wie ich in meinem Kontext eine Komponente korrekt einsetzen kann.

Grüße...

[RWarnecke]

Wieso nutzt Du nicht das Event und fragst da den Status mit IF ab ? Ist der Ping erfolgreich, führe Deinen Code aus, ist der Ping nicht Erfolgreich gib eine Meldung aus zum Beispiel.

[nahpets]

Zitat von RWarnecke:

Wieso nutzt Du nicht das Event und fragst da den Status mit IF ab ? Ist der Ping erfolgreich, führe Deinen Code aus, ist der Ping nicht Erfolgreich gib eine Meldung aus zum Beispiel.

Das wird bei 'nem Programmablauf in der Form aber nicht funktionieren:

Delphi-Quellcode:

procedure irgendwie;
begin
  if a = b then begin
    irgendwas;
  end else begin
    if Ping_Erfolgreich('xxx.xxx.xxx.xxx') then begin
      MachWennPingErfolgreich; 
    end else begin
      MachWennPingNichtErfolgreich;
    end;
  end;
end;

Nur mal so als Idee:

Ping_Erfolgreich sei also eine Funktion, dann könnte man dadrin eventuell sowas machen:

Delphi-Quellcode:

var
    fPingOk;

function Ping_Erfolgreich(aAddress : String) : Boolean;
var
         i : Integer;
         iSleep : Integer;
begin
  fPingOk := False;
  i := 0;
  iSleep := 100;
  Ping.Address := aAddress;
  Ping.Ping;
  repeat
    i := i + iSleep;
    Sleep(iSleep);
    Application.ProcessMessages; // oder sonstwasfürnenschleifeninhalt
  until fPingOk or (i > Ping.TimeOut);
  Result := fPingOk; 
end;

In dem Ereignis der Pingkomponente, in dem man feststellen kann, ob das Ping erfolgreich war, wird bei Erfolg fPingOk auf True gesetzt.

Ist zwar unelegant und Objektorientierung sieht anders aus, aber es mag erstmal gehen.
Ansonsten halt eine Ableitung der Pingkomponente schreiben, die beim Ping eben wartet und in 'nem Attribut über Erfolg oder Misserfolg informiert.

Sprich: Meine obige "Krücke" in 'ner Komponente kapseln.

[jaevencooler]

Moin, Moin,


ich habe das mal so gelöst :

Delphi-Quellcode:

unit PrjClassTCPHelper;

interface

uses
  Windows,
  WinSock,
  SysUtils,
  Classes;


function IsHostAlive( AHostname         : String;
                      var AErrorMessage : string;
                      ApTripTime        : PCardinal = nil;
                      ATimeout          : Integer   = 1000;
                      ATTL              : Integer   = 255
                    ): Boolean;

type

  IP_OPTION_INFORMATION = packed record
    TTL         : Byte;
    TOS         : Byte;
    Flags       : Byte;
    OptionsSize : Byte;
    OptionsData : PAnsiChar;
  end;
  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;

  ICMP_ECHO_REPLY = packed record
    Address       : in_addr;
    Status        : Cardinal;
    RoundTripTime : Cardinal;
    DataSize      : Word;
    Reserved      : Word;
    Data          : Pointer;
    Options       : IP_OPTION_INFORMATION;
  end;
  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;


function IcmpCreateFile: THandle;                       stdcall; external 'Iphlpapi.dll';
function IcmpCloseHandle(IcmpHandle: THandle): Boolean; stdcall; external 'Iphlpapi.dll';
function IcmpSendEcho( IcmpHandle         : THandle;
                       DestinationAddress : Cardinal;
                       RequestData        : Pointer;
                       RequestSize        : Word;
                       RequestOptions     : PIP_OPTION_INFORMATION;
                       ReplyBuffer        : Pointer;
                       ReplySize          : Cardinal;
                       Timeout            : Cardinal
                     ): Cardinal; stdcall; external 'Iphlpapi.dll';



implementation



//------------------------------------------------------------------------------
//- PrjClassTCPHelper.StringToPAnsiChar
//1  wandelt einen string in eine PAnsiChar
//- Params: stringVar : string
//- Result: PAnsiChar
function StringToPAnsiChar(stringVar : string) : PAnsiChar;
var  LAnsString     : AnsiString;
var  LInternalError : Boolean;
begin
  LInternalError := false;
  Result := '';
  try
    if stringVar <> '' Then
    begin
       LAnsString := AnsiString(StringVar);
       Result     := PAnsiChar(PAnsiString(LAnsString));
    end;
  Except
    LInternalError := true;
  end;
end;

//------------------------------------------------------------------------------
//- PrjClassTCPHelper.ResolveHost
//1 löst den Hostname auf und gibt die IP Adresse zurück
//- Params: stringVar : string
//- Result: cardinal
function ResolveHost(AHostname : AnsiString): Cardinal;
var lHostInfo : PHostEnt;
var lIpAdress : ^PInAddr;
begin
  Result := inet_addr(PAnsiChar(AHostname));
  // ist AHostname schon eine IP Adresse dann ist result <> INADDR_NONE
  if Result = INADDR_NONE then begin
    // AHostname auflösen und IP ermitteln
    LHostInfo := gethostbyname(PAnsiChar(AHostname));
    if Assigned(LHostInfo) then
    begin
      lIpAdress := Pointer(lHostInfo^.h_addr_list);
      if Assigned(lIpAdress) and Assigned(lIpAdress^) then
      begin
        Result := lIpAdress^^.S_addr;
      end;
    end;
  end;
end;

//------------------------------------------------------------------------------
//- PrjClassTCPHelper.IsHostAlive
//1 senedet ein Ping an den Peer und wartet auf eine Antwort, gibt true zurück wenn eine Antwort kommt
//- Params: AHostname  : String;var AErrorMessage : string; ATimeout, ATTL : Integer
//- Result: boolean
function IsHostAlive( AHostname         : String;
                      var AErrorMessage : string;
                      ApTripTime        : PCardinal;
                      ATimeout,
                      ATTL              : Integer
                    ): Boolean;

const SendBuffer : array[0..31] of AnsiChar = 'pingpongpingpongpingpongpingpong';
var WSA          : TWSADATA;
var Reply        : PICMP_ECHO_REPLY;
var Addr         : Cardinal;
var hIcmp        : THandle;
var Options      : IP_OPTION_INFORMATION;
begin
  Result := False;
  FillChar(Options, SizeOf(IP_OPTION_INFORMATION), #0);
  Options.TTL := ATTL;
  Options.TOS := 1;
  if WSAStartUp(((0 shl 8) + 2), WSA) = 0 then
  begin
    Addr := ResolveHost(AnsiString(AHostname));
    if Addr <> INADDR_NONE then
    begin
      hIcmp := IcmpCreateFile;
      if hicmp <> INVALID_HANDLE_VALUE then
      begin
        Reply := nil;
        try
          Reply := AllocMem(SizeOf(ICMP_ECHO_REPLY) + SizeOf(SendBuffer));
          IcmpSendEcho(hIcmp, Addr, @SendBuffer[0], SizeOf(SendBuffer), @Options, Reply, SizeOf(ICMP_ECHO_REPLY) + SizeOf(SendBuffer), ATimeout);
          Result := (Reply^.Status = 0);
          if Result and Assigned(ApTripTime) then
          begin
            ApTripTime^ := Reply^.RoundTripTime;
          end;
        finally
          IcmpCloseHandle(hIcmp);
          if Assigned(Reply) then
          begin
            FreeMem(Reply);
          end;
          WSACleanup;
        end;
      end else
      begin
        AErrorMessage := 'IcmpCreateFile not successfull';
      end;
    end else begin
      // Hostname konnte nicht aufgelöst werden.
      AErrorMessage := 'hostname could not be resolved';
      WSACleanup;
    end;
  end else
  begin
    // Winsock konnte nicht gestartet werden.
    AErrorMessage := 'winsock could not be started';
  end;
end;

end.

hilft ja eventuel weiter

Bei einem Einsatz einer Firewall muss das Port ICMP dafür frei gegeben sein !!!


Cu Michael

[t.roller]

Einfachere Lösung:

Delphi-Quellcode:

//function gethostbyname(name: PAnsiChar): PHostEnt; stdcall ;
//    external 'wsock32.dll' name 'gethostbyname';
// oder uses ...Winapi.Winsock,...
function GHBN(const str: Ansistring): Boolean; // GetHostByName
var PHE : PHostEnt;
begin
PHE:= NIL; Result:= FALSE;
PHE := GetHostByName(PAnsiChar(str)); Application.ProcessMessages;
if PHE<>NIL then Result:= TRUE;
end;
---
//Aufruf:
If GHBN('www.google.com') then...

[scrat1979]

Wow! Danke für Eure schnellen Antworten. Ich werde sie mir heute Abend mal anschauen.

Beste Grüße!