delphi - 网络基础结构发现

  显示原文与译文双语对照的内容
0 0

我想进行完全的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,
                  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 ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);
procedure ScanLevel(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(@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地址?

谢谢

enter image description here

时间:原作者:6个回答

0 0

我修改你代码添加函数 GetHostNameinet_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,0,@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) and (Length(lpRemoteName)>2) and (LastDelimiter('', lpRemoteName)=2) then
   Result:=Copy(lpRemoteName, 3, 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, 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 ScanNetworkResources(ResourceType, DisplayType: DWord);
procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
  IPAddress, MacAddress : AnsiString;
  ErrCode : DWORD;
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
          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.
原作者:
...