![]() |
![]() |
![]() |
![]() |
![]() |
FTP | ![]() |
![]() |
CCD | ![]() |
![]() |
Buscar | ![]() |
![]() |
Trucos | ![]() |
![]() |
Trabajo | ![]() |
![]() |
Foros | ![]() |
#1
|
|||
|
|||
![]() Hola a todos haber si hay alguien que me pueda ayudar.
Mi problema: Como puedo a traves de un programa creado con delphi copiar un carpeta del registro de Windows(hacer una copia de seguridad de dicha carpeta) y que despues tambien pueda restaurarla. Si no hay ninguna funcioncilla, darme alguna idea. gracias espero que respondais ![]() |
#2
|
||||
|
||||
Te gusta algo Así:
uses Registry; procedure TForm1.Button1Click(Sender: TObject); var Reg : TRegistry; begin Reg := TRegistry.Create; try Reg.RootKey := HKEY_LOCAL_MACHINE; if not Reg.SaveKey( 'Software\Borland\Delphi', 'C:\Delphi.REG' ) Then RaiseLastWin32Error; finally Reg.Free; end; end; y usar el método LoadKey para recuperarlo
__________________
delphi.com.ar Dedique el tiempo suficiente para formular su pregunta si pretende que alguien dedique su tiempo en contestarla. ![]() |
#3
|
|||
|
|||
Me da errores el codigo
Hola de nuevo he utilizado el código de arriva, y me da un error.
En la ventana de error pone "Win32 Error.code:1411. Esta clase no existe." Haber si hay alguna solucion. Garcias ![]() Por cierto gracias a Delphi.com.ar por ayudarme Última edición por Periyo fecha: 07-05-2003 a las 13:14:20. |
#4
|
|||
|
|||
![]() Ya encontre la solución al problema. Encontre una funcioncilla muy interesante, mas que una funcion es toda una unidad.
Aqui os la dejo. Solo teneis que crear una unidad y meter todo este código. Despues es cuestión de llamar al procedimiento "procedure ExportKey ( RootKey : HKEY; Key : String; FileName : String; Overwrite : Boolean );" Mandando como paramatros: Root,Direcion de la clave,Direccion y nombre del archivo donde se hara la copia, true para que sobrescriba si ya existiera el archivo o falso para que no lo sobrescriba. unit ExportarRegistro; interface uses Windows,Classes,Registry,SysUtils; const ExportHeader = 'REGEDIT4'; procedure ExportKey ( RootKey : HKEY; Key : String; FileName : String; Overwrite : Boolean ); 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 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 i<Datasize-1 then 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; initialization Initialize; end. |
![]() |
Herramientas | Buscar en Tema |
Desplegado | |
|
|
![]() |
||||
Tema | Autor | Foro | Respuestas | Último mensaje |
proxy del firefox en el registro de Windows | barrauda | API de Windows | 0 | 17-02-2005 19:52:52 |
Problemas con el registro de windows | CFPA86 | Varios | 1 | 25-06-2004 23:35:12 |
Eliminar registro de Windows | verm83 | Varios | 1 | 11-04-2004 22:27:39 |
registro de Windows | ebeltete | API de Windows | 1 | 17-06-2003 17:00:14 |
Microsoft Taglines | SnaKe | Humor | 0 | 03-06-2003 15:42:27 |
![]() |
|