IP's anpingen

[Neutral General]

Ich hab zwar schon was in der DP-Suche gefunden aber das funktioniert irgendwie nicht so richtig... :(
Meistens weil Delphi irgendwelche Konstanten nicht kennt.
Kann mir jemand nochmal ungefähr sagen wie das mit Indy (IdEcho) geht :gruebel:

[Sharky]

Zitat:

Zitat von Neutral General

...wie das mit Indy (IdEcho) geht :gruebel:

Mit dem Echo-Protokoll pingen? Das geht wohl nicht.
Verwende für einen Pint IdIcmpClient und dann die Methode .Ping

[Neutral General]

Ja das hatte ich auch schonmal probiert aber immer wenn ich den Host wechseln will gibts ne Exception :(

[Neutral General]

Ok ich habs irgendwie doch geschafft :

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var i : Integer;
begin
for i:= 1 to 200 do begin
  Ping.Host := '192.168.2.' + IntToStr(i);
  Ping.Ping();
end;
end;

Delphi-Quellcode:

procedure TForm1.PingReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
  if (AReplyStatus.MsRoundTripTime < 50) and (AReplyStatus.FromIpAddress <> '0.0.0.0') then
  ListBox1.Items.Add(AReplyStatus.FromIpAddress);
end;

:)

Danke Sharky wegen dem Tipp :thumb:

[CReber]

Die functions hab ich mir mal irgendwann zu einer Unit zusammengesucht:

Delphi-Quellcode:

unit NetworkFunctions;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinInet, WinSock;

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

type 
  IPAddr = DWORD; 

  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY; 
  ICMP_ECHO_REPLY = packed record 
    Address       : ULONG; 
    Status        : ULONG; 
    RoundTripTime : ULONG;
    DataSize      : WORD; 
    Reserved      : WORD; 
    Data          : Pointer; 
  end; 

  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION; 
  IP_OPTION_INFORMATION = packed record 
    Ttl         : byte; 
    Tos         : byte; 
    Flags       : byte; 
    OptionsSize : byte; 
    OptionsData : Pointer; 
  end;

procedure GetComputerList(List: TStrings);
function InternetAvailable:Boolean;                                 // Only DFÜ / RAS
function Ping(IP:string; TimeOut:Cardinal) : Boolean;                 // TimeOut ~1000
function GetNetworkName(IPAddr: string): string;
function GetIp(const HostName: string): string;

implementation

function IcmpCreateFile : DWORD; stdcall; external 'icmp.dll';
function IcmpCloseHandle(const IcmpHandle : DWORD) : longbool; stdcall; external 'icmp.dll';
function IcmpSendEcho(const IcmpHandle : DWORD;const DestinationAddress : IPAddr;const RequestData : Pointer;const RequestSize : WORD;const RequestOptions : PIP_OPTION_INFORMATION;const ReplyBuffer : Pointer;const ReplySize : DWORD;const TimeOut : DWORD) : DWORD; stdcall; external 'icmp.dll'

function GetNetworkName(IPAddr: string): string;
  var SockAddrIn: TSockAddrIn;
      HostEnt: PHostEnt;
      WSAData: TWSAData;
begin 
  WSAStartup($101, WSAData); 
  SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr)); 
  HostEnt:= GetHostByAddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); 
  if HostEnt <> nil then 
    Result := StrPas(Hostent^.h_name) 
  else
    Result := '';
end;

function GetIp(const HostName: string): string;
  type
    TaPInAddr = array[0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
  var
    phe: PHostEnt;
    pptr: PaPInAddr;
    i: Integer;
    GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  Result := '';
  phe := GetHostByName(PChar(HostName));
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pPtr^[i] <> nil do begin
    Result := inet_ntoa(pptr^[i]^);
    Inc(i);
  end;
  WSACleanup;

end;

function Ping(IP:string; TimeOut:Cardinal):Boolean;
  var hICMP                           : DWORD;
      pierWork                        : PICMP_ECHO_REPLY;
      dwSize                          : DWORD;
      Class1,Class2,Class3,Class4     : String;
      i,j                             : Byte;
begin
  Result:=False;
  j:=1;
  for i:=1 to Length(IP) do begin
    if IP[i]<>'.' then begin
      case j of
        1: Class1:=Class1+IP[i];
        2: Class2:=Class2+IP[i];
        3: Class3:=Class3+IP[i];
        4: Class4:=Class4+IP[i];
      end;
    end else
      Inc(j);
  end;
  hICMP := IcmpCreateFile;
  if hICMP = INVALID_HANDLE_VALUE then exit;
  try 
    dwSize   := SizeOf(ICMP_ECHO_REPLY)+8;
    pierWork := AllocMem(dwSize);
    try
      if IcmpSendEcho(hICMP,MAKELONG(MAKEWORD(StrToInt(Class1), StrToInt(Class2)),MAKEWORD(StrToInt(Class3), StrToInt(Class4))),nil,0,nil,pierWork,dwSize,TimeOut) = 0 then
        Result:=False
      else
        Result:=True;
    finally 
      FreeMem(pierWork,dwSize); 
    end; 
  finally 
    IcmpCloseHandle(hIcmp); 
  end; 
end;

  // Nur für DFÜ / RAS
function InternetAvailable:Boolean;
begin
  Result := InternetCheckConnection(nil, 0, 0);
end;

function CreateNetResourceList(ResourceType: DWord; 
                              NetResource: PNetResource; 
                              out Entries: DWord; 
                              out List: PNetResourceArray): Boolean; 
var 
  EnumHandle: THandle; 
  BufSize: DWord; 
  Res: DWord; 
begin 
  Result := False; 
  List := Nil; 
  Entries := 0; 
  if WNetOpenEnum(RESOURCE_GLOBALNET,ResourceType,0,NetResource,EnumHandle) = NO_ERROR then begin
    try
      BufSize := $4000;  // 16 kByte  
      GetMem(List, BufSize);  
      try 
        repeat 
          Entries := DWord(-1);  
          FillChar(List^, BufSize, 0); 
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);  
          if Res = ERROR_MORE_DATA then begin  
            ReAllocMem(List, BufSize); 
          end;  
        until Res <> ERROR_MORE_DATA;

        Result := Res = NO_ERROR; 
        if not Result then begin 
          FreeMem(List);  
          List := Nil;  
          Entries := 0; 
        end;  
      except 
        FreeMem(List);  
        raise; 
      end;  
    finally  
      WNetCloseEnum(EnumHandle); 
    end;  
  end; 
end; 

procedure GetComputerList(List: TStrings);
  procedure ScanLevel(ResourceType, DisplayType: DWord; NetResource: PNetResource);
  var
    Entries: DWord;
    NetResourceList: PNetResourceArray;
    i: Integer;
  begin
    if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
      for i := 0 to Integer(Entries) - 1 do begin
        if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
          (NetResourceList[i].dwDisplayType = DisplayType) then begin
          List.AddObject(NetResourceList[i].lpRemoteName,
                        Pointer(NetResourceList[i].dwDisplayType));
        end;
        if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
          ScanLevel(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,@NetResourceList[i]);
      end;
    finally
      FreeMem(NetResourceList);
    end;
  end;
begin 
  ScanLevel(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, Nil);
end;

end.

[Neutral General]

öhhm :gruebel:
Also meine Art funktioniert und ist "etwas" kürzer :mrgreen:
Vorallem versteh ich meine Version :wink:

[Flax]

hehe! Die Netzwerk-Sachen sind aber kein standard krams! :roll:

Und mit Broadcast senden vielleicht?

Beispiel ausprobiert ?

[Der_Ventilator]

Zitat:

Zitat von CReber

Die functions hab ich mir mal irgendwann zu einer Unit zusammengesucht:

Delphi-Quellcode:

unit NetworkFunctions;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinInet, WinSock;

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

type 
  IPAddr = DWORD; 

  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY; 
  ICMP_ECHO_REPLY = packed record 
    Address       : ULONG; 
    Status        : ULONG; 
    RoundTripTime : ULONG;
    DataSize      : WORD; 
    Reserved      : WORD; 
    Data          : Pointer; 
  end; 

  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION; 
  IP_OPTION_INFORMATION = packed record 
    Ttl         : byte; 
    Tos         : byte; 
    Flags       : byte; 
    OptionsSize : byte; 
    OptionsData : Pointer; 
  end;

procedure GetComputerList(List: TStrings);
function InternetAvailable:Boolean;                                 // Only DFÜ / RAS
function Ping(IP:string; TimeOut:Cardinal) : Boolean;                 // TimeOut ~1000
function GetNetworkName(IPAddr: string): string;
function GetIp(const HostName: string): string;

implementation

function IcmpCreateFile : DWORD; stdcall; external 'icmp.dll';
function IcmpCloseHandle(const IcmpHandle : DWORD) : longbool; stdcall; external 'icmp.dll';
function IcmpSendEcho(const IcmpHandle : DWORD;const DestinationAddress : IPAddr;const RequestData : Pointer;const RequestSize : WORD;const RequestOptions : PIP_OPTION_INFORMATION;const ReplyBuffer : Pointer;const ReplySize : DWORD;const TimeOut : DWORD) : DWORD; stdcall; external 'icmp.dll'

function GetNetworkName(IPAddr: string): string;
  var SockAddrIn: TSockAddrIn;
      HostEnt: PHostEnt;
      WSAData: TWSAData;
begin 
  WSAStartup($101, WSAData); 
  SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr)); 
  HostEnt:= GetHostByAddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); 
  if HostEnt <> nil then 
    Result := StrPas(Hostent^.h_name) 
  else
    Result := '';
end;

function GetIp(const HostName: string): string;
  type
    TaPInAddr = array[0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
  var
    phe: PHostEnt;
    pptr: PaPInAddr;
    i: Integer;
    GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  Result := '';
  phe := GetHostByName(PChar(HostName));
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pPtr^[i] <> nil do begin
    Result := inet_ntoa(pptr^[i]^);
    Inc(i);
  end;
  WSACleanup;

end;

function Ping(IP:string; TimeOut:Cardinal):Boolean;
  var hICMP                           : DWORD;
      pierWork                        : PICMP_ECHO_REPLY;
      dwSize                          : DWORD;
      Class1,Class2,Class3,Class4     : String;
      i,j                             : Byte;
begin
  Result:=False;
  j:=1;
  for i:=1 to Length(IP) do begin
    if IP[i]<>'.' then begin
      case j of
        1: Class1:=Class1+IP[i];
        2: Class2:=Class2+IP[i];
        3: Class3:=Class3+IP[i];
        4: Class4:=Class4+IP[i];
      end;
    end else
      Inc(j);
  end;
  hICMP := IcmpCreateFile;
  if hICMP = INVALID_HANDLE_VALUE then exit;
  try 
    dwSize   := SizeOf(ICMP_ECHO_REPLY)+8;
    pierWork := AllocMem(dwSize);
    try
      if IcmpSendEcho(hICMP,MAKELONG(MAKEWORD(StrToInt(Class1), StrToInt(Class2)),MAKEWORD(StrToInt(Class3), StrToInt(Class4))),nil,0,nil,pierWork,dwSize,TimeOut) = 0 then
        Result:=False
      else
        Result:=True;
    finally 
      FreeMem(pierWork,dwSize); 
    end; 
  finally 
    IcmpCloseHandle(hIcmp); 
  end; 
end;

  // Nur für DFÜ / RAS
function InternetAvailable:Boolean;
begin
  Result := InternetCheckConnection(nil, 0, 0);
end;

function CreateNetResourceList(ResourceType: DWord; 
                              NetResource: PNetResource; 
                              out Entries: DWord; 
                              out List: PNetResourceArray): Boolean; 
var 
  EnumHandle: THandle; 
  BufSize: DWord; 
  Res: DWord; 
begin 
  Result := False; 
  List := Nil; 
  Entries := 0; 
  if WNetOpenEnum(RESOURCE_GLOBALNET,ResourceType,0,NetResource,EnumHandle) = NO_ERROR then begin
    try
      BufSize := $4000;  // 16 kByte  
      GetMem(List, BufSize);  
      try 
        repeat 
          Entries := DWord(-1);  
          FillChar(List^, BufSize, 0); 
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);  
          if Res = ERROR_MORE_DATA then begin  
            ReAllocMem(List, BufSize); 
          end;  
        until Res <> ERROR_MORE_DATA;

        Result := Res = NO_ERROR; 
        if not Result then begin 
          FreeMem(List);  
          List := Nil;  
          Entries := 0; 
        end;  
      except 
        FreeMem(List);  
        raise; 
      end;  
    finally  
      WNetCloseEnum(EnumHandle); 
    end;  
  end; 
