Recorrer el registro de windows como una estructura de directorios

[[nlsgarcia]]

ElDuc,

Continuación del Msg #6:

Esta es la versión 2 del programa SearchRemoveRegistry, el cual se mejoro en lo referente a la búsqueda y remoción de Items del registro de Windows.

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function SearchRegistry(RootKey, SubKey, ValueName : String) : Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CountRemove : Integer;

implementation

{$R *.dfm}

const
   HKEYNames : Array[0..6] of String = ('HKEY_CLASSES_ROOT', 'HKEY_CURRENT_USER',
                                       'HKEY_LOCAL_MACHINE', 'HKEY_USERS',
                                       'HKEY_PERFORMANCE_DATA', 'HKEY_CURRENT_CONFIG',
                                       'HKEY_DYN_DATA');


// Convierte una Clave del Registro de String a HKey
function StrToHKEY(const KEY: string): HKEY;
var
   i: Byte;
begin
   Result := $0;
   for i := Low(HKEYNames) to High(HKEYNames) do
   begin
      if SameText(HKEYNames[i], KEY) then
         Result := HKEY_CLASSES_ROOT + i;
   end;
end;

// Consulta Items del Registro (Key, Variables  y Valores) iguales a un valor dado
function TForm1.SearchRegistry(RootKey, SubKey, ValueName : String) : Integer;

   function GetValue(Reg : TRegistry; ValueName : String) : String;
   var
      rd: TRegDataInfo;
      size: Cardinal;
      st: string;
      Value : String;
     
   begin
      if Reg.GetDataInfo(ValueName, rd) then
      case rd.RegData of

         rdUnknown: Value := '';
         rdInteger: Value := IntToStr(Reg.ReadInteger(ValueName));
         rdString , rdExpandString: Value := Reg.ReadString(ValueName);
         rdBinary : begin
                       size:= Reg.GetDataSize(ValueName);
                       SetLength(st, size);
                       Reg.ReadBinaryData(ValueName, PChar(st)^, size);
                       Value := st;
                    end;
      end;
      Result := Value;
   end;

var
   i,j : Integer;
   ListKeys : TStrings;
   ListValues : TStrings;
   Reg : TRegistry;
   ItemReg : String;
   Value : String;

begin

   Reg := TRegistry.Create;

   try

      Reg.RootKey := StrToHKEY(RootKey);

      if Reg.OpenKey(IncludeTrailingBackslash(SubKey),False) Then
      begin

         ListKeys := TStringlist.Create;
         ListValues := TStringlist.Create;

         try

            Reg.GetKeyNames(ListKeys);

            for i := 0 to ListKeys.Count-1 Do
            begin

               Application.ProcessMessages;
               if Reg.OpenKey(IncludeTrailingBackslash(SubKey) + ListKeys.Strings[i],False) Then
               begin

                  if (ListKeys.Strings[i] = ValueName) then
                  begin

                      ItemReg := RootKey +
                                 IncludeTrailingBackslash(SubKey) +
                                 IncludeTrailingBackslash(ListKeys.Strings[i]);

                      ListBox1.Items.Add(ItemReg);

                      if ListBox1.ScrollWidth < ListBox1.Canvas.TextWidth(ItemReg) then
                         ListBox1.ScrollWidth := ListBox1.Canvas.TextWidth(ItemReg) + 120;

                      Inc(CountRemove);

                  end
                  else
                  begin

                     Reg.GetValueNames(ListValues);

                     for j := 0 to ListValues.Count -1 do
                     begin

                        Value := GetValue(Reg,ListValues.Strings[j]);

                        if (Value = ValueName) or
                           (ListValues.Strings[j] = ValueName) or
                           (ListKeys.Strings[i] = ValueName) then
                        begin

                           ItemReg := RootKey +
                                      IncludeTrailingBackslash(SubKey) +
                                      IncludeTrailingBackslash(ListKeys.Strings[i]) +
                                      ListValues.Strings[j] +
                                      ' = ' +
                                      Value;

                           ListBox1.Items.Add(ItemReg);

                           if ListBox1.ScrollWidth < ListBox1.Canvas.TextWidth(ItemReg) then
                              ListBox1.ScrollWidth := ListBox1.Canvas.TextWidth(ItemReg) + 120;

                           Inc(CountRemove);

                        end;

                     end;

                  end;

                  If not Reg.HasSubKeys then
                        Reg.CloseKey;

                  ListValues.Clear;

               end;

               If Reg.HasSubKeys then
                  SearchRegistry(RootKey,IncludeTrailingBackslash(SubKey) +
                  ListKeys.Strings[i],ValueName)

            end;

         finally

            ListKeys.Free;
            ListValues.Free;

         end;

      end;

   finally

      Reg.Free;

   end;

   Result := CountRemove;

