1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140:
| interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, winsock, nb30; type TForm1 = class(TForm) TV: TTreeView; ListBox1: TListBox; Button1: TButton; Label1: TLabel; Label2: TLabel; ListBox2: TListBox; Label3: TLabel; procedure Button1Click(Sender: TObject); private procedure NetworkEnum(TreeNode: TTreeNode; pNetNode: PNetResourceA);
public
end; var Form1: TForm1; FPCcount:longint; type TaPInAddr = array [0..10] of PInAddr; PaPInAddr = ^TaPInAddr; type ASTAT = record adapt:TAdapterStatus; NameBuff:array[1..10] of TNameBuffer; end; implementation {$R *.DFM} function GetLocalMACbyIP(IP:string):string; var lenum: TLanaEnum; ncb:TNCB; stats:ASTAT; err:char; i:longint; begin result:=''; ZeroMemory(@ncb,sizeof(NCB)); ncb.ncb_command := char(NCBENUM); ncb.ncb_buffer := @lenum; ncb.ncb_length := sizeof(TLanaEnum); err:=Netbios(@ncb); if (err <> char(NRC_GOODRET)) then ShowMessage('Fehler bei netbios funktion'); ZeroMemory(@ncb,sizeof(NCB)); ncb.ncb_command := char(NCBRESET); ncb.ncb_buffer := @lenum; err:=Netbios(@ncb); if (err <> char(NRC_GOODRET)) then ShowMessage('Fehler bei netbios funktion'); ZeroMemory(@ncb,sizeof(NCB)); ncb.ncb_command := char(NCBASTAT); ncb.ncb_buffer := @stats; ncb.ncb_length := sizeof(stats); strlcopy(ncb.ncb_callname,Pchar(ip),length(ip)); err:=Netbios(@ncb); if (err <> char(NRC_GOODRET)) then ShowMessage('Fehler bei netbios funktion'); for i:=0 to 5 do result:=result+inttohex(byte(stats.adapt.adapter_address[i]),2); end; function IPbyName(hostname:string):string; var HostInfo : PHostEnt; pptr : PaPInAddr; i : longint; begin result:=''; HostInfo:=gethostbyname(pchar(stringreplace(hostname,'\','',[rfReplaceAll]))); if Hostinfo <> nil then begin pptr := PaPInAddr(HostInfo^.h_addr_list); I := 0; while pptr^[I] <> nil do begin result:=StrPas(inet_ntoa(pptr^[I]^)); Inc(I); end; end; end; procedure TForm1.NetworkEnum(TreeNode: TTreeNode; pNetNode: PNetResourceA); var hEnum : THandle; dwCount : DWORD; dwBufSize : DWORD; pNR, pBuf : PNetResourceA; dwRet : DWORD; ChildNode : TTreeNode; IP : string; begin dwRet := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0,pNetNode, hEnum); if dwRet <> NO_ERROR then Exit; dwBufSize := 16384; GetMem(pBuf, dwBufSize); try while True do begin dwCount := $FFFFFFFF; dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize); if dwRet = ERROR_MORE_DATA then begin dwCount := $FFFFFFFF; FreeMem(pBuf); GetMem(pBuf, 2*dwBufSize); dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize); end; if dwRet = ERROR_NO_MORE_ITEMS then Break; if dwRet <> NO_ERROR then Abort; pNR := pBuf; while dwCount > 0 do begin IP:=''; IP:=IPbyName(pNR.lpRemoteName); if IP <> '' then begin Listbox1.Items.add(IP + ' ('+pNR.lpRemoteName+')'); Listbox2.Items.add(GetLocalMACbyIP(IP)); IP:=' ('+IP+')'; end; application.processmessages; ChildNode := TV.Items.AddChild(TreeNode, pNR.lpRemoteName + IP); NetworkEnum(ChildNode, pNR); Inc(pNR); Dec(dwCount); end; end; finally WNetCloseEnum(hEnum); FreeMem(pBuf); end; end; procedure TForm1.Button1Click(Sender: TObject); var GInitData : TWSADATA; begin WSAStartup($101, GInitData); Screen.cursor:= crHourglass; NetworkEnum(nil,nil); Screen.cursor:= crDefault; WSACleanup; end; |