Ver Mensaje Individual
  #7  
Antiguo 06-12-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
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.

Última edición por nlsgarcia fecha: 06-12-2013 a las 01:23:52.
Responder Con Cita