procedure ExportRegistryBranch(Rootsection: Integer; regroot: string;
  FileName: string);
implementation

function FindDBL (s: string): integer;
var
 i, count: integer;
begin
 count := 0;
 for i:=1 to length(s) do
   if s[i]='\"' then
   begin
     count := count+1;
    end;
 FindDBL := count;
end;

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;
  correct:string;

  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);
    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) + '\"'));
       if  FindDBL(dblbackslash(reg.ReadString(t)))>0 then
       begin
        correct  := StringReplace(dblbackslash(reg.ReadString(t)), '\"', '\\"',[rfReplaceAll, rfIgnoreCase]);
        Writeln(f, '\"' + correct + '\"');
       end
       else 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, 'Windows Registry Editor Version 5.00'); {"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;

_____________________________________

ExportRegistryBranch(HKEY_CURRENT_USER,'\Software\key\','c:\1.reg');