source: trunk/UEthernetAddress.pas

Last change on this file was 11, checked in by george, 16 years ago

Opraveno: Načítání seznamu síťových adaptérů přes API funkce.
Opraveno: Uvolňění paměti AppUserEventsOptions.
Přidáno: Textová identifikace Windows Vista.
File size: 9.5 KB
Line 
1unit UEthernetAddress;
2
3interface
4
5uses classes, sysutils, IpHlpApi, IpTypes, Forms, StdCtrls, Windows, Dialogs;
6
7const
8 MAX_INTERFACE_NAME_LEN = $100;
9 ERROR_SUCCESS = 0;
10 MAXLEN_IFDESCR = $100;
11 MAXLEN_PHYSADDR = 8;
12
13 MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0 ;
14 MIB_IF_OPER_STATUS_UNREACHABLE = 1;
15 MIB_IF_OPER_STATUS_DISCONNECTED = 2;
16 MIB_IF_OPER_STATUS_CONNECTING = 3;
17 MIB_IF_OPER_STATUS_CONNECTED = 4;
18 MIB_IF_OPER_STATUS_OPERATIONAL = 5;
19
20 MIB_IF_TYPE_OTHER = 1;
21 MIB_IF_TYPE_ETHERNET = 6;
22 MIB_IF_TYPE_TOKENRING = 9;
23 MIB_IF_TYPE_FDDI = 15;
24 MIB_IF_TYPE_PPP = 23;
25 MIB_IF_TYPE_LOOPBACK = 24;
26 MIB_IF_TYPE_SLIP = 28;
27
28 MIB_IF_ADMIN_STATUS_UP = 1;
29 MIB_IF_ADMIN_STATUS_DOWN = 2;
30 MIB_IF_ADMIN_STATUS_TESTING = 3;
31
32
33type
34 TNetworkInterface = record
35 IPAddress: string;
36 BroadcastIPAddress: string;
37 SubNetMask: string;
38 Name: string;
39 DeviceName: string;
40 GUID: string;
41 end;
42 TNetworkInterfaceList = array of TNetworkInterface;
43
44 MIB_IFROW = Record
45 wszName : Array[0 .. (MAX_INTERFACE_NAME_LEN*2-1)] of char;
46 dwIndex : LongInt;
47 dwType : LongInt;
48 dwMtu : LongInt;
49 dwSpeed : LongInt;
50 dwPhysAddrLen : LongInt;
51 bPhysAddr : Array[0 .. (MAXLEN_PHYSADDR-1)] of Byte;
52 dwAdminStatus : LongInt;
53 dwOperStatus : LongInt;
54 dwLastChange : LongInt;
55 dwInOctets : LongInt;
56 dwInUcastPkts : LongInt;
57 dwInNUcastPkts : LongInt;
58 dwInDiscards : LongInt;
59 dwInErrors : LongInt;
60 dwInUnknownProtos : LongInt;
61 dwOutOctets : LongInt;
62 dwOutUcastPkts : LongInt;
63 dwOutNUcastPkts : LongInt;
64 dwOutDiscards : LongInt;
65 dwOutErrors : LongInt;
66 dwOutQLen : LongInt;
67 dwDescrLen : LongInt;
68 bDescr : Array[0 .. (MAXLEN_IFDESCR - 1)] of Char;
69 end;
70
71function Get_EthernetAddresses: TStringList;
72function GetNetworkAdapterList: TNetworkInterfaceList;
73Function GetIfTable( pIfTable : Pointer; var pdwSize : LongInt; bOrder : LongInt ): LongInt; stdcall;
74procedure DisplayIfConf;
75
76
77implementation
78
79Function GetIfTable; stdcall; external 'IPHLPAPI.DLL';
80
81function Get_EthernetAddresses: TStringList;
82const
83 _MAX_ROWS_ = 20;
84type
85 _IfTable = record
86 nRows : LongInt;
87 ifRow : Array[1.._MAX_ROWS_] of MIB_IFROW;
88 end;
89var
90 pIfTable : ^_IfTable;
91 TableSize : LongInt;
92 tmp : String;
93 i,j : Integer;
94 ErrCode : LongInt;
95begin
96 pIfTable := nil;
97 //------------------------------------------------------------
98 Result := TStringList.Create;
99 if Assigned(Result) then
100 try
101 //-------------------------------------------------------
102 // First: just get the buffer size.
103 // TableSize returns the size needed.
104 TableSize:=0; // Set to zero so the GetIfTabel function
105 // won't try to fill the buffer yet,
106 // but only return the actual size it needs.
107 GetIfTable(pIfTable, TableSize, 1);
108 if (TableSize < SizeOf(MIB_IFROW)+Sizeof(LongInt)) then
109 begin
110 Exit; // less than 1 table entry?!
111 end; // if-end.
112
113 // Second:
114 // allocate memory for the buffer and retrieve the
115 // entire table.
116 GetMem(pIfTable, TableSize);
117 ErrCode := GetIfTable(pIfTable, TableSize, 1);
118 if ErrCode<>ERROR_SUCCESS then
119 begin
120 Exit; // OK, that did not work.
121 // Not enough memory i guess.
122 end; // if-end.
123
124 // Read the ETHERNET addresses.
125 for i := 1 to pIfTable^.nRows do
126 try
127 if pIfTable^.ifRow[i].dwType=MIB_IF_TYPE_ETHERNET then
128 begin
129 tmp:='';
130 for j:=0 to pIfTable^.ifRow[i].dwPhysAddrLen-1 do
131 begin
132 tmp := tmp + format('%.2x',
133 [ pIfTable^.ifRow[i].bPhysAddr[j] ] );
134 end; // for-end.
135 //-------------------------------------
136 if Length(tmp)>0 then Result.Add(tmp);
137 end; // if-end.
138 except
139 Exit;
140 end; // if-try-except-end.
141 finally
142 if Assigned(pIfTable) then FreeMem(pIfTable,TableSize);
143 end; // if-try-finally-end.
144end;
145
146function GetNetworkAdapterList: TNetworkInterfaceList;
147const
148 _MAX_ROWS_ = 20;
149type
150 _IfTable = record
151 nRows : LongInt;
152 ifRow : Array[1.._MAX_ROWS_] of MIB_IFROW;
153 end;
154var
155 pIfTable : ^_IfTable;
156 TableSize : LongInt;
157 tmp : String;
158 i,j : Integer;
159 ErrCode : LongInt;
160begin
161 pIfTable := nil;
162 //if Assigned(Result) then
163 try
164 //-------------------------------------------------------
165 // First: just get the buffer size.
166 // TableSize returns the size needed.
167 TableSize := 0; // Set to zero so the GetIfTabel function
168 // won't try to fill the buffer yet,
169 // but only return the actual size it needs.
170 GetIfTable(pIfTable, TableSize, 1);
171 if (TableSize < SizeOf(MIB_IFROW)+Sizeof(LongInt)) then
172 begin
173 Exit; // less than 1 table entry?!
174 end; // if-end.
175
176 // Second:
177 // allocate memory for the buffer and retrieve the
178 // entire table.
179 GetMem(pIfTable, TableSize);
180 ErrCode := GetIfTable(pIfTable, TableSize, 1);
181 if ErrCode<>ERROR_SUCCESS then begin
182 Exit; // OK, that did not work.
183 // Not enough memory i guess.
184 end; // if-end.
185
186 // Read the ETHERNET addresses.
187 SetLength(Result, 0);
188 for i := 1 to pIfTable^.nRows do with pIfTable^.ifRow[i] do begin
189 try
190 if (pIfTable^.ifRow[i].dwOperStatus = MIB_IF_OPER_STATUS_OPERATIONAL) and
191 (pIfTable^.ifRow[i].dwType=MIB_IF_TYPE_ETHERNET) then
192 begin
193 SetLength(Result, Length(Result) + 1);
194 with Result[High(Result)] do begin
195 SetLength(DeviceName, dwDescrLen);
196 Move(bDescr[0], DeviceName[1], dwDescrLen);
197 Name := DeviceName;
198 IPAddress := '192.168.0.3';
199 BroadcastIPAddress := '192.168.0.255';
200 BroadcastIPAddress := '255.255.255.0';
201// IPAddress := '127.0.0.1';
202// BroadcastIPAddress := '255.0.0.0';
203 end;
204
205{ tmp := '';
206 for j:=0 to pIfTable^.ifRow[i].dwPhysAddrLen-1 do
207 begin
208 tmp := tmp + format('%.2x',
209 [ pIfTable^.ifRow[i].bPhysAddr[j] ] );
210 end; // for-end.
211 //-------------------------------------
212 if Length(tmp)>0 then Result.Add(tmp);
213} end; // if-end.
214 except
215 Exit;
216 end; // if-try-except-end.
217; end;
218 finally
219 if Assigned(pIfTable) then FreeMem(pIfTable,TableSize);
220 end; // if-try-finally-end.
221end;
222
223procedure DisplayIfConf;
224type
225 DWORD = Cardinal;
226var
227 AdapterInfo : array of IP_ADAPTER_INFO;
228 pAdapterInfo : PIP_ADAPTER_INFO;
229 BufSize : DWORD;
230 Status : DWORD;
231 I : Integer;
232 Buf : String;
233 DisplayMemo: TMemo;
234const
235 BooleanToStr : array [Boolean] of String = ('FALSE', 'TRUE');
236procedure Display(Text: string);
237begin
238 ShowMessage(Text);
239end;
240 function IpListToStr(pIpAddr : PIP_ADDR_STRING) : String;
241 begin
242 Result := '';
243 repeat
244 Result := Result + ', ' + Pchar(Addr(pIpAddr^.IpAddress));
245 pIpAddr := pIpAddr.Next;
246 until pIpAddr = nil;
247 Delete(Result, 1, 2);
248 if Result = '' then Result := 'none';
249 end;
250begin
251// DisplayMemo.Clear;
252 BufSize := SizeOf(AdapterInfo);
253// pAdapterInfo := ;
254 Status := GetAdaptersInfo(@AdapterInfo[0], BufSize);
255 SetLength(AdapterInfo, BufSize div SizeOf(IP_ADAPTER_INFO));
256
257 Status := GetAdaptersInfo(@AdapterInfo[0], BufSize);
258 if Status <> ERROR_SUCCESS then begin
259 case Status of
260 ERROR_NOT_SUPPORTED :
261 Display('GetAdaptersInfo is not supported by the operating ' +
262 'system running on the local computer.');
263 ERROR_NO_DATA :
264 Display('No network adapter on the local computer.');
265 else
266 Display('GetAdaptersInfo failed with error #' +
267IntToStr(Status));
268 end;
269 Exit;
270 end;
271 repeat
272 Display('Description: ' + pAdapterInfo^.Description);
273 Display('Name: ' + pAdapterInfo^.AdapterName);
274
275 Buf := '';
276 for I := 0 to pAdapterInfo^.AddressLength - 1 do
277 Buf := Buf + '-' + IntToHex(pAdapterInfo^.Address[I], 2);
278 Delete(Buf, 1, 1);
279 Display('MAC address: ' + Buf);
280
281 Display('IP address: ' +
282IpListToStr(@pAdapterInfo^.IpAddressList));
283 Display('Gateway: ' +
284IpListToStr(@pAdapterInfo^.GatewayList));
285 DIsplay('DHCP enabled: ' + BooleanToStr[pAdapterInfo^.DhcpEnabled
286<> 0]);
287 Display('DHCP: ' + IpListToStr(@pAdapterInfo^.DhcpServer));
288 DIsplay('Have WINS: ' + BooleanToStr[pAdapterInfo^.HaveWins]);
289 Display('Primary WINS: ' +
290IpListToStr(@pAdapterInfo^.PrimaryWinsServer));
291 Display('Secondary WINS: ' +
292IpListToStr(@pAdapterInfo^.SecondaryWinsServer));
293
294 pAdapterInfo := pAdapterInfo^.Next;
295 until pAdapterInfo = nil;
296 Display('Done.');
297end;
298
299end.
300
301
302
303
304
305
Note: See TracBrowser for help on using the repository browser.