Luchando con la unidad exportar registro logre solucionar el problema de la importación (creando un procedimiento ImportKey) solo terminé la parte correspondiente a los valores de cadena (String) y enteros (dword) pero no es dificil completar el resto.
la publico para futura referencia. Acepto críticas y sugerencias
Código Delphi
[-]
unit ExportarRegistro;
interface
uses Windows,Classes,Registry,SysUtils, Math;
const
ExportHeader = 'REGEDIT4';
procedure ExportKey (RootKey : HKEY; Key : String; FileName: String; Overwrite: Boolean);
procedure ImportKey (FileName: String);
implementation
type
TSubstitution = record
Character : char;
Substitution : String;
end;
const
SubstitutionsConst : array [1..4] of TSubstitution =
( (Character : #10; Substitution : '\n'),
(Character : #13; Substitution : '\r'),
(Character : '"'; Substitution : '\"'),
(Character : '\'; Substitution : '\\'));
var
Substitutions : array [1..255] of String;
procedure Initialize;
var
i : Integer;
begin
for i:=low(Substitutions) to high(Substitutions) do
Substitutions[i]:='';
for i:=low(SubstitutionsConst) to high(SubstitutionsConst) do
Substitutions[ord(SubstitutionsConst[i].Character)]:= SubstitutionsConst[i].Substitution;
end;
function RegistryRootKeyName ( Key : HKEY ) : string;
begin
case Key of
$80000000 : Result:='HKEY_CLASSES_ROOT';
$80000001 : Result:='HKEY_CURRENT_USER';
$80000002 : Result:='HKEY_LOCAL_MACHINE';
$80000003 : Result:='HKEY_USERS';
$80000004 : Result:='HKEY_PERFORMANCE_DATA';
$80000005 : Result:='HKEY_CURRENT_CONFIG';
$80000006 : Result:='HKEY_DYN_DATA';
else Result:='';
end;
end;
function RegistryRootKeyValue(Key:string):HKEY;
begin
If Key = 'HKEY_CLASSES_ROOT' Then Result:= $80000000
Else If Key = 'HKEY_CURRENT_USER' Then Result:= $80000001
Else If Key = 'HKEY_LOCAL_MACHINE' Then Result:= $80000002
Else If Key = 'HKEY_USERS' Then Result:= $80000003
Else If Key = 'HKEY_PERFORMANCE_DATA' Then Result:= $80000004
Else If Key = 'HKEY_CURRENT_CONFIG' Then Result:= $80000005
Else If Key = 'HKEY_DYN_DATA' Then Result:= $80000006;
end;
function NormalizeString( s : String ) : String;
var
i : Integer;
subst : String;
begin
SetLength(Result,Length(s)); Result:='';
for i:=1 to Length(s) do
begin
subst:=Substitutions[ord(s[i])];
if subst<>'' then
Result:=Result+subst
else
Result:=Result+s[i];
end;
end;
function ConvertValueToStr(Reg : TRegistry; ValueName : String) : String;
var
DataType : TRegDataType;
DataSize : Integer;
Buffer : pointer;
p : ^byte;
b : byte;
i : Integer;
begin
DataType:=Reg.GetDataType(ValueName);
case DataType of
rdString,
rdExpandString : Result := '"'+NormalizeString(Reg.ReadString(ValueName))+'"';
rdInteger : Result := Format('dword:%.8x',[Reg.ReadInteger(ValueName)]);
rdBinary : begin
DataSize := Reg.GetDataSize(ValueName);
GetMem(Buffer,Datasize);
try
if Reg.ReadBinaryData(ValueName,Buffer^,Datasize)=Datasize then
begin
Result:='hex:';
p:=Buffer;
for i:=0 to Datasize-1 do
begin
b:=p^;
if ithen
Result:=Result+Format('%.2x,',[b])
else Result:=Result+Format('%.2x',[b]);
if (i mod 16 = 15) then
Result:=Result+'\'+#13#10;
inc(p);
end;
end;
finally
Freemem(Buffer,Datasize);
end;
end;
end;
end;
procedure PrepareData(Reg : TRegistry; Data : TStrings );
var
Values : TStringList;
Keys : TStringList;
CurPath : String;
s : String;
i : Integer;
begin
Values := TStringList.Create;
Keys := TStringList.Create;
Keys.Add(Reg.CurrentPath);
try
while Keys.Count>0 do
begin
if Reg.OpenKey('\'+Keys[0],False) then
begin
CurPath:=Reg.CurrentPath;
Reg.GetValueNames(Values);
Data.Add(Format('[%s\%s]',[RegistryRootKeyName(Reg.RootKey),CurPath]));
for i:=0 to Values.Count-1 do
begin
if Values[i]='' then
s:='@'
else
s:='"'+Values[i]+'"';
Data.Add(Format( '%s=%s',[s,ConvertValueToStr(Reg,Values[i])]));
end;
Data.Add('');
Reg.GetKeyNames(Values); for i:=0 to Values.Count-1 do
Keys.Insert(1,Keys[0]+'\'+Values[i]);
Values.Clear;
end;
Keys.Delete(0);
end;
finally
Keys.Free;
Values.Free;
end;
end;
procedure ExportKey ( RootKey : HKEY; Key : String;
FileName : String; Overwrite : Boolean );
var
Reg : TRegistry;
ExportData : TStringList;
Ok : Boolean;
begin
if FileExists(FileName) and not Overwrite then
exit;
Reg := TRegistry.Create;
ExportData := TStringList.Create;
try
Reg.RootKey:=RootKey;
if Reg.OpenKey(Key,False) then
begin
ExportData.Add(ExportHeader);
ExportData.Add('');
PrepareData(Reg,ExportData);
Ok:=not FileExists(FileName);
if not Ok then
Ok:=DeleteFile(FileName);
if Ok then
ExportData.SaveToFile(FileName);
end;
finally
ExportData.Free;
Reg.Free;
end;
end;
Procedure WriteDataKey(ActualKey,Data:String);
Procedure Guardar(Key,Name,Value:String;Tipo : Integer);
Var
Reg : tRegistry;
RootKey,LocalKey : String;
Begin
Reg := TRegistry.Create;
Try
RootKey := copy(Key,1,Pos('\',Key)-1);
LocalKey := copy(Key,Pos('\',Key)+1,255);
Reg.RootKey := RegistryRootKeyValue(RootKey);
Reg.OpenKey(LocalKey,True);
Case tipo of
0 : Reg.WriteString(Name,Value); 1 : Reg.WriteInteger(Name,StrToInt('$'+Value)); End;
Reg.CloseKey;
Finally
Reg.Free;
End;
End;
Var
Clave,Valor : String;
i,p : Integer;
Begin
Delete(data,1,1); Clave := copy(Data,1,Pos('"',Data)-1);
Delete(data,1,Pos('"',Data)+1); If Data[1] = '"' Then
Begin Delete(data,1,1); Valor := copy(Data,1,Pos('"',Data)-1);
For i := 1 to 4 do
While Pos(SubstitutionsConst[i].Substitution,Valor) <> 0 do
Begin
p := Pos(SubstitutionsConst[i].Substitution,Valor);
Delete(Valor,p,2);
Insert(SubstitutionsConst[i].Character,Valor,p);
End;
Guardar(ActualKey,Clave,Valor,0);
End
Else If Pos('dword',Data) = 1 Then
Begin Valor := Copy(Data,7,8);
Guardar(ActualKey,Clave,Valor,1);
End;
End;
procedure ImportKey (FileName: String);
var
ImportData : TStringList;
i :Integer;
ActualKey,Data : String;
Begin
if Not FileExists(FileName) then
exit;
ImportData := TStringList.Create;
ActualKey := '';
try
ImportData.LoadFromFile(FileName);
If ImportData[0] = ExportHeader Then
Begin
For i := 1 to ImportData.Count-1 do
Begin
Data := ImportData[i];
If Data <> '' Then
Begin
If (Data[1] = '[') and (Data[Length(data)] = ']') Then
Begin Delete(Data,Length(data),1);
Delete(Data,1,1);
ActualKey := Data;
End
Else
Begin WriteDataKey(ActualKey,Data);
End;
End;
End;
End;
finally
ImportData.Free;
end;
End;
initialization
Initialize;
end.