Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi IP's anpingen (https://www.delphipraxis.net/39272-ips-anpingen.html)

Neutral General 31. Jan 2005 10:07
IP's anpingen
 
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 31. Jan 2005 10:15
Re: IP's anpingen
 
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 31. Jan 2005 10:17
Re: IP's anpingen
 
Ja das hatte ich auch schonmal probiert aber immer wenn ich den Host wechseln will gibts ne Exception :(

Neutral General 31. Jan 2005 10:25
Re: IP's anpingen
 
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 31. Jan 2005 14:36
Re: IP's anpingen
 
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 31. Jan 2005 14:47
Re: IP's anpingen
 
öhhm :gruebel:
Also meine Art funktioniert und ist "etwas" kürzer :mrgreen:
Vorallem versteh ich meine Version :wink:

Flax 31. Jan 2005 15:51
Re: IP's anpingen
 
hehe! Die Netzwerk-Sachen sind aber kein standard krams! :roll:

Und mit Broadcast senden vielleicht?

Beispiel ausprobiert ?

Der_Ventilator 13. Aug 2009 14:25
Re: IP's anpingen
 
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 13. Aug 2009 15:04
Re: IP's anpingen
 
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 13. Aug 2009 21:11
Re: IP's anpingen
 
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.

Klaus01 14. Aug 2009 08:34
Re: IP's anpingen
 
Zitat:
Zitat von Luckie
Kabnn es sein, dass man für den Indy Ping Administratorrechte benötigt?
Wenn das eine Frage ist, ja Indy ping benötigt Adminrechte.
Wenn das keine Frage ist, ist es mir unklar worauf Du dich beziehst.

Grüße
Klaus

Luckie 14. Aug 2009 11:52
Re: IP's anpingen
 
Jupp, war eine Frage. Weil es wäre dann ja der Code vorzuziehen, der keine Administratorenrechte benötigt.

Garfield 2. Okt 2016 21:35
AW: Re: IP's anpingen
 
Zitat:
Zitat von CReber (Beitrag 267054)
Die functions hab ich mir mal irgendwann zu einer Unit zusammengesucht:
Ich habe hier im Moment Lazarus 1.4.2. Da ist diese Unit mit einer kleinen Änderung bei GetComputerList drin. Und bei dieser Function hängt sich mein Programm unter Win10 irgendwann weg. In Scanlevel habe ich immer Entries = 3, aber i geht immer nur von 0 bis 1 und der Inhalt von NetResourceList scheint sich nicht zu ändern.

Garfield 3. Okt 2016 08:22
AW: IP's anpingen
 
Bei Lazarus 1.6 wurden nur die nicht benötigten Units unter uses entfernt.

Delphi-Quellcode:
          List.AddObject(NetResourceList[i].lpRemoteName,
                        Pointer(NetResourceList[i].dwDisplayType));

ergibt die Fehlermeldung

Zitat:
networkfunctions.pas(183,123) Error: Incompatible type for arg no. 2: Got "Pointer", expected "TObject"
.

Deshalb wurde daraus
Delphi-Quellcode:
          List.Add(NetResourceList^[i].lpRemoteName);
                        // Pointer(NetResourceList^[i].dwDisplayType));
und irgendwie scheint sich der Pointer nicht zu bewegen.

Bohrstein 22. Feb 2018 09:17
AW: Re: IP's anpingen
 
Zitat:
Zitat von TeronG (Beitrag 941484)
Dann Poste ich auch mal "mein" Ping.
Funktioniert super, danke. Einzig musste ich die Zeile "GetHostByName" (wegen der Meldung: "inkompatible Typen PAnsiChar und PWideChar") für das aktuelle Delphi (Tokyo) anpassen:

Delphi-Quellcode:
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
  phe: PHostEnt;
  pac: PAnsiChar;
  GInitData: TWSAData;
  s: PAnsiChar; // <-- Variable für die Umwandlung von String nach PansiChar
begin
  WSAStartup($101, GInitData);
  try
    s := PansiChar(AnsiString(AIP)); // <-- Umwandlung
    phe := GetHostByName(s); // <-- kein PChar mehr
    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;

Neutral General 22. Feb 2018 09:19
AW: IP's anpingen
 
Ich habe diesen Thread vor 13 Jahren geöffnet :shock: :roll:

Bernhard Geyer 22. Feb 2018 09:22
AW: IP's anpingen
 
Zitat:
Zitat von Neutral General (Beitrag 1394405)
Ich habe diesen Thread vor 13 Jahren geöffnet :shock: :roll:
Das muss man doch vorhersehen. Sonst wird das nix mit der 100%igen Aufwärtskompatiblität für alle Zeiten ...


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:57 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