uses Registry; 
 
type 
  pIPADR = ^IPADR; 
  IPADR = packed record 
    Next: pIPADR; 
    IpAddress, IpMask: array[1..16] of Char; 
    Context: Cardinal; 
  end; 
  pAdapterInfo = ^AdapterInfo; 
  AdapterInfo = packed record 
    Next: pAdapterInfo; 
    ComboIndex: Cardinal; 
    AdapterName, Description: array[1..MAX_PATH] of Char; 
    AddressLength: LongWord; 
    Address: array[1..8] of Byte; 
    Index: Cardinal; 
    dwType, DhcpEnabled: LongWord; 
    CurrentIpAddress, IpAddressList, GatewayList, DhcpServer: IPADR; 
    HaveWins: Boolean; 
    PrimaryWinsServer, SecondaryWinsServer: IPADR; 
    LeaseObtained, LeaseExpires: int64; 
  end; 
 
function GetAdaptersInfo(const pAdapterInfo: pAdapterInfo; const 
  pOutBufLen: PULONG): Cardinal; stdcall; external 'IPHLPAPI.DLL'; 
 
var 
  value: array[0..3] of string = 
  ('DefaultGateway', 'IPAddress', 'SubnetMask', 'NameServer'); 
  nam: array[0..4] of string = 
  ('Gateway:    ', 'IP-Adresse: ', 'Sub-Netz:   ', 
    'DNS:        ', 'DHCP:       '); 
 
procedure Info(s: string; sl: TStrings); 
const 
  EDHCP = 'EnableDHCP'; 
  DHCP = 'Dhcp'; 
  KEY = '\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\'; 
var 
  Reg: TRegistry; 
  i, x: integer; 
  buff: array[0..99] of char; 
begin 
  i := 0; 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_LOCAL_MACHINE; 
    if Reg.OpenKey(key + s, false) 
      then begin 
      if Reg.Valueexists(EDHCP) then i := Reg.readinteger(EDHCP); 
      if i > 0 then begin 
        sl.add(nam[4] + 'Ja'); 
        if Reg.Valueexists(dhcp + value[0]) then begin 
          Reg.ReadBinaryData(dhcp + value[0], buff, sizeof(buff)); 
          sl.add(nam[0] + PChar(@buff)); 
        end; 
        for x := 1 to 3 do begin 
          if Reg.Valueexists(dhcp + value[x]) then 
            sl.add(nam[x] + Reg.Readstring(dhcp + value[x])); 
        end; 
      end else begin 
        sl.add(nam[4] + 'Nein'); 
        for x := 0 to 2 do begin 
          if Reg.Valueexists(value[x]) then 
            Reg.ReadBinaryData(value[x], buff, sizeof(buff)); 
          sl.add(nam[x] + PChar(@buff)); 
        end; 
        if Reg.Valueexists(value[3]) then 
          sl.add(nam[3] + stringreplace(Reg.Readstring(value[3]), ',', 
            #32#32#32, [rfReplaceAll])); 
      end; 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
procedure adapter(sl: TStrings); 
var 
  len, reslt: Cardinal; 
  pWrk, pLst: pAdapterInfo; 
  s: string; 
begin 
  len := 0; 
  sl.clear; 
  pLst := nil; 
  reslt := GetAdaptersInfo(pLst, @len); 
  if reslt = ERROR_BUFFER_OVERFLOW then 
  begin 
    pLst := AllocMem(len); 
    try 
      reslt := GetAdaptersInfo(pLst, @len); 
      if reslt = ERROR_SUCCESS then 
      begin 
        pWrk := pLst; 
        repeat 
          sl.add(trim(pWrk.Description)); 
          s := trim(pWrk.AdapterName); 
          Info(s, sl); 
          sl.add(stringofchar('-', 50)); 
          pWrk := pWrk.Next; 
        until pWrk = nil; 
      end; 
    finally 
      FreeMem(pLst, len); 
    end; 
  end; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  with Listbox1 do begin 
    Font.Name := 'Courier New'; // feste Breite 
    Font.Size := 10; 
    adapter(Items); 
  end; 
end;