Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#4

AW: IsHostAlive mit XE2 - Unklare Fehler / Warnungen

  Alt 12. Mär 2014, 19:58
Tja, das kommt davon, wenn falsche Typen verwendet werden.

Das hat gefälligst ein Cardinal, DWORD oder Dergleichen zu sein, wie man am MSDN-Library durchsucheninet_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;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (12. Mär 2014 um 21:18 Uhr)
  Mit Zitat antworten Zitat