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;

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;