2012-04-16 15 views
12

मैं एक पूरी तरह से लैन डिवाइस खोज करना चाहता हूं, ताकि मैं संलग्न एक के समान चित्र बना सकूं, लेकिन आईपी और मैक पते जैसी अतिरिक्त जानकारी के साथ।नेटवर्क इंफ्रास्ट्रक्चर डिस्कवरी

मैं 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; 

लेकिन यह केवल नेटवर्क में कंप्यूटर के नाम देता है, रूटर और उनके आईपी पते के बिना। तो यह वास्तव में एक समाधान नहीं है।

क्या आप कृपया मुझे बता सकते हैं कि स्थानीय नेटवर्क में सभी आईपी और मैक पते के साथ सभी उपकरणों (राउटर, कंप्यूटर, प्रिंटर) को गिनने का एक अच्छा तरीका क्या है?

धन्यवाद।

enter image description here

+0

एनएमएपी का उपयोग करें और परिणाम – mjn

+0

का विश्लेषण करें मैं तीसरे पक्ष के ऐप्स का उपयोग करने पर "मूल" समाधान पसंद करूंगा। – Pateman

+0

आपको आरआरयूजेड की साइट [यहां] पर कुछ रोचक ressouces मिल सकता है (http://theroadtodelphi.wordpress.com/category/networking/)। – menjaraz

उत्तर

14

मैं तुम्हें कोड समारोह GetHostName और inet_ntoa जोड़ने आईपी पते और एक नेटवर्क संसाधन के मैक पता प्राप्त करने के लिए SendARP समारोह पाने के लिए संशोधित।

{$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. 
संबंधित मुद्दे