Импорт в реестр ключа MTU

Razgildai

Member
Joined
Aug 12, 2005
Messages
7
Reaction score
0
Age
41
Location
Беларусь
Хотелось автоматизировать Импорт в реестр ключа MTU в ветке HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\{.........}, понятное дело что запуском *.reg файла не обойдешся.
ВОТ код, правда сыроват, может кто поможет, своим профессиональным советом. Проверено на компьютерах с одной сетевой картой и одним IP адресом
Code:
unit MTU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, StdCtrls, WinSock;

type
  TForm1 = class(TForm)
    Button1: TButton;
    SubKeys: TMemo;
    LocalIP: TMemo;
    RegIP: TMemo;
    Memo1: TMemo;
    Button2: TButton;
    ChangeMTU: TCheckBox;
    ValueMTU: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure EnumAllKeys(hkey: THandle);
    procedure Button2Click(Sender: TObject);
    procedure ChangeMTUClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var

  Form1: TForm1;
  function GetLocalIP: String;

implementation

{$R *.dfm}

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string;
   Strings: TStrings);
 var
   valueType: DWORD;
   valueLen: DWORD;
   p, buffer: PChar;
   key: HKEY;
 begin
  Strings.Clear; // Clear TStrings
  if RegOpenKeyEx(CurrentKey,                     // open the specified key
                   PChar(Subkey),
                   0, KEY_READ, key) = ERROR_SUCCESS then
   begin
     // retrieve the type and data for a specified value name
    SetLastError(RegQueryValueEx(key,
                  PChar(ValueName),
                  nil,
                  @valueType,
                  nil,
                  @valueLen));
     if GetLastError = ERROR_SUCCESS then
       if valueType = REG_MULTI_SZ then
       begin
         GetMem(buffer, valueLen);
         try
           // receive the value's data (in an array). 
          RegQueryValueEx(key,
                           PChar(ValueName),
                           nil,
                           nil,
                           PBYTE(buffer),
                           @valueLen);
           // Add values to stringlist
          p := buffer;
           while p^ <> #0 do
           begin
             Strings.Add(p);
             Inc(p, lstrlen(p) + 1)
           end
         finally
           FreeMem(buffer)
         end
       end
       else
         raise ERegistryException.Create('Stringlist expectedt...')
     else
       raise ERegistryException.Create('Cannot Read MULTI_SZ Value...');
   end;
 end;


procedure TForm1.EnumAllKeys(hkey: THandle);
    var
     l: TStringList;
     n: Integer;
   begin
     with TRegistry.Create do
       try
         RootKey := hkey;
         OpenKey('SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces', False);
         l := TStringList.Create;
         try
           GetKeynames(l);
           CloseKey;
           for n := 0 to l.Count - 1 do
           begin
             SubKeys.Lines.Add(l[n]);
             if OpenKey(l[n], False) then
             begin
               EnumAllKeys(CurrentKey);
               CloseKey;
             end;
           end;
         finally
           l.Free
         end;
       finally
         Free;
       end;
   end;

function GetLocalIP: String;
      const WSVer = $101;
     var
        wsaData: TWSAData;
        P: PHostEnt;
        Buf: array [0..127] of Char;
   begin
      Result := '';
       if WSAStartup(WSVer, wsaData) = 0 then
       begin
          if GetHostName(@Buf, 128) = 0 then
          begin
             P := GetHostByName(@Buf);
              if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
          end;
    WSACleanup;
       end;
   end;
Function ReadDHCP(const CurrentKey: HKey; const Subkey, ValueName: string):String;
 var
  DHCPIP:TRegistry;
  enableDHCP :integer;
   begin
   DHCPIP:=TRegistry.Create;
   DHCPIP.RootKey:=CurrentKey;
   DHCPIP.OpenKey(Subkey,false);
   enableDHCP:=DHCPIP.ReadInteger('EnableDHCP');
   if enableDHCP=1 then Result:=DHCPIP.ReadString('DhcpIPAddress')
                   else Result:='0.0.0.0';
   DHCPIP.Free;
   end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i : byte;
 str : string;
 TargetKey : byte;
 AddKey:TRegistry;
 begin
   RegIP.Clear;
   SubKeys.Clear;
   LocalIP.Clear;
   SubKeys.Lines.BeginUpdate;
   LocalIP.Lines.BeginUpdate;
   try
     EnumAllKEys(HKEY_LOCAL_MACHINE);
     LocalIP.Lines.Add(GetLocalIP);
   finally
     SubKeys.Lines.EndUpdate;
     LocalIP.Lines.EndUpdate;
   end;
  str:='SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\';
  For i:=0 to  SubKeys.Lines.Count-1 do
  begin
    Memo1.Clear;
    ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE,str+(SubKeys.Lines[i]), 'IPAddress', Memo1.Lines);
    if Pos('0.0.0.0',Memo1.Lines[0])<>0 then
    begin
     Memo1.Clear;
     Memo1.Lines.Add(ReadDHCP(HKEY_LOCAL_MACHINE,str+(SubKeys.Lines[i]), 'DhcpIPAddress'));
    end;
    RegIP.Lines.Add(Memo1.Lines[0]);
  end;
  for i:=0 to RegIP.Lines.Count-1 do
   if pos(LocalIP.Lines[0],RegIP.Lines[i])<>0 then TargetKey:=i;
   ShowMessage('Target '+SubKeys.Lines[TargetKey]);
 if ChangeMTU.Checked = True then
  begin
   AddKey:=TRegistry.Create;
   AddKey.RootKey:=HKEY_LOCAL_MACHINE;
   AddKey.OpenKey(str+SubKeys.Lines[TargetKey],false);
   AddKey.WriteInteger('MTU',StrToInt(ValueMTU.Text));
   AddKey.Free;
  end;
 end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Halt(1);
end;

procedure TForm1.ChangeMTUClick(Sender: TObject);
 begin
    if ChangeMTU.Checked then
     begin
      ValueMTU.Enabled:=True;
      ValueMTU.SetFocus
     end else
          begin
           ValueMTU.Enabled:=False;
           ValueMTU.Text:=''
          end  
end;

end.
 

Razgildai

Member
Joined
Aug 12, 2005
Messages
7
Reaction score
0
Age
41
Location
Беларусь
van4ello, я имел ввиду оптимизацию кода программы. А Halt - это по старой привычки из TurboPascal
 
Last edited by a moderator:

van4ello

Member
Joined
Nov 12, 2005
Messages
69
Reaction score
14
Location
ukraine
Понял,тебе бы надо добавить еще парочку конструкций try в места где ты работешь с реестром,а также лучше вынести в отдельную процедуру некоторые куски кода!например тоже чтение и запись кода в реестр.
 

N3tM4n

Member
Joined
Oct 10, 2005
Messages
11
Reaction score
1
Location
localhost
AddKey.WriteInteger('MTU',StrToInt(ValueMTU.Text));
AddKey.CloseKey; // <== нужна эта строчка кода для сохранения изменения реестра
AddKey.Free;
 
Top