【delphi开源代码栏目提醒】：网学会员为广大网友收集整理了，frm_ChangDNS.pas，希望对大家有所帮助！

    unit frm_ChangDNS;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs,Registry, StdCtrls, XPMan, ExtCtrls;
    
    type
      TFrmChangDns = class(TForm)
        BtnChange: TButton;
        BtnClose: TButton;
        GroupBox1: TGroupBox;
        EdDNS: TEdit;
        LblDns: TLabel;
        XPManifest1: TXPManifest;
        RGCardList: TRadioGroup;
        procedure FormShow(Sender: TObject);
        procedure BtnChangeClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure RGCardListClick(Sender: TObject);
        procedure BtnCloseClick(Sender: TObject);
      private
        CardIdLt:TStrings;
        procedure SaveString(sKey, sItem, sVal : string );
        Function GetWinVersion:integer;
        procedure SetDNSAddresses( sIPs : string );
        function getDNS:string;
        procedure setDNSAddr(const IPaddr:string);
        function GetDNSAddr:string;
        Procedure GetCard;
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      FrmChangDns: TFrmChangDns;
    
    implementation
    
    {$R *.dfm}
    Function TFrmChangDns.GetWinVersion:integer;
    var
      version:TOSVersionInfo;
    begin
    //result 0 is WinNT
    //result 1 is Windows 98
      result:=-1;
      Version.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
      Getversionex(version);
      case  Version.dwPlatformId  of
      VER_PLATFORM_WIN32_NT:
        begin
          result:=0;
        end;
      VER_PLATFORM_WIN32_WINDOWS:
        begin
          result:=1;
        end;
      end;
    end;
    
    
    procedure TFrmChangDns.SetDNSAddresses( sIPs : string );
    begin
      if GetWinVersion =  0 then
        setDNSAddr(sIPs)
      else if GetWinVersion =  1 then
        SaveString('SYSTEM\CurrentControlSet\Services\VxD\MSTCP','NameServer',sIPs);
    end;
    
    
    procedure TFrmChangDns.setDNSAddr(const IPaddr:string);
    var
      reg:TRegistry;
      name:array [0..255] of char;
      ID,CardNum:string;
    begin
      reg:=TRegistry.Create;
      StrLcopy(name,pchar(IPaddr),length(IPaddr));
      reg.RootKey:=HKEY_LOCAL_MACHINE;
      ID:=RGcardList.Items.Strings[RGCardList.itemindex];
      cardNum:=copy(ID,pos(';',ID)+1,length(ID));
      reg.CloseKey;
      if length(CardNum) < 2 then
        CardNum:='00'+CardNum;
      if LengTh(CardNum) < 3 then
        CardNum:='0'+CardNum;
      reg.OpenKey('SYSTEM\ControlSet'+CardNum+'\Services',false);
      reg.OpenKey('Tcpip\Parameters\Interfaces',false);
      ID:=CardIdLt.Strings[CardIDLt.IndexOf(ID)+1];
      reg.OpenKey(id,false);
      RegSetValueEx(reg.CurrentKey,'NameServer',0,REG_SZ,@name,13);
      Reg.CloseKey;
      reg.Free;
    end;
    
    Procedure TFrmChangDns.GetCard;
    var
      reg:TRegistry;
      i:integer;
      name:array [0..255] of char;
      ID:string;
      lS:TStrings;
    begin
      ls:=TStringlist.Create;
      reg:=TRegistry.Create;
      name:='';
      reg.RootKey:=HKEY_LOCAL_MACHINE;
      ID:='SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards\';
      reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards',false);
      Reg.GetKeyNames(Ls);
      for i:=0 to Ls.Count-1 do
      begin
        reg.CloseKey;
        reg.OpenKey(id+ls.Strings[i],false);
        RGCardList.Items.Add(reg.ReadString('Description')+';'+inttostr(i+1));
        CardIdLt.Add(reg.ReadString('Description')+';'+inttostr(i+1));
        CardIdLt.Add(reg.ReadString('ServiceName'));
      end;
      RGCardList.ItemIndex:=0;
      ls.Free;
      reg.Free;
    end;
    
    function TFrmChangDns.GetDNSAddr:string;
    var
      reg:TRegistry;
      name:array [0..255] of char;
      ID,CardNum:string;
      Psize:Dword;
    begin
      reg:=TRegistry.Create;
      name:='';
      reg.RootKey:=HKEY_LOCAL_MACHINE;
      ID:=RGcardList.Items.Strings[RGCardList.itemindex];
      cardNum:=copy(ID,pos(';',ID)+1,length(ID));
      reg.CloseKey;
      if length(CardNum) < 2 then
        CardNum:='00'+CardNum;
      if LengTh(CardNum) < 3 then
        CardNum:='0'+CardNum;
      reg.OpenKey('SYSTEM\ControlSet'+CardNum+'\Services',false);
      reg.OpenKey('Tcpip\Parameters\Interfaces',false);
      ID:=CardIdLt.Strings[CardIDLt.IndexOf(ID)+1];
      reg.OpenKey(id,false);
      RegqueryValueEx(reg.CurrentKey,'NameServer',nil,nil,@name,@Psize);
      result:=copy(name,0,strlen(name));
      Reg.CloseKey;
      reg.Free;
    end;
    
    function TFrmChangDns.getDNS:string;
    var
      reg : TRegistry;
    begin
      reg := TRegistry.Create;
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if GetWinVersion =  0 then
      begin
         result:=GetDNSAddr;
      end
      else if GetWinVersion =  1 then
        begin
          reg.OpenKey('SYSTEM\CurrentControlSet\Services\VxD\MSTCP',false);
          result:=reg.ReadString('NameServer');
        end;
      reg.Free;
    end;
    
    procedure TFrmChangDns.SaveString(sKey, sItem, sVal : string );
    var
      reg :  TRegistry;
    begin
      reg := TRegistry.Create;