como importar claves al Registro (desde archivo.reg)

[sitrico] · #1 01-12-2004

Estoy tratando de solucionar un problema de instalación de una aplicación que desarrolle hace tiempo y que consiste en que toda la configuración se guarda en el registro de windows dentro de la clave:

HKEY_CURRENT_USER

Por lo que en algunos casos (cuando el sistema lo instala un usuario distinto al que lo va a usar) el sistema da errores al no poder encontrar las claves de registro necesarias.

Para solucionarlo pensé en guardar las claves de registro en un archivo .reg y
buscando en los foros encontré este hilo:

http://www.clubdelphi.com/foros/show...portarRegistro

de donde tome la unidad ExportarRegistro que lo exporta perfectamente.

Mi duda es como Importar un archivo .reg directamente al registro (desde la aplicación) ya que al usar:

Código Delphi [-]ShellExecute(application.Handle,'open',
Pchar(ExtractFilePath(Application.ExeName)+ 'Archivo.Reg'),
nil, nil,SW_SHOW);

me aparecen los mensajes de "Quiere agragar la información al registro" y "la información se ha incorporado correctamente" pero mientras tanto no se detiene la ejecución de la aplicación y se genera de el error de claves de registro. (la siguiente corrida funciona bien).

lo que necesito es una funcion complementaria de tipo:

ImportarRegistro(filename)

Gracias.

PD Probé con Reg.LoadKey y tampoco funcionó

Uso: D7 - Win98 y otros Windows

[sitrico] · #2 03-12-2004

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)); //Try to minimize reallocations
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 //the last byte, no comma
                          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); //Use values as temporary storage
         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); // String
      1 : Reg.WriteInteger(Name,StrToInt('$'+Value)); // Entero
      End;
   Reg.CloseKey;
Finally
   Reg.Free;
   End;
End;
Var
Clave,Valor : String;
i,p : Integer;
Begin
Delete(data,1,1); // las Primera "
Clave := copy(Data,1,Pos('"',Data)-1);
Delete(data,1,Pos('"',Data)+1); // Segunada comilla + el Igual
If Data[1] = '"' Then
   Begin // Dato de tipo String;
   Delete(data,1,1); // las Primera "
   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 // Dato entero;
   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 // Nueva clave
               Delete(Data,Length(data),1);
               Delete(Data,1,1);
               ActualKey := Data;
               End
            Else
               Begin //Nuevos Valores
               WriteDataKey(ActualKey,Data);
               End;

            End;
         End;
      End;
finally
   ImportData.Free;
   end;
End;

initialization

Initialize;

end.