Хотелось автоматизировать Импорт в реестр ключа MTU в ветке HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\{.........}, понятное дело что запуском *.reg файла не обойдешся.
ВОТ код, правда сыроват, может кто поможет, своим профессиональным советом. Проверено на компьютерах с одной сетевой картой и одним IP адресом
ВОТ код, правда сыроват, может кто поможет, своим профессиональным советом. Проверено на компьютерах с одной сетевой картой и одним IP адресом
Код:
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.