end;

// Remueve del Items del Registro (Key, Variables  y Valores) iguales a un valor dado
function RemoveRegistry(RootKey, SubKey, ValueName : String) : Integer;
var
   i,j : Integer;
   ListKeys : TStrings;
   ListValues : TStrings;
   Reg : TRegistry;
   ItemReg : String;
   rd: TRegDataInfo;
   size: Cardinal;
   st: string;
   Value : String;

begin

   Reg := TRegistry.Create;

   try

      Reg.RootKey := StrToHKEY(RootKey);

      if Reg.OpenKey(IncludeTrailingBackslash(SubKey),False) Then
      begin

         ListKeys := TStringlist.Create;
         ListValues := TStringlist.Create;

         try

            Reg.GetKeyNames(ListKeys);

            for i := 0 to ListKeys.Count-1 Do
            begin

               Application.ProcessMessages;

               if Reg.OpenKey(IncludeTrailingBackslash(SubKey) + ListKeys.Strings[i],False) Then
               begin

                  if (ListKeys.Strings[i] = ValueName) then
                  begin
                     Reg.DeleteKey(IncludeTrailingBackslash(SubKey) + ListKeys.Strings[i]);
                     Inc(CountRemove);
                  end
                  else
                  begin

                     Reg.GetValueNames(ListValues);
                     for j := 0 to ListValues.Count -1 do
                     begin

                        if Reg.GetDataInfo(ListValues.Strings[j], rd) then
                        case rd.RegData of

                           rdUnknown: Value := '';
                           rdInteger: Value := IntToStr(Reg.ReadInteger(ListValues.Strings[j]));
                           rdString , rdExpandString: Value := Reg.ReadString(ListValues.Strings[j]);
                           rdBinary : begin
                                         size:= Reg.GetDataSize(ListValues.Strings[j]);
                                         SetLength(st, size);
                                         Reg.ReadBinaryData(ListValues.Strings[j], PChar(st)^, size);
                                         Value := st;
                                      end;
                        end;

                        if (Value = ValueName) or (ListValues.Strings[j] = ValueName) then
                        begin
                           Reg.DeleteValue(ListValues.Strings[j]);
                           Inc(CountRemove);
                        end;

                     end;

                  end;

                  If Reg.HasSubKeys then
                     RemoveRegistry(RootKey,IncludeTrailingBackslash(SubKey) +
                     ListKeys.Strings[i],ValueName)

               end;

            end;

         finally

            ListKeys.Free;
            ListValues.Free;

         end;

      end;

   finally

      Reg.Free;

   end;

   Result := CountRemove;

end;

// Inicializa Valores de Búsqueda de Ejemplo
procedure TForm1.FormCreate(Sender: TObject);
var
   i : Integer;
begin
   for i := Low(HKEYNames) to High(HKEYNames) do
      ComboBox1.Items.Add(HKEYNames[i]);
   ComboBox1.Text := ComboBox1.Items.Strings[5];
   Edit2.Text := '\';
   Edit3.Text := '';
end;

// Consulta del Registro Items de un valor específico
procedure TForm1.Button1Click(Sender: TObject);
var
   RootKey : String;
   SubKey : String;
   ValueName : String;
   Msg : String;

begin

   RootKey := ComboBox1.Text;
   SubKey := Edit2.Text;
   ValueName := Edit3.Text;

   if (RootKey = EmptyStr) or (SubKey = EmptyStr) or (ValueName = EmptyStr) then
      raise Exception.Create('Párametros del Registro Inválidos');

   ListBox1.Clear;
   Button1.Enabled := False;
   CountRemove := 0;

   if SearchRegistry(RootKey, SubKey, ValueName) <> 0 then
   begin
      Msg := Format('Se Encontraron %d Items del Registro = %s',[CountRemove,ValueName]);
      MessageDlg(Msg,mtInformation,[mbOK],0)
   end
   else
   begin
      Msg := Format('No se Encontró Ningún Item del Registro = %s',[ValueName]);
      MessageDlg(Msg,mtError,[mbOK],0);
   end;
   Button1.Enabled := True;

end;

// Remueve del Registro Items de un valor específico
procedure TForm1.Button2Click(Sender: TObject);
var
   RootKey : String;
   SubKey : String;
   ValueName : String;
   Msg : String;

begin

   RootKey := ComboBox1.Text;
   SubKey := Edit2.Text;
   ValueName := Edit3.Text;

   if (RootKey = EmptyStr) or (SubKey = EmptyStr) or (ValueName = EmptyStr) then
      raise Exception.Create('Párametros del Registro Inválidos');

   ListBox1.Clear;
   Button2.Enabled := False;
   CountRemove := 0;

   if RemoveRegistry(RootKey, SubKey, ValueName) <> 0 then
   begin
      Msg := Format('Se Removieron %d Items del Registro = %s',[CountRemove,ValueName]);
      MessageDlg(Msg,mtInformation,[mbOK],0)
   end
   else
   begin
      Msg := Format('No se Removio Ningún Item del Registro = %s',[ValueName]);
      MessageDlg(Msg,mtError,[mbOK],0);
   end;

   Button2.Enabled := True;

end;

end.

El código anterior permite Consultar y Remover Items del Registro de Windows a Nivel de: Claves, Variables y Valores por medio de un argumento de búsqueda.

El ejemplo esta disponible en el link : http://terawiki.clubdelphi.com/Delph...egistry_v2.rar

Espero sea útil

Nelson.

[ElDuc]

Hola otra vez,

Lo primero pediros disculpas por esta desaparición, pero por unos problemillas personales he estado fuera de juego.

En segundo lugar, agradeceros muchísimo muestra colaboración, espero algún día tener conocimientos para poder hacer contribuciones como las vuestras, ¡sois una pasada! GRACIAS.

dec, he probado tu EXE y creo que va perfecto, ya que me encuentra la palabra en cualquier sitio, es decir, tanto en el nombre de la clave como en el nombre del valor como en el propio valor, es lo que yo buscaba.

El problema lo tengo cuando intento abrir las fuentes para incorporar la clase en mi programa ya que me salen mensajes de error:









y una vez cargado si intento compilar me sale:



Yo estoy trabajando con D7, no sé si este es el problema.

nlsgarcia,

Tus fuentes si que puedo abrirlas, pero he probado tu ejecutable y no me encuentra lo que busco, te pongo una imagen del exe de dec que me encuentra más de 4000 ocurrencias y una del tuyo que no me encuentra ninguna, no sé si es porque no hago bien alguna cosa.





Cuando podáis me comentáis algo, MUCHAS GRACIAS.

[dec]

Hola,

Asegúrate de descargar la última versión del archivo que he adjuntado más arriba en este hilo: en efecto anoche mismo hice cambios para que pudiese compilar en Delphi 2007, y, creo que también en Delphi 7. Los problemas que encontraste seguramente están relacionados con haber usado Delphi XE2 para llevar a cabo el proyecto en un principio. O sea descarga de nuevo el archivo Zip adjunto, prueba a ver y comenta qué tal. Además hice algunas mejoras y "refactorizaciones".

P.D. Hay alguna cosa que no va bien, si no recuerdo mal: el "case sensitive" no parece funcionar correctamente. Es decir, parece funcionar siempre en modo "case insensitive" aunque se indique lo contrario. A ver si tengo un poco de tiempo y lo miro.

[dec]

Hola,

Parece que las imágenes de "DropBox" que quieres publicar no aparecen en el hilo... probablemente porque "DropBox" no las quiere servir así sin más. Si quieres prueba con un servicio como el que ofrece ImageShack que cuyas URLs de imágenes sí que pueden mostrarse aquí sin problemas.

[ElDuc]

Hola dec, disculpa pero no encuentro la 2ª versión que dices.

[dec]

Hola,

Empezado por ElDuc

Hola dec, disculpa pero no encuentro la 2ª versión que dices.

Sí; mira, en realidad es el archivo que adjunto en este mensaje: se trata del mismo archivo (Zip) de siempre pero su contenido es distinto y contiene las actualizaciones que he comentado.

[dec]

Hola,

Sólo para comentar que ya parece que el "case sensitive" funciona como se espera.