delphi修改电脑IP
来源：互联网 发布：学php需要什么基础 编辑：程序博客网 时间：2024/05/04 02:00
用 WinExec或ShellExecute 执行 DOS命令 netsh ，可以修改。也或者修改注冊表，不知是否可行?
主持人注：netsh是Win2k的一个命令行程序，可以用来动态设置IP地址。如：
netsh -c interface ip add address "本地连接" 192.168.1.105 255.255.255.0
关于该命令的更多信息请参考：http://www.yesky.com/20030410/1662582.shtml
修改注册表的方法只能修改DNS，可以立即生效。如果修改IP地址，则需要重新启动系统后才能生效。所以，目前找到的办法恐怕只有在dos环境下运行netsh命令了。这里是编写好的程序
LHAIPSet.rar。
注册表类型全操作
unit MiniReg;
{
---------------------------------------------------------------------------------------------------
Function Examples:
procedure TForm1.Button1Click(Sender: TObject);
var
ba1, ba2: array of byte;
n: integer;
s: String;
d: Cardinal;
begin
setlength(ba1, 10);
for n := 0 to 9 do ba1[n] := byte(n);
RegSetString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestString', 'TestMe');
RegSetExpandString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestExpandString', '%SystemRoot%/Test');
RegSetMultiString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', 'String1'#0'String2'#0'String3');
RegSetDword(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestDword', 7);
RegSetBinary(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestBinary', ba1);
To set the default value for a key, end the key name with a '/':
RegSetString(HKEY_CURRENT_USER, 'Software/My Company/Test/', 'Default Value');
RegGetString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestString', s);
RegGetMultiString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', s);
RegGetExpandString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestExpandString', s);
RegGetAnyString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', s, StringType);
RegSetAnyString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', s, StringType);
RegGetDWORD(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestDword', d);
RegGetBinary(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestBinary', s);
SetLength(ba2, Length(s));
for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);
Button1.Caption := IntToStr(Length(ba2));
if RegKeyExists(HKEY_CURRENT_USER, 'Software/My Company/Test/foo') then
if RegValueExists(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestBinary') then
MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);
RegDelValue(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestString');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company/Test/foo');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company/Test');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company');
if RegEnumKeys(HKEY_CURRENT_USER, 'Software/My Company', s) then
ListBox1.Text := s;
if RegEnumValues(HKEY_CURRENT_USER, 'Software/My Company', s) then
ListBox1.Text := s;
if RegConnect('//server1', HKEY_LOCAL_MACHINE, RemoteKey) then
begin
RegGetString(RemoteKey, 'Software/My Company/Test/foo/bar/TestString', s);
RegDisconnect(RemoteKey);
end;
end;
---------------------------------------------------------------------------------------------------
}
interface
uses Windows;
function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;
function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;
function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
function RegValueExists(RootKey: HKEY; Name: String): boolean;
function RegKeyExists(RootKey: HKEY; Name: String): boolean;
function RegDelValue(RootKey: HKEY; Name: String): boolean;
function RegDelKey(RootKey: HKEY; Name: String): boolean;
function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;
function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
function RegDisconnect(RemoteKey: HKEY): boolean;
function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
implementation
function LastPos(Needle: Char; Haystack: String): integer;
begin
for Result := Length(Haystack) downto 1 do
if Haystack[Result] = Needle then
Break;
end;
function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
begin
Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);
end;
function RegDisconnect(RemoteKey: HKEY): boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;
function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;
var
SubKey: String;
n: integer;
dispo: DWORD;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, hTemp, @dispo) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if SubKey = '' then
Result := (RegSetValueEx(hTemp, nil, 0, ValType, PVal, ValSize) = ERROR_SUCCESS)
else
Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;
var
SubKey: String;
n: integer;
MyValType: DWORD;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
PKey: PChar;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if SubKey = '' then
PKey := nil
else
PKey := PChar(SubKey);
if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
begin
GetMem(Buf, BufSize);
if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
begin
if ValType = MyValType then
begin
PVal := Buf;
ValSize := BufSize;
Result := True;
end else
begin
FreeMem(Buf);
end;
end else
begin
FreeMem(Buf);
end;
end;
RegCloseKey(hTemp);
end;
end;
end;
function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;
begin
case ValueType of
REG_SZ, REG_EXPAND_SZ:
Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0), Length(Value) + 1);
Reg_MULTI_SZ:
Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0#0), Length(Value) + 2);
else
Result := False;
end;
end;
function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);
end;
function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);
end;
function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);
end;
function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
end;
function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));
end;
function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
bOK: Boolean;
begin
Result := False;
Value := '';
if RegGetValueType(Rootkey, Name, ValueType) then
begin
case ValueType of
REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:
bOK := RegGetValue(RootKey, Name, ValueType, Buf, BufSize);
else
bOK := False;
end;
if bOK then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
end;
function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := 0;
if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
begin
Value := PDWord(Buf)^;
FreeMem(Buf);
Result := True;
end;
end;
function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
begin
SetLength(Value, BufSize);
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegValueExists(RootKey: HKEY; Name: String): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
ValType: Cardinal;
begin
Result := False;
Value := REG_NONE;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if SubKey = '' then
Result := (RegQueryValueEx(hTemp, nil, nil, @ValType, nil, nil) = ERROR_SUCCESS)
else
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);
if Result then
Value := ValType;
RegCloseKey(hTemp);
end;
end;
end;
function RegKeyExists(RootKey: HKEY; Name: String): boolean;
var
hTemp: HKEY;
begin
Result := False;
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
Result := True;
RegCloseKey(hTemp);
end;
end;
function RegDelValue(RootKey: HKEY; Name: String): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegDelKey(RootKey: HKEY; Name: String): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;
const
MaxBufSize: Cardinal = 1024;
var
iRes: integer;
hTemp: HKEY;
Buf: String;
BufSize: Cardinal;
begin
Result := False;
// no root keys...
if pos('/', Name) <> 0 then
begin
iRes := RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_ENUMERATE_SUB_KEYS or KEY_WRITE, hTemp);
if WithSubKeys then
begin
while iRes = ERROR_SUCCESS do
begin
BufSize := MaxBufSize;
SetLength(Buf, BufSize);
iRes := RegEnumKeyEx(hTemp, 0, @Buf[1], BufSize, nil, nil, nil, nil);
if iRes = ERROR_NO_MORE_ITEMS then
begin
RegCloseKey(hTemp);
Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);
end else
begin
if iRes = ERROR_SUCCESS then
begin
SetLength(Buf, BufSize);
if RegDelKeyEx(RootKey, Concat(Name, '/', Buf), WithSubKeys) then
iRes := ERROR_SUCCESS
else
iRES := ERROR_BADKEY;
end;
end;
end;
end else
begin
RegCloseKey(hTemp);
Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);
end;
end;
end;
function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;
var
i: integer;
iRes: integer;
s: String;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
ResultList := '';
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
Result := True;
BufSize := 1024;
GetMem(buf, BufSize);
i := 0;
iRes := ERROR_SUCCESS;
while iRes = ERROR_SUCCESS do
begin
BufSize := 1024;
if DoKeys then
iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
else
iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
if iRes = ERROR_SUCCESS then
begin
SetLength(s, BufSize);
Move(buf^, s[1], BufSize);
if ResultList = '' then
ResultList := s
else
ResultList := Concat(ResultList, #13#10, s);
inc(i);
end;
end;
FreeMem(buf);
RegCloseKey(hTemp);
end;
end;
function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
begin
Result := RegEnum(RootKey, Name, ValueList, False);
end;
function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
begin
Result := RegEnum(RootKey, Name, KeyList, True);
end;
end.
主持人注：netsh是Win2k的一个命令行程序，可以用来动态设置IP地址。如：
netsh -c interface ip add address "本地连接" 192.168.1.105 255.255.255.0
关于该命令的更多信息请参考：http://www.yesky.com/20030410/1662582.shtml
修改注册表的方法只能修改DNS，可以立即生效。如果修改IP地址，则需要重新启动系统后才能生效。所以，目前找到的办法恐怕只有在dos环境下运行netsh命令了。这里是编写好的程序
LHAIPSet.rar。 注册表类型全操作
unit MiniReg;
{
---------------------------------------------------------------------------------------------------
Function Examples:
procedure TForm1.Button1Click(Sender: TObject);
var
ba1, ba2: array of byte;
n: integer;
s: String;
d: Cardinal;
begin
setlength(ba1, 10);
for n := 0 to 9 do ba1[n] := byte(n);
RegSetString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestString', 'TestMe');
RegSetExpandString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestExpandString', '%SystemRoot%/Test');
RegSetMultiString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', 'String1'#0'String2'#0'String3');
RegSetDword(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestDword', 7);
RegSetBinary(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestBinary', ba1);
To set the default value for a key, end the key name with a '/':
RegSetString(HKEY_CURRENT_USER, 'Software/My Company/Test/', 'Default Value');
RegGetString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestString', s);
RegGetMultiString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', s);
RegGetExpandString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestExpandString', s);
RegGetAnyString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', s, StringType);
RegSetAnyString(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestMultiString', s, StringType);
RegGetDWORD(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestDword', d);
RegGetBinary(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestBinary', s);
SetLength(ba2, Length(s));
for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);
Button1.Caption := IntToStr(Length(ba2));
if RegKeyExists(HKEY_CURRENT_USER, 'Software/My Company/Test/foo') then
if RegValueExists(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestBinary') then
MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);
RegDelValue(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar/TestString');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company/Test/foo/bar');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company/Test/foo');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company/Test');
RegDelKey(HKEY_CURRENT_USER, 'Software/My Company');
if RegEnumKeys(HKEY_CURRENT_USER, 'Software/My Company', s) then
ListBox1.Text := s;
if RegEnumValues(HKEY_CURRENT_USER, 'Software/My Company', s) then
ListBox1.Text := s;
if RegConnect('//server1', HKEY_LOCAL_MACHINE, RemoteKey) then
begin
RegGetString(RemoteKey, 'Software/My Company/Test/foo/bar/TestString', s);
RegDisconnect(RemoteKey);
end;
end;
---------------------------------------------------------------------------------------------------
}
interface
uses Windows;
function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;
function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;
function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
function RegValueExists(RootKey: HKEY; Name: String): boolean;
function RegKeyExists(RootKey: HKEY; Name: String): boolean;
function RegDelValue(RootKey: HKEY; Name: String): boolean;
function RegDelKey(RootKey: HKEY; Name: String): boolean;
function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;
function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
function RegDisconnect(RemoteKey: HKEY): boolean;
function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
implementation
function LastPos(Needle: Char; Haystack: String): integer;
begin
for Result := Length(Haystack) downto 1 do
if Haystack[Result] = Needle then
Break;
end;
function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
begin
Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);
end;
function RegDisconnect(RemoteKey: HKEY): boolean;
begin
Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end;
function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;
var
SubKey: String;
n: integer;
dispo: DWORD;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, hTemp, @dispo) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if SubKey = '' then
Result := (RegSetValueEx(hTemp, nil, 0, ValType, PVal, ValSize) = ERROR_SUCCESS)
else
Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;
var
SubKey: String;
n: integer;
MyValType: DWORD;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
PKey: PChar;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if SubKey = '' then
PKey := nil
else
PKey := PChar(SubKey);
if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
begin
GetMem(Buf, BufSize);
if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
begin
if ValType = MyValType then
begin
PVal := Buf;
ValSize := BufSize;
Result := True;
end else
begin
FreeMem(Buf);
end;
end else
begin
FreeMem(Buf);
end;
end;
RegCloseKey(hTemp);
end;
end;
end;
function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;
begin
case ValueType of
REG_SZ, REG_EXPAND_SZ:
Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0), Length(Value) + 1);
Reg_MULTI_SZ:
Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0#0), Length(Value) + 2);
else
Result := False;
end;
end;
function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);
end;
function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);
end;
function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);
end;
function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
end;
function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
begin
Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));
end;
function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
bOK: Boolean;
begin
Result := False;
Value := '';
if RegGetValueType(Rootkey, Name, ValueType) then
begin
case ValueType of
REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:
bOK := RegGetValue(RootKey, Name, ValueType, Buf, BufSize);
else
bOK := False;
end;
if bOK then
begin
Dec(BufSize);
SetLength(Value, BufSize);
if BufSize > 0 then
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
end;
function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := 0;
if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
begin
Value := PDWord(Buf)^;
FreeMem(Buf);
Result := True;
end;
end;
function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
var
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
Value := '';
if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
begin
SetLength(Value, BufSize);
Move(Buf^, Value[1], BufSize);
FreeMem(Buf);
Result := True;
end;
end;
function RegValueExists(RootKey: HKEY; Name: String): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
ValType: Cardinal;
begin
Result := False;
Value := REG_NONE;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
if SubKey = '' then
Result := (RegQueryValueEx(hTemp, nil, nil, @ValType, nil, nil) = ERROR_SUCCESS)
else
Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);
if Result then
Value := ValType;
RegCloseKey(hTemp);
end;
end;
end;
function RegKeyExists(RootKey: HKEY; Name: String): boolean;
var
hTemp: HKEY;
begin
Result := False;
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
Result := True;
RegCloseKey(hTemp);
end;
end;
function RegDelValue(RootKey: HKEY; Name: String): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegDelKey(RootKey: HKEY; Name: String): boolean;
var
SubKey: String;
n: integer;
hTemp: HKEY;
begin
Result := False;
n := LastPos('/', Name);
if n > 0 then
begin
SubKey := Copy(Name, 1, n - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, n + 1, Length(Name) - n);
Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;
const
MaxBufSize: Cardinal = 1024;
var
iRes: integer;
hTemp: HKEY;
Buf: String;
BufSize: Cardinal;
begin
Result := False;
// no root keys...
if pos('/', Name) <> 0 then
begin
iRes := RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_ENUMERATE_SUB_KEYS or KEY_WRITE, hTemp);
if WithSubKeys then
begin
while iRes = ERROR_SUCCESS do
begin
BufSize := MaxBufSize;
SetLength(Buf, BufSize);
iRes := RegEnumKeyEx(hTemp, 0, @Buf[1], BufSize, nil, nil, nil, nil);
if iRes = ERROR_NO_MORE_ITEMS then
begin
RegCloseKey(hTemp);
Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);
end else
begin
if iRes = ERROR_SUCCESS then
begin
SetLength(Buf, BufSize);
if RegDelKeyEx(RootKey, Concat(Name, '/', Buf), WithSubKeys) then
iRes := ERROR_SUCCESS
else
iRES := ERROR_BADKEY;
end;
end;
end;
end else
begin
RegCloseKey(hTemp);
Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);
end;
end;
end;
function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;
var
i: integer;
iRes: integer;
s: String;
hTemp: HKEY;
Buf: Pointer;
BufSize: Cardinal;
begin
Result := False;
ResultList := '';
if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
begin
Result := True;
BufSize := 1024;
GetMem(buf, BufSize);
i := 0;
iRes := ERROR_SUCCESS;
while iRes = ERROR_SUCCESS do
begin
BufSize := 1024;
if DoKeys then
iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
else
iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
if iRes = ERROR_SUCCESS then
begin
SetLength(s, BufSize);
Move(buf^, s[1], BufSize);
if ResultList = '' then
ResultList := s
else
ResultList := Concat(ResultList, #13#10, s);
inc(i);
end;
end;
FreeMem(buf);
RegCloseKey(hTemp);
end;
end;
function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
begin
Result := RegEnum(RootKey, Name, ValueList, False);
end;
function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
begin
Result := RegEnum(RootKey, Name, KeyList, True);
end;
end.
- delphi修改电脑IP
- 修改电脑IP地址
- 电脑无法修改ip地址
- 修改电脑ip为静态
- 如何修改自己电脑的IP地址
- delphi 编写控制IP地址修改程序
- Delphi 调用netsh命令修改IP地址
- 关于delphi 修改 Ip地址的运用
- Delphi 调用netsh命令修改IP地址
- Delphi 调用netsh命令修改IP地址
- 修改电脑ip为固定ip不能上网
- IP代理软件 代理IP地址 IP修改器 更换IP工具 变跟电脑IP
- 批处理方式修改IP地址和电脑名
- 批处理方式修改IP地址和电脑名
- wamp修改访问地址；用手机访问电脑IP
- Delphi 修改ScktComp使ServerSocket可以绑定在指定IP
- ifconfig修改IP地址后，重启网络服务或者重启电脑 修改后的IP无法生效！
- 转 『BAT文件』修改IP和电脑名的bat代码
- 编写安全的 Transact-SQL
- 什么是职业生涯规划？
- ORALCE: Select into VS Insert into select(真的晕)
- The Curl Programming Language
- iBatis指南、Hibernate指南、Spring开发指南
- delphi修改电脑IP
- NOV/30/2004
- alt的特殊显示方式
- 又有了一个自己的家
- 复制同步
- 爱一个人，是不是命中注定
- 可可西里
- 小试iBatis
- 给坐在靠南窗口的办公人员一点建议
