Delphi World - Извлечь адреса сетевых карт
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Извлечь адреса сетевых карт

Оформил: 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;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования