Извлечь адреса сетевых карт
Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch
{for NT4 and Windows 2000, and you must have Admin privileges}
{fьr NT4 und Windows 2000, und Adminrechte erforderlich}
uses
Registry;
const
nString = 'SOFTWARE\MICROSOFT\WINDOWS NT\CURRENTVERSION\NetworkCards';
nEthernet = 'Ethernet';
nEtherjet = 'Etherjet'; {if Hardware IBM PL300 with Chip 10/100}
nTcpIp1 = 'SYSTEM\CurrentControlSet\Services\';
nTcpIp2 = '\Parameters\Tcpip';
var
reg: TRegistry;
buffer1, buffer2, buffer3: array [1..32] of Char;
i: Integer;
ipaddress, subnetmask, DefaultGateway: string;
Adapter, Adapter_Key: string;
stringlist: TStrings;
function search_adapter_key: string;
var
astring, description, st: string;
nPos: integer;
ServiceName: string;
begin
reg := TRegistry.Create;
stringlist := TStringList.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey(nString, False);
reg.GetKeyNames(stringlist); {search all subkeys
such alle unterschlьssel}
reg.CloseKey;
for i := 0 to (stringlist.Count - 1) do
begin
st := stringlist[i];
aString := nString + '\' + st;
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey(aString, False);
description := reg.ReadString('Description');
nPos:= AnsiPos(nEthernet, description); {search description for string Ethernet
Beschreibung nach dem string Ethernet absuchen}
if nPos > 0 then
begin
ServiceName := reg.ReadString('ServiceName');
Adapter_Key := nTcpIp1 + ServiceName + nTcpIp2;
end;
nPos := AnsiPos(nEtherjet, description); {search description for string 'Etherjet
if IBM PL300 with MotherboardChip}
if nPos > 0 then
begin
ServiceName := reg.ReadString('ServiceName');
Adapter_Key := nTcpIp1 + ServiceName + nTcpIp2;
end;
reg.CloseKey;
end;
Result := Adapter_Key;
end;
procedure search_for_adapter_NT;
var
BufSize: Integer; {Bufsize requested but not used
Bufsize erforderlich aber nicht benutzt}
begin
adapter := search_adapter_key;
if adapter <> '' then
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(adapter, False);
Reg.ReadBinaryData('IpAddress', buffer1, BufSize);
finally
Reg.CloseKey;
Reg.Free;
end;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(adapter, False);
Reg.ReadBinaryData('SubnetMask', buffer2, BufSize);
finally
Reg.CloseKey;
Reg.Free;
end;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey(adapter, False);
Reg.ReadBinaryData('DefaultGateway', buffer3, BufSize);
finally
Reg.CloseKey;
Reg.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
search_for_adapter_NT;
Memo1.Lines.Add(buffer1);
Memo1.Lines.Add(buffer2);
Memo1.Lines.Add(buffer3);
end;
|