AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

IP's anpingen

Ein Thema von Neutral General · begonnen am 31. Jan 2005 · letzter Beitrag vom 22. Feb 2018
Antwort Antwort
Seite 1 von 2  1 2      
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#1

IP's anpingen

  Alt 31. Jan 2005, 11:07
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
Michael
  Mit Zitat antworten Zitat
Benutzerbild von Sharky
Sharky

Registriert seit: 29. Mai 2002
Ort: Frankfurt
8.252 Beiträge
 
Delphi 2006 Professional
 
#2

Re: IP's anpingen

  Alt 31. Jan 2005, 11:15
Zitat von Neutral General:
...wie das mit Indy (IdEcho) geht
Mit dem Echo-Protokoll pingen? Das geht wohl nicht.
Verwende für einen Pint IdIcmpClient und dann die Methode .Ping
Stephan B.
"Lasst den Gänsen ihre Füßchen"
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#3

Re: IP's anpingen

  Alt 31. Jan 2005, 11:17
Ja das hatte ich auch schonmal probiert aber immer wenn ich den Host wechseln will gibts ne Exception
Michael
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#4

Re: IP's anpingen

  Alt 31. Jan 2005, 11:25
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
Michael
  Mit Zitat antworten Zitat
Benutzerbild von CReber
CReber

Registriert seit: 26. Nov 2003
Ort: Berlin
343 Beiträge
 
Delphi 2006 Professional
 
#5

Re: IP's anpingen

  Alt 31. Jan 2005, 15:36
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.
Christian Reber
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.219 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#6

Re: IP's anpingen

  Alt 31. Jan 2005, 15:47
öhhm
Also meine Art funktioniert und ist "etwas" kürzer
Vorallem versteh ich meine Version
Michael
  Mit Zitat antworten Zitat
Flax

Registriert seit: 12. Mär 2003
76 Beiträge
 
Delphi 7 Enterprise
 
#7

Re: IP's anpingen

  Alt 31. Jan 2005, 16:51
hehe! Die Netzwerk-Sachen sind aber kein standard krams!

Und mit Broadcast senden vielleicht?

Beispiel ausprobiert ?
  Mit Zitat antworten Zitat
Der_Ventilator

Registriert seit: 11. Apr 2004
Ort: Kanada
136 Beiträge
 
Delphi 2010 Professional
 
#8

Re: IP's anpingen

  Alt 13. Aug 2009, 15:25
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.
Codito, ergo sum. - I code therefore I am
  Mit Zitat antworten Zitat
Benutzerbild von TeronG
TeronG

Registriert seit: 19. Jul 2004
Ort: München
960 Beiträge
 
Delphi 2007 Professional
 
#9

Re: IP's anpingen

  Alt 13. Aug 2009, 16:04
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:
 if Ping(vIPAdresse,vTimeOut) then
龍 Der Unterschied zwischen Theorie und Praxis ist in der Praxis größer als in der Theorie.
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#10

Re: IP's anpingen

  Alt 13. Aug 2009, 22:11
Kabnn es sein, dass man für den Indy Ping Administratorrechte benötigt?

Zitat von Neutral General:
Also meine Art funktioniert und ist "etwas" kürzer
Das denkst aber auch nur du. Die Indy Komponenten kapseln den Code nur für dich.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


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 09:16 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz