Tips (1541)

Tip Bewertung (7):

{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;