end; 

procedure GetComputerList(List: TStrings);
  procedure ScanLevel(ResourceType, DisplayType: DWord; NetResource: PNetResource);
  var
    Entries: DWord;
    NetResourceList: PNetResourceArray;
    i: Integer;
  begin
    if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
      for i := 0 to Integer(Entries) - 1 do begin
        if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
          (NetResourceList[i].dwDisplayType = DisplayType) then begin
          List.AddObject(NetResourceList[i].lpRemoteName,
                        Pointer(NetResourceList[i].dwDisplayType));
        end;
        if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
          ScanLevel(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,@NetResourceList[i]);
      end;
    finally
      FreeMem(NetResourceList);
    end;
  end;
begin 
  ScanLevel(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, Nil);
end;

end.

Für D2009 habe ich die PChar-Variablen in PAnsiChar-Variablen abgeändert:
Ping funktioniert aber weiterhin und hat gegenüber der Indy-Komponente den Vorteil, dass man das leichter in eine Funktion einbauen kann.

Delphi-Quellcode:

unit networkfunctions;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinInet, WinSock;

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

type
  IPAddr = DWORD;

  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
  ICMP_ECHO_REPLY = packed record
    Address       : ULONG;
    Status        : ULONG;
    RoundTripTime : ULONG;
    DataSize      : WORD;
    Reserved      : WORD;
    Data          : Pointer;
  end;

  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;
  IP_OPTION_INFORMATION = packed record
    Ttl         : byte;
    Tos         : byte;
    Flags       : byte;
    OptionsSize : byte;
    OptionsData : Pointer;
  end;

procedure GetComputerList(List: TStrings);
function InternetAvailable:Boolean;                                 // Only DFÜ / RAS
function Ping(IP:string; TimeOut:Cardinal) : Boolean;                 // TimeOut ~1000
function GetNetworkName(IPAddr: string): string;
function GetIp(const HostName: string): string;

implementation

function IcmpCreateFile : DWORD; stdcall; external 'icmp.dll';
function IcmpCloseHandle(const IcmpHandle : DWORD) : longbool; stdcall; external 'icmp.dll';
function IcmpSendEcho(const IcmpHandle : DWORD;const DestinationAddress : IPAddr;const RequestData : Pointer;const RequestSize : WORD;const RequestOptions : PIP_OPTION_INFORMATION;const ReplyBuffer : Pointer;const ReplySize : DWORD;const TimeOut : DWORD) : DWORD; stdcall; external 'icmp.dll'

function GetNetworkName(IPAddr: string): string;
  var SockAddrIn: TSockAddrIn;
      HostEnt: PHostEnt;
      WSAData: TWSAData;
begin
  WSAStartup($101, WSAData);
  SockAddrIn.sin_addr.s_addr := inet_addr(PAnsiChar(IPAddr));
  HostEnt:= GetHostByAddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
  if HostEnt <> nil then
    Result := StrPas(Hostent^.h_name)
  else
    Result := '';
end;

function GetIp(const HostName: string): string;
  type
    TaPInAddr = array[0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
  var
    phe: PHostEnt;
    pptr: PaPInAddr;
    i: Integer;
    GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  Result := '';
  phe := GetHostByName(PAnsiChar(HostName));
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pPtr^[i] <> nil do begin
    Result := inet_ntoa(pptr^[i]^);
    Inc(i);
  end;
  WSACleanup;

end;

function Ping(IP:string; TimeOut:Cardinal):Boolean;
  var hICMP                           : DWORD;
      pierWork                        : PICMP_ECHO_REPLY;
      dwSize                          : DWORD;
      Class1,Class2,Class3,Class4     : String;
      i,j                             : Byte;
begin
  Result:=False;
  j:=1;
  for i:=1 to Length(IP) do begin
    if IP[i]<>'.' then begin
      case j of
        1: Class1:=Class1+IP[i];
        2: Class2:=Class2+IP[i];
        3: Class3:=Class3+IP[i];
        4: Class4:=Class4+IP[i];
      end;
    end else
      Inc(j);
  end;
  hICMP := IcmpCreateFile;
  if hICMP = INVALID_HANDLE_VALUE then exit;
  try
    dwSize   := SizeOf(ICMP_ECHO_REPLY)+8;
    pierWork := AllocMem(dwSize);
    try
      if IcmpSendEcho(hICMP,MAKELONG(MAKEWORD(StrToInt(Class1), StrToInt(Class2)),MAKEWORD(StrToInt(Class3), StrToInt(Class4))),nil,0,nil,pierWork,dwSize,TimeOut) = 0 then
        Result:=False
      else
        Result:=True;
    finally
      FreeMem(pierWork,dwSize);
    end;
  finally
    IcmpCloseHandle(hIcmp);
  end;
end;

  // Nur für DFÜ / RAS
function InternetAvailable:Boolean;
begin
  Result := InternetCheckConnection(nil, 0, 0);
end;

function CreateNetResourceList(ResourceType: DWord;
                              NetResource: PNetResource;
                              out Entries: DWord;
                              out List: PNetResourceArray): Boolean;
var
  EnumHandle: THandle;
  BufSize: DWord;
  Res: DWord;
begin
  Result := False;
  List := Nil;
  Entries := 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET,ResourceType,0,NetResource,EnumHandle) = NO_ERROR then begin
    try
      BufSize := $4000;  // 16 kByte
      GetMem(List, BufSize);
      try
        repeat
          Entries := DWord(-1);
          FillChar(List^, BufSize, 0);
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
          if Res = ERROR_MORE_DATA then begin
            ReAllocMem(List, BufSize);
          end;
        until Res <> ERROR_MORE_DATA;

        Result := Res = NO_ERROR;
        if not Result then begin
          FreeMem(List);
          List := Nil;
          Entries := 0;
        end;
      except
        FreeMem(List);
        raise;
      end;
    finally
      WNetCloseEnum(EnumHandle);
    end;
  end;
end;

procedure GetComputerList(List: TStrings);
  procedure ScanLevel(ResourceType, DisplayType: DWord; NetResource: PNetResource);
  var
    Entries: DWord;
    NetResourceList: PNetResourceArray;
    i: Integer;
  begin
    if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
      for i := 0 to Integer(Entries) - 1 do begin
        if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
          (NetResourceList[i].dwDisplayType = DisplayType) then begin
          List.AddObject(NetResourceList[i].lpRemoteName,
                        Pointer(NetResourceList[i].dwDisplayType));
        end;
        if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
          ScanLevel(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,@NetResourceList[i]);
      end;
    finally
      FreeMem(NetResourceList);
    end;
  end;
begin
  ScanLevel(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, Nil);
end;

end.

[TeronG]

Dann Poste ich auch mal "mein" Ping.

Delphi-Quellcode:

unit uPing;

interface
uses
  Windows, SysUtils, Classes;

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

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


function Ping(InetAddress : string;TimeOut : DWORD = 1) : boolean;

implementation

uses
  WinSock;


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;TimeOut : DWORD = 1) : boolean;
var
  Handle : THandle;
  InAddr : IPAddr;
  DW : DWORD;
  rep : array[1..128] of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then
   Exit;
  TranslateStringToTInAddr(InetAddress, InAddr);            //timeOut 
  DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 1);
  Result := (DW <> 0);
  IcmpCloseHandle(Handle);
end;

end.

Verwenden:

Delphi-Quellcode:

 if Ping(vIPAdresse,vTimeOut) then

[Luckie]

Kabnn es sein, dass man für den Indy Ping Administratorrechte benötigt?

Zitat:

Zitat von Neutral General

Also meine Art funktioniert und ist "etwas" kürzer :mrgreen:

Das denkst aber auch nur du. ;) Die Indy Komponenten kapseln den Code nur für dich.