IsHostAlive mit XE2 - Unklare Fehler / Warnungen

[Piro]

Moin zusammen,

ich verwende aus der CodeLibrary die IsHostAlive Unit, welche ich sehr gerne benutze. Ich musste aber die Umwandlung der Strings in PAnsiString anpassen und verwende dafür eine Funktion. Habe ich im Netz gefunden. Vielleicht geht es ja einfacher.

Delphi-Quellcode:

unit uHostAlive; 

...

function StringToPAnsiChar(stringVar : string) : PAnsiChar;
Var
  AnsString : AnsiString;
  InternalError : Boolean;
begin
  InternalError := false;
  Result := '';
  try
    if stringVar <> '' Then
    begin
       AnsString := AnsiString(StringVar);
       Result := PAnsiChar(PAnsiString(AnsString));
    end;
  Except
    InternalError := true;
  end;
end;

function IsHostAlive(Hostname: String; pTripTime: PCardinal = nil; Timeout: Integer = 5000; TTL: Integer = 255): Boolean;
const 
  SendBuffer: array[0..31] of char = 
              ('p', 'i', 'n', 'g', 'p', 'o', 'n', 'g', 
               'p', 'i', 'n', 'g', 'p', 'o', 'n', 'g', 
               'p', 'i', 'n', 'g', 'p', 'o', 'n', 'g', 
               'p', 'i', 'n', 'g', 'p', 'o', 'n', 'g'); 
var 
  WSA: TWSADATA; 
  Reply: PICMP_ECHO_REPLY; 
  Addr: Integer; 
  hIcmp: cardinal; 
  Options: IP_OPTION_INFORMATION; 

  function ResolveHost(Hostname: String): Integer; 
  type 
    PPInAddr= ^PInAddr; 
  var 
    HostInfo: PHostEnt;
    T: PPInAddr; 
  begin 
    t:= nil; 
    Result:= inet_addr(PAnsiChar(Hostname)); // mit XE2 ging PChar nicht mehr aber PAnsiChar
    if result = INADDR_NONE then begin                        
       HostInfo:= gethostbyname(StringToPAnsiChar(Hostname)); // mit XE2 ging PChar und PAnsiChar nicht mehr, deshalb die Funktion
       if HostInfo <> nil then 
          T:= Pointer(HostInfo^.h_addr_list);
       if (T <> nil) and (T^<> nil) then begin 
          Result:= T^^.S_addr; 
       end;
    end; 
  end; 

begin 
  Result:= False; 
  FillChar(Options, sizeof(IP_OPTION_INFORMATION), #0); 
  Reply:= nil; 
  options.TTL:= TTL; 
  options.TOS:= 1; 
  if WSAStartUp(((0 shl 8)+2), WSA) = 0 then begin 
     Addr:= ResolveHost(Hostname); 
     if Addr <> INADDR_NONE then begin
        hIcmp:= IcmpCreateFile(); 
        if hicmp <> INVALID_HANDLE_VALUE then try 
           Reply:= AllocMem(sizeof(ICMP_ECHO_REPLY)+sizeof(SendBuffer)); 
           IcmpSendEcho(hIcmp, Addr, @SendBuffer[0], sizeof(SendBuffer), @Options, Reply, sizeof(ICMP_ECHO_REPLY)+sizeof(SendBuffer), timeout); 
           Result:= (Reply^.Status = 0); 
           if Result and (pTripTime <> nil) then 
              pTripTime^:= Reply^.RoundTripTime; 
        finally 
           IcmpCloseHandle(hIcmp); 
           if Reply <> nil then 
              FreeMem(Reply); 
           WSACleanup(); 
        end; 
     end else begin 
        WSACleanup(); 
       // Hostname konnte nicht aufgelöst werden. 
     end; 
  end else begin 
       // Winsock konnte nicht gestartet werden. 
  end; 
end; 

end.

Leider macht mir die Unit seit der Umstellung auf XE2 Pro Ärger und meine Computer und Server sind nie erreichbar.

Die Vergleiche sind immer gleich (True oder False) laut Compilier.

Delphi-Quellcode:

if result = INADDR_NONE then begin // [DCC Warnung] uHostAlive.pas(79): W1021 Der Vergleich ergibt immer False
                                   // [DCC Warnung] uHostAlive.pas(79): W1023 Vorzeichenbehaftete und -lose Typen werden verglichen - beide Operanden werden erweitert

...

Addr:= ResolveHost(Hostname); 
if Addr <> INADDR_NONE then begin // [DCC Warnung] uHostAlive.pas(97): W1022 Der Vergleich ergibt immer True
                                  // [DCC Warnung] uHostAlive.pas(97): W1023 Vorzeichenbehaftete und -lose Typen werden verglichen - beide Operanden werden erweitert

Wie gesagt, die Probleme hatte ich mit meiner früheren Version TurboDelphi Pro nicht. Ich könnte die Warnungen ja ignorieren aber die Computer / Server sind laut Rückgabewert nie erreichbar und das stimmt nicht.
Ich hoffe, einer von euch geht die Probleme und einen Lösungsansatz. Würde ungern auf diese Unit verzichten.

Gruß Sven

[himitsu]

Wie ist INADDR_NONE deklariert?

Zitat:

Delphi-Quellcode:

function StringToPAnsiChar(stringVar : string) : PAnsiChar;
Var
  AnsString : AnsiString;
  InternalError : Boolean;
begin
  InternalError := false;
  Result := '';
  try
    if stringVar <> '' Then
    begin
       AnsString := AnsiString(StringVar);
       Result := PAnsiChar(PAnsiString(AnsString));
    end;
  Except
    InternalError := true;
  end;
end;

Was soll das InternalError darstellen?
Die Variable wird ja nie verwendet/ausgelesen.

Solange niemand bei stringVar das Speichernmanagement zerschießt, wird es dort auch niemals eine Exception geben.
OK, bei einem EOutOfMemory, aber so oder so ... dann ist eh alles zu spät.

Ein Zeiger auf den Speicher der lokalen Variable?
Diese Variable wird bei Prozedurende freigegeben und demnach enthält dann auch das Result einen ungültigen Zeiger.

Den AnsiString einfach so in einen PAnsiString zu casten ist garantiert auch total falsch.
Aber ermutlich wolltest du das Result := PAnsiChar(Pointer(AnsString)); erreichen, also daß Delphi keine automatischen Konvertierungen bei AnsiString/PAnsiChar einbaut.


Entweder du machst Hostname direkt zu einem AnsiString (dessen Typ ändern),
oder halt nur temporär, aber dann so, daß die TempVariable lange genug überlebt.

Delphi-Quellcode:

gethostbyname(PAnsiChar(AnsiString(Hostname)));

// wird intern zu
AutomatischGenierierteAnsiStringVariable := AnsiString(Hostname);
gethostbyname(PAnsiChar(AutomatischGenierierteAnsiStringVariable));

Zitat von Piro:

Leider macht mir die Unit seit der Umstellung auf XE2 Pro Ärger und meine Computer und Server sind nie erreichbar.

Das Ganze war vorher noch ANSI? (vor D2009)

Zitat:

Delphi-Quellcode:

const
  SendBuffer: array[0..31] of char = 'pingpongpingpongpingpongpingpong';  // ja, das geht auch so

Also das CHAR war vorher ein AnsiChar?
Tja, dann stimmt dein Protokoll jetzt nicht mehr, denn jetzt ist es Unicode.

[Piro]

Danke für die schnelle Hilfe.

Die Variable

Zitat:

INADDR_NONE

habe ich nicht gesetzt. Habe den Code 1:1 aus der CodeLibrary.

Hat aber bis dato auch funktioniert. Im Anhang findest du den aktuellen Wert zur Laufzeit. Scheint ein willkürlicher Wert zu sein.
Was muss denn die Variable für einen Wert haben. Dachte immer das die Variable eine Konstante ist.

Übrigens habe ich die Umwandlungsfunktion nur 1:1 kopiert und nicht den Code angepasst.

[himitsu]

Tja, das kommt davon, wenn falsche Typen verwendet werden.

Das hat gefälligst ein Cardinal, DWORD oder Dergleichen zu sein, wie man am inet_addr sehen kann.

Es wurde aber als Integer definiert und ein Integer kann nunmal "logisch" niemals den Wert $FFFFFFFF (4294967295 ) enthalten.
OK, binär wäre es die -1, aber eine Compiler, welcher genau auf die Typen achtet, wird bei diesem Vergleich beide Typen auf Int64 erweitern.
Und da er die Grenzen des Integers kennt, gibt er natürlich die Warnung aus, daß ein Vergleich niemals zutreffen wird, da es den Wert halt nicht geben kann.
Lösung: if DWORD(Addr) <> INADDR_NONE then , oder man berichtigt eben die Typen.


Ich hab auch gleich noch ein paar andere Typen angepasst (THandle statt Cardinal usw.)
Und melde gleich meine Antwort, so daß der CodeLib-Eintrag berichtigt wird.

Quelle: http://www.delphipraxis.net/126574-i...rreichbar.html

PS: Genau aus solchen Gründen, also wegen falschen Typen gibt es die meisten Probleme, vorallem bei solchen Umstellungen wie von ANSI zu Unicode oder von Win32 auf Win64.

Delphi-Quellcode:

unit hostalive;

interface

uses
  Windows, Winsock;  // Winapi.Windows, Winapi.Winsock;

function IsHostAlive(Hostname: String; pTripTime: PCardinal=nil; Timeout: Integer=1000; TTL: Integer=255): Boolean;

implementation

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';

function ResolveHost(Hostname: AnsiString): Cardinal;
var
  HostInfo: PHostEnt;
  T: ^PInAddr;
begin
  Result := inet_addr(PAnsiChar(Hostname));
  if Result = INADDR_NONE then begin
    HostInfo := gethostbyname(PAnsiChar(Hostname));
    if Assigned(HostInfo) then begin
      T := Pointer(HostInfo^.h_addr_list);
      if Assigned(T) and Assigned(T^) then
        Result := T^^.S_addr;
    end;
  end;
end;

function IsHostAlive(Hostname: String; pTripTime: PCardinal; Timeout, TTL: Integer): Boolean;
const
  SendBuffer: array[0..31] of AnsiChar = 'pingpongpingpongpingpongpingpong';
var
  WSA:     TWSADATA;
  Reply:   PICMP_ECHO_REPLY;
  Addr:    Cardinal;
  hIcmp:   THandle;
  Options: IP_OPTION_INFORMATION;
begin
  Result := False;
  FillChar(Options, SizeOf(IP_OPTION_INFORMATION), #0);
  Options.TTL := TTL;
  Options.TOS := 1;
  if WSAStartUp(((0 shl 8) + 2), WSA) = 0 then begin
    Addr := ResolveHost(AnsiString(Hostname));
    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), Timeout);
          Result := Reply^.Status = 0;
          if Result and Assigned(pTripTime) then
            pTripTime^ := Reply^.RoundTripTime;
        finally
          IcmpCloseHandle(hIcmp);
          if Assigned(Reply) then
            FreeMem(Reply);
          WSACleanup;
        end;
      end;
    end else begin
      // Hostname konnte nicht aufgelöst werden.
      WSACleanup;
    end;
  end else begin
    // Winsock konnte nicht gestartet werden.
  end;
end;

end.

Delphi-Quellcode:

var
  RTT: Cardinal;
begin
  if IsHostalive('google.de', @RTT) then
    ShowMessage(IntToStr(RTT) + 'ms');
end;

[Piro]

!!! VIELEN DANK !!!

Das hat geklappt, jetzt ist wieder alles erreichbar. Dieses Forum und seine Mitglieder sind der Hammer und haben mir schon mehr als einmal aus der Klemme geholfen.

Schönen Abend noch.

@himitsu : 1000 Danke nochmal

[PeterPanino]

@ himitsu

IsHostalive('google.com', @RTT) gibt immer True zurück.

IsHostalive('microsoft.com', @RTT) gibt immer False zurück.

WARUM?

Delphi XE7

EDIT:

Wenn ich aber die IP-Adresse von microsoft.com (95.100.79.156) verwende, wird True zurückgegeben:

IsHostalive('95.100.79.156', @RTT) gibt immer True zurück.

Wieso funktioniert es also mit microsoft.com nicht?

[Dalai]

Zitat von PeterPanino:

IsHostalive('google.com', @RTT) gibt immer True zurück.

IsHostalive('microsoft.com', @RTT) gibt immer False zurück.

WARUM?

Weil Google auf ICMP-Requests antwortet, Microsoft aber nicht. Letzteres ist übrigens typisch für die, denn standardmäßig antwortet kein Windows seit XP SP2 mehr auf ICMP-Requests, weil das in der Firewall (schwachsinnigerweise) abgeschaltet ist.

Zitat:

Wenn ich aber die IP-Adresse von microsoft.com (95.100.79.156) verwende, wird True zurückgegeben:

IsHostalive('95.100.79.156', @RTT) gibt immer True zurück.

Wieso funktioniert es also mit microsoft.com nicht?

Schau dir mal mit nslookup oder Webseiten wie IP2Geolocation an, auf welchen Namen die IP-Adressen auflösen, dann siehst du, dass hinter dieser IP Akamai steckt, nicht Microsoft (IP2Geolocation).

MfG Dalai

[PeterPanino]

Zitat von Dalai:

... standardmäßig antwortet kein Windows seit XP SP2 mehr auf ICMP-Requests, weil das in der Firewall (schwachsinnigerweise) abgeschaltet ist.

Schutz gegen Port-Scans?

Kann ich aber sonst davon ausgehen, dass IsHostalive mit allen anderen "normalen" Domain-Namen IM INTERNET funktioniert?

[PeterPanino]

Übrigens: Wenn ich IsHostalive mit einem leeren string aufrufe, gibt es immer True mit 0 ms zurück!

IsHostalive('', @RTT)

WARUM?

[mjustin]

Zitat von PeterPanino:

Übrigens: Wenn ich IsHostalive mit einem leeren string aufrufe, gibt es immer True mit 0 ms zurück!

IsHostalive('', @RTT)

WARUM?

Weil die intern verwendete Funktion gethostbyname dann localhost verwendet.

Zitat:

If the name parameter points to an empty string or name is NULL, the returned string is the same as the string returned by a successful gethostname function call (the standard host name for the local computer).