delphi – 网络基础架构发现

我想执行一个彻底的LAN设备发现,以便我可以创建一个类似于附件的图,但附加信息,如IP和MAC地址.

我已经尝试过Torry的代码：

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

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,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 ScanNetworkResources(ResourceType,DisplayType: DWord; List: TStrings);

procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(ResourceType,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(@NetResourceList[i]);
    end;
  finally
    FreeMem(NetResourceList);
  end;
end;

begin
  ScanLevel(Nil);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ScanNetworkResources(RESOURCETYPE_DISK,RESOURCEDISPLAYTYPE_SERVER,ListBox1.Items);
end;

但它只返回网络中的计算机的名称,而不需要路由器及其IP地址.所以这不是一个真正的解决方案.

你能告诉我什么是枚举本地网络中的所有设备(路由器,计算机,打印机)以及其IP和MAC地址的好方法？

谢谢.

解决方法

我修改了你添加功能 GetHostName和 inet_ntoa的代码,以获取IP地址和 SendARP的功能来获取网络资源的MAC地址.

{$APPTYPE CONSOLE}

{$R *.res}

uses
  StrUtils,Windows,WinSock,SysUtils;

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

function SendArp(DestIP,SrcIP:ULONG;pMacAddr:pointer;PhyAddrLen:pointer) : DWord; StdCall; external 'iphlpapi.dll' name 'SendARP';

function GetIPAddress(const HostName: AnsiString): AnsiString;
var
  HostEnt: PHostEnt;
  Host: AnsiString;
  SockAddr: TSockAddrIn;
begin
  Result := '';
  Host := HostName;
  if Host = '' then
  begin
    SetLength(Host,MAX_PATH);
    GetHostName(PAnsiChar(Host),MAX_PATH);
  end;
  HostEnt := GetHostByName(PAnsiChar(Host));
  if HostEnt <> nil then
  begin
    SockAddr.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
    Result := inet_ntoa(SockAddr.sin_addr);
  end;
end;


function GetMacAddr(const IPAddress: AnsiString; var ErrCode : DWORD): AnsiString;
var
 MacAddr    : Array[0..5] of Byte;
 DestIP     : ULONG;
 PhyAddrLen : ULONG;
begin
  Result    :='';
  ZeroMemory(@MacAddr,SizeOf(MacAddr));
  DestIP    :=inet_addr(PAnsiChar(IPAddress));
  PhyAddrLen:=SizeOf(MacAddr);
  ErrCode   :=SendArp(DestIP,@MacAddr,@PhyAddrLen);
  if ErrCode = S_OK then
   Result:=AnsiString(Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[MacAddr[0],MacAddr[1],MacAddr[2],MacAddr[3],MacAddr[4],MacAddr[5]]));
end;


function ParseRemoteName(Const lpRemoteName : string) : string;
begin
  Result:=lpRemoteName;
  if StartsStr('\\',lpRemoteName) and (Length(lpRemoteName)>2) and (LastDelimiter('\',lpRemoteName)>2) then
   Result:=Copy(lpRemoteName,3,PosEx('\',lpRemoteName,3)-3)
  else
  if StartsStr('\\',lpRemoteName)=2) then
   Result:=Copy(lpRemoteName,length(lpRemoteName));
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,EnumHandle) = NO_ERROR then
  begin
    try
      BufSize := $4000;  // 16 kByte
      GetMem(List,DisplayType: DWord);

procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
  IPAddress,MacAddress : AnsiString;
  ErrCode : DWORD;
begin
  if CreateNetResourceList(ResourceType,NetResourceList) then try
    for i := 0 to Integer(Entries) - 1 do
    begin
      if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
        (NetResourceList[i].dwDisplayType = DisplayType) then
        begin
          IPAddress   :=GetIPAddress(ParseRemoteName(AnsiString(NetResourceList[i].lpRemoteName)));
          MacAddress  :=GetMacAddr(IPAddress,ErrCode);
          Writeln(Format('Remote Name %s Ip %s MAC %s',[NetResourceList[i].lpRemoteName,IPAddress,MacAddress]));
        end;
      if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
        ScanLevel(@NetResourceList[i]);
    end;
  finally
    FreeMem(NetResourceList);
  end;
end;

begin
  ScanLevel(Nil);
end;

var
  WSAData: TWSAData;
begin
  try
   if WSAStartup($0101,WSAData)=0 then
   try
     ScanNetworkResources(RESOURCETYPE_ANY,RESOURCEDISPLAYTYPE_SERVER);
     Writeln('Done');
   finally
     WSACleanup;
   end;
  except
    on E:Exception do
      Writeln(E.Classname,': ',E.Message);
  end;
  Readln;
end.

delphi – 网络基础架构发现

解决方法

猜你在找的Delphi相关文章