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.