|
 Forum
Grundkurs
»Introduktion
»Snabbguide
»Komponenter
»Händelser
»Strängar
»Räkna med Delphi »Egna
typer
»Selektion
»Iteration
»Menyer
»Funktioner
»Arraystrukturer
Tips & Tricks
»Nya tips
»Blandat
»Databaser
»Filer
»Forms
»Grafik
»Internet
»Komponenter
»Matematik
»Multimedia
»Objekt/ActiveX
»Skrivare
»Strängar
»System
»Mest lästa tips
Artiklar
»Delphi och ADO
»Bygga en DLL
»Skapa en enkel rapport
»Hantera registret
»Enheter, units
»Klassen TCanvas
»Använd LookUp Controls
 Nya
tips
 Lägg
till tips
 Delphilänkar
 Gästbok
|
|
|
|
|
|
Tar kopia på registret och sparar den i en *.Reg fil
|
Kategori: Filer
Inlagt: 2005-03-09
Läst: 1375
Inlagt av: Bengt Nilsson
|
|
Beskrivning |
|
Denna units tar en kopia på registret och sparar den i en *.Reg fil.
Regfilen är Kompatibel med "Regedit"
Dubbelklicka på filen så inporeras den i registret.
|
|
Kod |
unit RegExpo;
interface
uses
Windows, rRegistry, Classes, SysUtils;
{$I-}
{$LONGSTRINGS ON}
{
Example:
ExportRegistryBranch(HKEY_LOCAL_MACHINE,'SOFTWARE\Borland\Delphi','A:\DELPHI.REG')
}
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 ; {longstring s 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);
try
values := TStringList.Create;
try
keys := TStringList.Create;
try
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) {line too long?} then
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}
finally
reg.CloseKey;
end;
finally
{value names all done, no longer needed}
values.Free;
end;
{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]);
finally
keys.Free; {this branch is ready}
end;
end; { ProcessBranch}
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;
{Call the function that writes the branch and all subbranches}
ProcessBranch(Regroot);
finally
reg.Free; {ready}
Close(f);
end;
end;
end.
|
|
|