TRegistry Export

//wersja 13.04
uses
registry, windows;
 
type
TRegistryExportHelper = class helper for TRegistry
procedure ExportKey(APath: string; AOutput: TStrings; AVer: Byte = 5);
end;
 
procedure TRegistryExportHelper.ExportKey(APath: string; AOutput: TStrings;
AVer: Byte = 5);
var
FStrRootKey: string;
 
function RootKeyToString(key: HKEY): string;
begin
case key of
HKEY_CLASSES_ROOT:
Result := 'HKEY_CLASSES_ROOT';
HKEY_CURRENT_USER:
Result := 'HKEY_CURRENT_USER';
HKEY_LOCAL_MACHINE:
Result := 'HKEY_LOCAL_MACHINE';
HKEY_USERS:
Result := 'HKEY_USERS';
HKEY_PERFORMANCE_DATA:
Result := 'HKEY_PERFORMANCE_DATA';
HKEY_CURRENT_CONFIG:
Result := 'HKEY_CURRENT_CONFIG';
HKEY_DYN_DATA:
Result := 'HKEY_DYN_DATA';
end;
end;
 
function FormatString(s: string): string;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(s) do
begin
if s[i] in ['"', '\'] then
Result := Result + '\';
Result := Result + s[i];
end;
end;
 
function FormatKey(s: string): string;
begin
if s = '' then
Result := '@'
else
Result := '"' + FormatString(s) + '"';
end;
 
procedure ExportValue(reg: TRegistry; v: string);
var
RD: DWord;
buffer: PByte;
bs: Integer;
empty: Boolean;
i: DWord;
begin
bs := reg.GetDataSize(v);
empty := (bs = 0) or (bs = -1);
if empty then
bs := 1024;
GetMem(buffer, bs);
try
if RegQueryValueExA(reg.CurrentKey, PChar(v), nil, @RD, buffer,
lpdword(@bs)) = ERROR_SUCCESS then
begin
v := FormatKey(v)+'=';
 
if RD = REG_DWORD then
begin
AOutput.Append(v+'dword:' + LowerCase(IntToHex(PDWord(buffer)^, 8)));
end
else
if RD = REG_SZ then
begin
AOutput.Append(v+'"' + FormatString(PChar(buffer)) + '"')
end
else
begin
if RD = REG_BINARY then
v := v+'hex:'
else
v := v+'hex('+LowerCase(IntToHex(RD, 0))+'):';
 
if not empty then
begin
for i := 0 to bs-1 do
begin
v := v + LowerCase(IntToHex(buffer[i], 2));
if i < bs - 1 then
v := v + ',';
if Length(v) >= 77 then
begin
AOutput.Append(v+'\');
v := '  ';
end;
end;
end;
 
if Length(v) > 0 then
AOutput.Append(v);
end;
end
finally
Freemem(buffer);
end;
end;
 
procedure ExportNode(reg: TRegistry);
var
s: TStrings;
i: Integer;
begin
s := TStringList.Create;
try
reg.GetValueNames(s);
for i := 0 to s.Count - 1 do
ExportValue(reg, s[i]);
finally
s.Free;
end;
end;
 
procedure RegScan(key: string);
var
r: TRegistry;
s: TStrings;
i: Integer;
begin
AOutput.Append('');
AOutput.Append('['+FStrRootKey+key+']');
r := TRegistry.Create(Self.Access);
s := TStringList.Create;
try
r.RootKey := Self.RootKey;
if r.OpenKeyReadOnly(key) then
begin
ExportNode(r);
r.GetKeyNames(s);
for i := 0 to s.Count - 1 do
begin
RegScan(key+'\'+s[i]);
end;
end;
finally
s.Free;
r.Free;
end;
end;
 
begin
if AVer = 5 then
AOutput.Append('Windows Registry Editor Version 5.00')
else
if AVer = 4 then
AOutput.Append('REGEDIT4');
FStrRootKey := RootKeyToString(Self.RootKey);
RegScan(APath);
end;

Przykład użycia

var
r: TRegistry;
begin
Memo1.Lines.Clear;
r := TRegistry.Create;
try
r.RootKey := HKEY_LOCAL_MACHINE;
if r.OpenKeyReadOnly('\Software') then
r.ExportKey('\Software', Memo1.Lines);
finally
r.Free;
end;
end;