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

[Sharky]

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

[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

[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.

[Garfield]

Zitat von CReber:

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]

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.

[Neutral General]

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

[Flax]

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

Und mit Broadcast senden vielleicht?

Beispiel ausprobiert ?

[Der_Ventilator]

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.