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:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
const MAX_INTERFACE_NAME_LEN = $100; // maximale Länge Name des Interfaces
const MAXLEN_PHYSADDR = 8; // maximale Länge der physischen Adresse
const MAXLEN_IFDESCR = $100; // maximale Länge Beschreibung des Int.
// Die Struktur eines IFRow-Tables - wird für jedes Interface erstellt
type
TMIB_IFROW = record
wszName : array [0 .. (MAX_INTERFACE_NAME_LEN*2-1)] of byte;
dwIndex : cardinal; // index of the interface
dwType : Longint ;// type of interface
dwMtu : Longint ;// max transmission unit
dwSpeed : Longint ;// speed of the interface
dwPhysAddrLen : Longint ;// length of physical address
bPhysAddr : array [0 .. (MAXLEN_PHYSADDR-1)] of byte ;// physical address of adapter
dwAdminStatus : Longint ;// administrative status
dwOperStatus : Longint ;// operational status
dwLastChange : Longint ;// last time operational status changed
dwInOctets : Longint ;// octets received
dwInUcastPkts : Longint ;// unicast packets received
dwInNUcastPkts : Longint ;// non-unicast packets received
dwInDiscards : Longint ;// received packets discarded
dwInErrors : Longint ;// erroneous packets received
dwInUnknownProtos : Longint ;// unknown protocol packets received
dwOutOctets : Longint ;// octets sent
dwOutUcastPkts : Longint ;// unicast packets sent
dwOutNUcastPkts : Longint ;// non-unicast packets sent
dwOutDiscards : Longint ;// outgoing packets discarded
dwOutErrors : Longint ;// erroneous packets sent
dwOutQLen : Longint ;// output queue length
dwDescrLen : Longint ;// length of bDescr member
bDescr :array[0 .. (MAXLEN_IFDESCR-1)] of char ;// interface description
End;
// Struktur des IfTables
TifTable = record
nRows : LongInt; // Anzahl Interfaces
ifRow : array[1..20]of TMIB_IFROW; // mehr als 20 sollten es aber nicht sein!
end;
// -----------------------------------für die IPs ---------------------
type
_MIB_IPADDRROW = packed record
dwAddr: DWORD; // IP address
dwIndex: DWORD; // interface index
dwMask: DWORD; // subnet mask
dwBCastAddr: DWORD; // broadcast address
dwReasmSize: DWORD; // re-assembly size
unused: WORD; // not currently used
unused2: WORD; // not currently used
end;
TMib_IpAddrRow = _MIB_IPADDRROW;
PMib_IpAddrRow = ^TMib_IpAddrRow;
_MIB_IPADDRTABLE = packed record
dwNumEntries: DWORD; // number of entries in the table
table: array[0..0] of TMib_IpAddrRow; // array of IP address entries
end;
TMib_IpAddrTable = _MIB_IPADDRTABLE;
PMib_IpAddrTable = ^TMib_IpAddrTable;
type
TForm1 = class(TForm)
Button1: TButton;
RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
pIfTable : ^TifTable; // ein Pointer auf eine Interfacetabelle
L : record // L ist ein Record für das Auslesen der Werte
cbRequired : Longint; // wird gebraucht, um die benötigte Buffer-Größe zu ermitteln
nStructSize : LongInt;
tmp : String;
end;
end;
// für IPs
function GetIpAddrTable(ipAddrTable: PMIB_IPADDRTABLE; var dwSize: ULONG; bOrder: BOOL): Integer; stdcall; external 'iphlpapi.dll';
// Einbinden der Funktion aus iphlpapi, um die Interfaces-Stats zu holen
function GetIfTable(pIfRowTable: Pointer ; var pdwSize : Longint; bOrder : LongInt): Longint;stdcall;
function GetIfTable; external 'iphlpapi.dll' name 'GetIfTable';
var
Form1: TForm1;
cCode : Word;
implementation
function IntToIp(Ip: Cardinal): string;
type TIpRec = record n1, n2, n3, n4: Byte; end;
begin
with TIpRec(Ip) do Result := Format('%d.%d.%d.%d', [n1, n2, n3, n4]);
end;
function GetAdress(index : DWORD) : DWORD;
var
Size: longint;
IpAddrTable: PMib_IpAddrTable;
i: Integer;
begin
Size := 0;
GetIpAddrTable(nil, Size, True);
if Size > 0 then
begin
GetMem(IpAddrTable, Size);
try
if GetIpAddrTable(IpAddrTable, Size, True) = ERROR_SUCCESS then
begin
for i := 0 to IpAddrTable^.dwNumEntries -1 do
begin
if (index = IpAddrTable^.table[i].dwIndex) then
begin
result := IpAddrTable^.table[i].dwAddr;
end ;
end;
end;
finally
FreeMem(IpAddrTable);
end;
end;
end;
function MacAdresse (VAR Addr) : String;
var daten : array[0..5] of byte absolute Addr;
begin
Result := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[Daten[0],daten[1],Daten[2],Daten[3],Daten[4]])
end;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
// Die Windwos Error Messages...
const ERROR_NOT_SUPPORTED = $50;
const ERROR_INSUFFICIENT_BUFFER = 122 ;
const ERROR_INVALID_PARAMETER = 87 ;
var
i : integer;
begin
pIfTable := nil;
Richedit1.Clear ;
ZeroMemory(@L, sizeof(L));
// schauen, wie gross die Tabelle ist..
cCode := GetIfTable(pIfTable, L.cbRequired,1);
if (L.cbRequired <=0) or (L.cbRequired>sizeof(TifTable)) then exit;
// Mem allokieren und IP-Table empfangen...
GetMem(pIfTable, L.cbRequired);
ZeroMemory(pIfTable, L.cbrequired);
cCode := GetIfTable(pIfTable, L.cbRequired, 1);
if cCode <> ERROR_SUCCESS then
begin
showmessage ('Fehler beim Funktionsaufruf') ;
exit;
end;
richedit1.Lines.clear;
for i:= 1 to pIfTable^.nRows do begin
richedit1.Lines.add(StrPas(@pIfTable^.ifRow[i].bDescr));
L.tmp := MacAdresse(pifTable^.ifRow[i].bPhysAddr);
L.tmp := Format ('phys Add.: %s', [L.tmp]);
richedit1.Lines.Add(L.tmp);
richedit1.Lines.Add('IP: ' + InttoIp(getAdress(pIfTable^.ifRow[i].dwIndex)));
richedit1.Lines.add('');
end;
end;
end. |
