AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Sonstige Fragen zu Delphi Delphi IdICMPClient unter Vista: Fehler bei Bereichsprüfung
Thema durchsuchen
Ansicht
Themen-Optionen

IdICMPClient unter Vista: Fehler bei Bereichsprüfung

Offene Frage von "stoxx"
Ein Thema von seim · begonnen am 5. Jan 2009 · letzter Beitrag vom 18. Jul 2013
Antwort Antwort
Benutzerbild von seim
seim

Registriert seit: 11. Nov 2007
83 Beiträge
 
#1

Re: IdICMPClient unter Vista: Fehler bei Bereichsprüfung

  Alt 5. Jan 2009, 18:11
Ok ich hab' den Weg über die ICMP.dll genommen..

Aufruf:
Delphi-Quellcode:
procedure TForm1.BtnClick(lala)
begin
if Ping('127.0.0.1') then
ShowMessage('Dein PC ist an')
else
ShowMessage('Dein PC scheint aus zu sein');
end;

Types und Vars:
Delphi-Quellcode:
type
  //ICMP.dll Datentypen
  TSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TSunW = packed record
    s_w1, s_w2: word;
  end;

  PIPAddr = ^TIPAddr;

  TIPAddr = record
    case integer of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  end;

  IPAddr = TIPAddr; //Eine der Funktionen in icmp.dll braucht den Datentyp "IPAddr"

  ip_option_information = record
    Ttl : byte;
    Tos : byte;
    Flags : byte;
    OptionsSize : byte;
    OptionsData : pointer;
  end;

  ICMP_ECHO_REPLY = record
    Address : IPAddr;
    Status : ULONG;
    RoundTripTime : ULONG;
    DataSize : Word;
    Reserved : Word;
    Data : Pointer;
    Options : IP_OPTION_INFORMATION;
  end;

//ICMP.dll Declarations
function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll';
function IcmpSendEcho (IcmpHandle : THandle; DestinationAddress : IPAddr;
    RequestData : Pointer; RequestSize : Smallint;
    RequestOptions : pointer;
    ReplyBuffer : Pointer;
    ReplySize : DWORD;
    Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';
Funktionen:
Delphi-Quellcode:
function Fetch(var AInput: string; const ADelim: string = ' '; const ADelete: Boolean = true): string;
var
  iPos: Integer;
begin
  if ADelim = #0 then begin
    // AnsiPos does not work with #0
    iPos := Pos(ADelim, AInput);
  end else begin
    iPos := Pos(ADelim, AInput);
  end;
  if iPos = 0 then begin
    Result := AInput;
    if ADelete then begin
      AInput := '';
    end;
  end else begin
    result := Copy(AInput, 1, iPos - 1);
    if ADelete then begin
      Delete(AInput, 1, iPos + Length(ADelim) - 1);
    end;
  end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
  phe: PHostEnt;
  pac: PChar;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  try
    phe := GetHostByName(PChar(AIP));
    if Assigned(phe) then
    begin
      pac := phe^.h_addr_list^;
      if Assigned(pac) then
      begin
        with TIPAddr(AInAddr).S_un_b do begin
          s_b1 := Byte(pac[0]);
          s_b2 := Byte(pac[1]);
          s_b3 := Byte(pac[2]);
          s_b4 := Byte(pac[3]);
        end;
      end
      else
      begin
        raise Exception.Create('Error getting IP from HostName');
      end;
    end
    else
    begin
      raise Exception.Create('Error getting HostName');
    end;
  except
    FillChar(AInAddr, SizeOf(AInAddr), #0);
  end;
  WSACleanup;
end;

function Ping(InetAddress : string) : boolean;
var
 Handle : THandle;
 InAddr : IPAddr;
 DW : DWORD;
 PingBuf: array[0..31] of char;
 Reply : ICMP_ECHO_REPLY;
begin
  result := false;

  Handle := IcmpCreateFile;

  if Handle = INVALID_HANDLE_VALUE then
   Exit;

  TranslateStringToTInAddr(InetAddress, InAddr);

  Reply.Data := @pingBuf;
  Reply.DataSize := 32;

  DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 1000); //Die 1000 gibt den TimeOut an

  if DW <> 0 then
    Result:= true;

  IcmpCloseHandle(Handle);
end;
  Mit Zitat antworten Zitat
Benutzerbild von stoxx
stoxx

Registriert seit: 13. Aug 2003
1.111 Beiträge
 
#2

AW: Re: IdICMPClient unter Vista: Fehler bei Bereichsprüfung

  Alt 18. Jul 2013, 17:45
Ok ich hab' den Weg über die ICMP.dll genommen..


Funktionen:
Delphi-Quellcode:
  ....
  TranslateStringToTInAddr(InetAddress, InAddr);

  Reply.Data := @pingBuf;
  Reply.DataSize := 32;

  DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 1000); //Die 1000 gibt den TimeOut an

  if DW <> 0 then
    Result:= true;

  IcmpCloseHandle(Handle);
end;


Hi .. die Unit ist schick, hat aber leider einen kleinen Fehler.
Trotz abgezogenem Netzwerkkabel liefert die Funktion (manchmal) ein True zurück.
Nach stöbern im msdn hat sich herausgestellt, dass man den Rückgabewert nicht so behandeln darf.

so ist es korrekt:

Delphi-Quellcode:


const

  IP_SUCCESS = 0;
  IP_BUF_TOO_SMALL = 11001;
  IP_DEST_NET_UNREACHABLE = 11002;
  IP_DEST_HOST_UNREACHABLE = 11003;
  IP_DEST_PROT_UNREACHABLE = 11004;
  IP_DEST_PORT_UNREACHABLE = 11005;
  IP_NO_RESOURCES = 11006;
  IP_BAD_OPTION = 11007;
  IP_HW_ERROR = 11008;
  IP_PACKET_TOO_BIG = 11009;
  IP_REQ_TIMED_OUT = 11010;
  IP_BAD_REQ = 11011;
  IP_BAD_ROUTE = 11012;
  IP_TTL_EXPIRED_TRANSIT = 11013;
  IP_TTL_EXPIRED_REASSEM = 11014;
  IP_PARAM_PROBLEM = 11015;
  IP_SOURCE_QUENCH = 11016;
  IP_OPTION_TOO_BIG = 11017;
  IP_BAD_DESTINATION = 11018;
  IP_GENERAL_FAILURE = 11050;




  ....

function Ping(InetAddress : string; var ErrorMessage : String) : boolean;
var
 Handle : THandle;
 InAddr : IPAddr;
 DW : DWORD;
 PingBuf: array[0..31] of char;
 Reply : ICMP_ECHO_REPLY;
begin
  result := false;
  ErrorMessage := '';
  try
      DW := 0;
      Handle := IcmpCreateFile;
      if Handle = INVALID_HANDLE_VALUE then
       Exit;
      try
        TranslateStringToTInAddr(InetAddress, InAddr);
      except
        on E: Exception do begin
          ErrorMessage := e.Message;
          Exit;
        end;
      end;
      Reply.Status := IP_SUCCESS;
      Reply.Data := @pingBuf;
      Reply.DataSize := 32;
      DW := IcmpSendEcho(Handle, InAddr, @PingBuf, 32, nil, @reply, SizeOf(icmp_echo_reply) + 32 , 1500); //Die 1000 gibt den TimeOut an

      // if (Reply.Status <> IP_GENERAL_FAILURE) and (Reply.Status <> IP_SUCCESS) then
      // ErrorMessage := Get_ICMP_ECHO_REPLY_StateString(reply.Status);
         
      
      if DW <> 0 then begin

          if Reply.Status = IP_SUCCESS then begin
               Result := True;
               ErrorMessage := '';
          end;
      end;
  except
  end;
  IcmpCloseHandle(Handle);
end; // Ping
Phantasie ist etwas, was sich manche Leute gar nicht vorstellen können.
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:57 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz