www.pudn.com > keyboard-spy.rar > RegExport.pas

unit RegExport; 
 
interface 
uses 
  windows, registry, Classes, sysutils; 
 
procedure ExportRegistryToFile(const Root: HKEY; const Key: string; const FileName: TFileName); 
 
implementation 
 
function DBLBackSlash(T: string): string; 
var 
  K                 : Longint; 
begin 
  Result := T; 
  for K := Length(T) downto 1 do 
    if Result[k] = '\' then insert('\', Result, K); 
end; 
 
{$I-} 
 
procedure ExportRegistryToFile(const Root: HKEY; const Key: string; const FileName: TFileName); 
var 
  Reg               : TRegistry; 
  F                 : TextFile; 
  p                 : PChar; 
  FKey              : string; 
 
  procedure ProcessBranch(R: string); ///递归处理子键 
  var 
    Values, Keys    : TStringList; 
    i, j, k         : longint; 
    s, t            : string; 
  begin 
    WriteLn(F); 
    case Root 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 + '\' + R + ']'); 
    Reg.CloseKey; 
    Reg.OpenKey(R, False); 
    Values := TStringList.Create; 
    Keys := TStringList.Create; 
    Reg.GetValueNames(Values); 
    Reg.GetKeyNames(Keys); 
    for i := 0 to Values.Count - 1 do 
    begin 
      s := Values.Strings[i]; 
      t := s; 
      if s = '' then s := '@' else s := '"' + s + '"'; 
      Write(F, DBLBackSlash(s) + '='); 
      case Reg.GetDataType(t) of 
        rdString, rdExpandString: Writeln(F, '"' + DBLBackSlash(Reg.ReadString(t)) + '"'); 
        rdInteger: Writeln(F, 'dword:' + IntToHex(Reg.ReadInteger(t), 8)); 
        rdBinary: begin 
            Write(F, 'hex:'); 
            j := Reg.GetDataSize(t); 
            GetMem(p, j); 
            Reg.ReadBinaryData(t, p^, j); 
            for k := 0 to j - 1 do 
            begin 
              Write(F, IntToHex(byte(p[k]), 2)); 
              if k <> j - 1 then 
              begin 
                Write(F, ','); 
                if (K > 0) and ((K mod 25) = 0) then 
                  WriteLn(F, '\'); 
              end; ///End if K<>j-1 
            end; ///For 
            FreeMem(p, j); 
            WriteLn(F); 
          end; 
      else ///case else 
        WriteLn(F, '""'); ///数据非法！ 
      end; /// End Case 
    end; ///end For 
    Reg.CloseKey; 
    Values.Free; 
    for i := 0 to Keys.Count - 1 do 
      if R <> '' then 
        ProcessBranch(R + '\' + Keys.Strings[i]) 
      else 
        ProcessBranch(Keys[i]); 
    Keys.Free; 
  end; 
 
begin 
  FKey := Key; 
  if FKey <> '' then 
    if Key[Length(FKey)] = '\' then 
      SetLength(FKey, Length(FKey) - 1); 
  AssignFile(F, FileName); 
  ReWrite(F); 
  if IOResult <> 0 then exit; 
  WriteLn(F, 'REGEDIT4'); 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := Root; 
    ProcessBranch(FKey); 
  finally 
    Reg.Free; 
    Close(F); 
  end; 
end; 
{$I+} 
 
end.