请教怎样在程序中备份和恢复注册表

jackzhao 2002-09-22 11:52:21
请教怎样在程序中备份和恢复注册表,窗体的关闭按纽怎么置灰
...全文
68 1 打赏 收藏 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
njbudong 2002-09-22
  • 打赏
  • 举报
回复
//看看如下函数
//

Procedure ExportRegistryBranch (rootsection : Integer; regroot:String;
filename:String);

implementation

Function dblBackSlash(t:string):string;
var k:longint;
begin
result:=t; {Strings are not allowed
to have}
for k:=length(t) downto 1 do {single backslashes}
if result[k]='\' then insert('\',result,k);
end;

Procedure ExportRegistryBranch (rootsection : Integer; regroot:String;
filename:String);
var
reg:tregistry;
f:textfile;
p:PCHAR;

Procedure ProcessBranch(root:string); {recursive sub-procedure}
var
values,
keys:tstringlist;
i,j,k:longint;
s,t:string; {longstrings are on the
heap, not on the stack!}
begin
writeln(f); {write blank line}
case rootsection of
HKEY_CLASSES_ROOT : s := 'HKEY_CLASSES_ROOT';
HKEY_CURRENT_USER : s := 'HKEY_CURRENT_USER';
HKEY_LOCAL_MACHINE : s := 'HKEY_LOCAL_MACHINE';
HKEY_USERS : s := 'HKEY_USERS';
HKEY_PERFORMANCE_DATA: s := 'HKEY_PERFORMANCE_DATA';
HKEY_CURRENT_CONFIG : s := 'HKEY_CURRENT_CONFIG';
HKEY_DYN_DATA : s := 'HKEY_DYN_DATA';
end;

Writeln(f,'['+s+'\'+root+']'); {write section name in
brackets}

reg.OpenKey(root,false);

values := tstringlist.create;

keys:=tstringlist.create;

reg.getvaluenames (values); {get all value names}
reg.getkeynames (keys); {get all sub-branches}

for i:=0 to values.count-1 do {write all the values
first}
begin
s := values[i];
t := s; {s=value name}
if s= ''then
s:='@' {empty means "default
value", write as @}
else
s:='"' + s + '"'; {else put in quotes}

write(f,dblbackslash(s)+ '=' ); {write the name of the key
to the file}

Case reg.Getdatatype(t) of {What type of data is it?}
rdString,
rdExpandString: {String-type}
Writeln(f,'"' + dblbackslash(reg.readstring(t) + '"'));
rdInteger: {32-bit unsigned long
integer}
Writeln(f,'dword:' + inttohex(reg.readinteger(t),8));
{ write an array of hex bytes if data is "binary." Perform a line
feed
after approx. 25 numbers so the line length stays within limits }
rdBinary :
begin
write(f,'hex:');
j := reg.getdatasize(t); {determine size}
getmem(p,j); {Allocate memory}
reg.ReadBinaryData(t,p^,J); {read in the data, treat
as pchar}
for k:=0 to j-1 do begin
Write(f,inttohex(byte(p[k]),2)); {Write byte as hex}
if k<>j-1 then {not yet last byte?}
begin
write(f,','); {then write Comma}
if (k>0) and ((k mod 25)=0) then {line too long?}
writeln(f,'\'); {then write Backslash +
lf}
end; {if}
end; {for}
freemem(p,j); {free the memory}
writeln(f); {Linefeed}
end;
ELSE
writeln(f,'""'); {write an empty string if
datatype illegal/unknown}
end; {case}
end; {for}

reg.closekey;

{value names all done, no longer needed}
values.free;

{Now al values are written, we process all subkeys}
{Perform this process RECURSIVELY...}
for i := 0 to keys.count -1 do
ProcessBranch(root+'\'+keys[i]);

keys.free; {this branch is ready}
end;

begin
if regroot[length(regroot)]='\' then {No trailing backslash}
setlength(regroot,length(regroot)-1);
Assignfile(f,filename); {create a text file}
rewrite(f);

IF ioresult<>0 then
EXIT;

Writeln(f,'REGEDIT4'); {"magic key" for regedit}

reg:=tregistry.create;
try
reg.rootkey:=rootsection;
ProcessBranch(regroot); {Call the function that
writes the branch and all subbranches}
finally
reg.free; {ready}
close(f);
end;
end;
end.

5,944

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