ElDuc,
Cita:
|
Empezado por ElDuc
...necesito...recorrer todo el registro...eliminar del registro cualquier clave que en su nombre de clave, nombre de valor o valor que contenga la palabra "AJAX_177"...
|
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;
Edit1: TEdit;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function SearchRegistry(RootKey, SubKey, ValueName : String) : Integer;
public
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');
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;
function TForm1.SearchRegistry(RootKey, SubKey, ValueName : String) : Integer;
var
i : 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
Reg.GetValueNames(ListValues);
if (ListValues.IndexOf(ValueName) <> -1) then
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;
ItemReg := RootKey +
IncludeTrailingBackslash(SubKey) +
IncludeTrailingBackslash(ListKeys.Strings[i]) +
ValueName +
' = ' +
Value;
ListBox1.Items.Add(ItemReg);
if ListBox1.ScrollWidth < ListBox1.Canvas.TextWidth(ItemReg) then
ListBox1.ScrollWidth := ListBox1.Canvas.TextWidth(ItemReg) + 120;
Inc(CountRemove);
ListValues.Clear;
If not Reg.HasSubKeys then
Reg.CloseKey;
end;
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;
function RemoveRegistry(RootKey, SubKey, ValueName : String) : Integer;
var
i : Integer;
ListKeys : TStrings;
ListValues : TStrings;
Reg : TRegistry;
ItemReg : 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);
if (ListValues.IndexOf(ValueName) <> -1) then
begin
ItemReg := RootKey +
IncludeTrailingBackslash(SubKey) +
IncludeTrailingBackslash(ListKeys.Strings[i]) +
ValueName;
Reg.DeleteValue(ValueName);
Inc(CountRemove);
If not Reg.HasSubKeys then
Reg.CloseKey;
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;
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := 'HKEY_CURRENT_CONFIG';
Edit2.Text := '\';
Edit3.Text := 'TestX';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
RootKey : String;
SubKey : String;
ValueName : String;
Msg : String;
begin
RootKey := Edit1.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;
procedure TForm1.Button2Click(Sender: TObject);
var
RootKey : String;
SubKey : String;
ValueName : String;
Msg : String;
begin
RootKey := Edit1.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 eliminar del registro de Windows cualquier Item del mismo cuya clave o valor se igual a un nombre de búsqueda predefinido.
El ejemplo esta disponible en el link :
http://terawiki.clubdelphi.com/Delph...veRegistry.rar
Nota: El ejemplo esta basado en la clave
HKEY_CURRENT_CONFIG del Registro de Windows por ser una clave poco extensa lo cual la hace apta para pruebas,
el código sugerido funciono correctamente en Delphi 7 sobre Windows 7 Professional x32,
se recomienda hacer un backup del registro antes de hacer cualquier modificación al mismo.
Espero sea útil
Nelson.