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);
{ Private declarations }
public
{ Public declarations }
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)); // struktur ausnullen
ncb.ncb_command := char(NCBENUM); // festlegen, was netbios machen soll => auflisten
ncb.ncb_buffer := @lenum; // puffer zuweisen
ncb.ncb_length := sizeof(TLanaEnum); // länge des puffers angeben
err:=Netbios(@ncb);
if (err <> char(NRC_GOODRET)) then ShowMessage('Fehler bei netbios funktion');
ZeroMemory(@ncb,sizeof(NCB));
ncb.ncb_command := char(NCBRESET); // zurücksetzen
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); // status des adapters abfragen
ncb.ncb_buffer := @stats;
ncb.ncb_length := sizeof(stats);
strlcopy(ncb.ncb_callname,Pchar(ip),length(ip)); // in ncb_callname muss der text (die IPangabe)
// reinkopiert werden
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; //auf eine erläuterung der IP-funktion verzichte ich jetzt
var HostInfo : PHostEnt; //da diese gemeinhin bekannt ist
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); //festlegung, was wir aufgelisttett haben wollen
//wichtig für die skalierung der funktion
if dwRet <> NO_ERROR then Exit; // hier fehlerbehandlung rein
dwBufSize := 16384; //puffer etwas grösser, für grössere netzwerke
GetMem(pBuf, dwBufSize); //Speicher holen
try
while True do
begin
dwCount := $FFFFFFFF; //alles anfordern
dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize); //auflistung selbst
if dwRet = ERROR_MORE_DATA then
begin
dwCount := $FFFFFFFF;
FreeMem(pBuf);
GetMem(pBuf, 2*dwBufSize); //doppelte Puffergrösse allokieren
dwRet := WNetEnumResource(hEnum, dwCount, pBuf, dwBufSize); //und nochmal
end;
if dwRet = ERROR_NO_MORE_ITEMS then Break; // nichts mehr zum auflisten => fertig
if dwRet <> NO_ERROR then Abort; // hier fehlerbehandlung rein
pNR := pBuf;
while dwCount > 0 do //alle aufgezählten elemente durchmachen
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); // aufgeliste elemente in den Treeview
NetworkEnum(ChildNode, pNR); // bei jedem element die unterelemente durchlaufen
// => Rekursiver aufruf !!
Inc(pNR); // nicht +1, da typisierter pointer sonder + sizeof(pNR) !!
Dec(dwCount);
end;
end;
finally
WNetCloseEnum(hEnum);
FreeMem(pBuf);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var GInitData : TWSADATA;
begin
WSAStartup($101, GInitData); // WinSock starten (wird für IP-ermittlung gebraucht)
Screen.cursor:= crHourglass;
NetworkEnum(nil,nil);
Screen.cursor:= crDefault;
WSACleanup;
end;