[Delphi] Czyszczenie rejestru

0

Jak oczyścić rejestr windows z niepotrzebnych i nie aktualnych plików? Proszę o kody źródłowe.

0

To nie jest jedna funkcja - po prostu musisz wiedzieć, jakie klucze usuwać, skąd je usuwać i co w nich takiego jest (lub nie ma), że można je usunąć.

0
Danko napisał(a)

Proszę o kody źródłowe.

[rotfl] [rotfl]
aleś mnie rozbawił, a z <ort>komentażami </ort>czy bez :D

0

Swoją drogą pytanie jest ciekawe bo nigdzie nie ma jak przesukać rejestr pod kątem danej rzeczy.
A <ort>z tąd</ort> już tylko krok do sprawdzania czy w podanej ścieżce plik istnieje...

0
Opi napisał(a)

Swoją drogą pytanie jest ciekawe bo nigdzie nie ma jak przesukać rejestr pod kątem danej rzeczy.
A z tąd już tylko krok do sprawdzania czy w podanej ścieżce plik istnieje...

napisz co to jest dana rzecz, a sposób na pewno się znajdzie :P

0
Misiekd napisał(a)

napisz co to jest dana rzecz, a sposób na pewno się znajdzie :P

Załóżmy że szukamy tylko w kluczu i jego podkluczach:
HKEY_CURRENT_USER\Software danej wartości rozpoczynającej się od C:\ lub D:\

Teraz jeśli znalazł początek łańcucha C:\ to niech pobierz cały łańcuch
i sprawdzi czy istnieje plik. Jeśli na końcu ścieżki (tego łańcucha) jest \ to oznacza to (chyba) folder. Więc niech sprawdzi czy istnieje folder.
Jeśli nie istnieje folder/plik to usuń całą wartość...

0

No to prosty kodzik do tego (potrzebny Button1 oraz ListView (CheckBoxes, Report, kolumny [Plik, Klucz]):

///////////////////////////////////////////////////
procedure TForm1.Znajdz(reg: TRegistry; Key: string);
var Str:TStringList;
    i:integer;
    Path:string;
begin
Application.ProcessMessages;
if reg.OpenKeyReadOnly(Key+'\') then
  begin
  Caption:=reg.CurrentPath;
  Path:=reg.CurrentPath;
  Str:=TStringList.Create;
  reg.GetValueNames(Str);
  for i:=0 to Str.Count-1 do
    if (reg.GetDataType(Str[i]) = rdString) and (pos(':\', reg.ReadString(Str[i]))>0) then
      begin
      with (ListView1.Items.Add) do
        begin
        Caption:=reg.ReadString(Str[i]);
        SubItems.Add(reg.CurrentPath);
        Checked:=fileexists(Caption);
        end;
      end;
  reg.GetKeyNames(Str);
  reg.CloseKey;
  for i:=0 to Str.Count-1 do
    Znajdz(reg, Path+Str[i]);
  Str.Free;
  end;
end;

///////////////////////////////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
var reg:TRegistry;
begin
ListView1.Items.BeginUpdate;
reg:=TRegistry.Create;
try
  reg.RootKey:=HKEY_CURRENT_USER;
  Znajdz(reg, 'SOFTWARE');
except
  end;
reg.Free;
ListView1.Items.EndUpdate;
end;
0
Szczawik napisał(a)

No to prosty kodzik do tego (potrzebny Button1 oraz ListView (CheckBoxes, Report, kolumny [Plik, Klucz]):

to chyba nie to. Zastanów się chwile i pomyśl, co zwróci Twój kod. My mamy na myśli znaleźć np. wszystkie wartości, których dane zaczynają się od 'c:' w kluczu HKCU.

Do tego trzeba rekurencji i GetKeyNames, GetValueNames, HasSubKeys i może jeszcze GetDataInfo, GetDataSize, GetDataType, GetKeyInfo

0

O czym ty mówisz? Popatrz na ten kod - jest w nim rekurancja. A tak poza tym to on działa. Sprawdzałem i wiem, co piszę..

:]

A tak poza tym, to czy usuniesz wpisy z nieistniejącymi plikami, czy istniejące pliki zaznaczysz na liście (jak w kodzie powyżej) - to zależy już tylko od ciebie.

Poza tym warto szukać ciągu :</b> i nie koniecznie na początku, bo można trafić na jakiś cudzysłów, ciąg file://, czy coś takiego.

0

a więc tak - na samym początku masz taką linijkę

if reg.OpenKeyReadOnly(Key+'\') then

i jeśli nie ma klucza o nazwie przekazanej w zmiennej Key to się kończy działanie procedury. O to mi chodzi.

To by robiło to o co chodzi (wyszukiwanie dowolnych wartości w całym rejestrze) po drobnych modyfikacjach.

No i muszę przyznać, że za pierwszym razem nie przyjrzałem się zbyt dokładnie [wstyd]

0

Po niewielkich przeróbkach? Wystarczy jedno słowo zmienić, by przeszukac cały klucz:

try
  reg.RootKey:=HKEY_CURRENT_USER;
  Znajdz(reg, '');        //   <-------- tu podajesz klucz początkowy
except
  end;

No i oczywistym jest, że jak podasz nieistniejący klucz, to ma nic nie zwracać .

[DOPISANE]

Wciąż nie rozumem, co Ci w tej linii nie pasuje:

if reg.OpenKeyReadOnly(Key+'\') then
0

Masz stary przykład. Metod na to jest wiele - każdy praktycznie robi to na swój sposób. Ten pokazuje jak wywalić wpisy, które zawierają błędne ścieżki. Nie wyłapuje to wszystkich złych kluczy (bo zły wpis nie musi koniecznie zawierać nazwy pliku) i czasem może namieszać więc lepiej patrz co robisz.

Mam nadzieje, że się połapiesz. Kod moim zdaniem jest przejrzysty. Drobna rada - jak robisz program to takie przeszukiwania lepiej robić osobnym wątkiem.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Registry, VGrid, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    Panel2: TPanel;
    btnStart: TButton;
    btnRemove: TButton;
    edKey: TEdit;
    edTime: TEdit;
    edValueName: TEdit;
    edValue: TEdit;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; Col, Row: Integer;
      var CanSelect: Boolean);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
    fRegistry: TRegistry;
    fRowCount: Integer;
    fCurrentKeyValue: String;
    fStopFlag: Boolean;
    fNoSelection: Boolean;
    procedure DoAnalyzeRegistry;
    procedure DoAnalyzeBranch;
    procedure DoAnalyzeKey(const Key: String);
    function  DoAnalyzeValue(const Key, Value: String): Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const Root : Array[0..3] of Char = ('A', ':', '\', #0);

const
  nKeyName     = 0;
  nFileTime    = 1;
  nValueName   = 2;
  nValueString = 3;

procedure NormalizeRegistryPath(var Path: String);
begin
  if (Path = '') or (Path[1] <> '\') then
    Path := '\' + Path;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  btnStop.Enabled  := TRUE;
  fRowCount := 1;
  StringGrid1.RowCount := 2;
  StringGrid1.Cells[nKeyName, 1]     := '';
  StringGrid1.Cells[nFileTime, 1]    := '';
  StringGrid1.Cells[nValueName, 1]   := '';
  StringGrid1.Cells[nValueString, 1] := '';

  DoAnalyzeRegistry;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fRegistry := TRegistry.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  fRegistry.Free;
end;

procedure TForm1.DoAnalyzeRegistry;
begin
  fStopFlag    := FALSE;
  fNoSelection := TRUE;

  if not fStopFlag then
  begin
    fCurrentKeyValue  := 'HKEY_CURRENT_USER';
    fRegistry.RootKey := HKEY_CURRENT_USER;
    fRegistry.OpenKey('\', FALSE);
    DoAnalyzeBranch();
  end;

  if not fStopFlag then
  begin
    fCurrentKeyValue  := 'HKEY_USERS';
    fRegistry.RootKey := HKEY_USERS;
    fRegistry.OpenKey('\', FALSE);
    DoAnalyzeBranch();
  end;

  if not fStopFlag then
  begin
    fCurrentKeyValue  := 'HKEY_LOCAL_MACHINE';
    fRegistry.RootKey := HKEY_LOCAL_MACHINE;
    fRegistry.OpenKey('\Software', FALSE);
    DoAnalyzeBranch();
  end;

  StringGrid1.RowCount := fRowCount;
  StatusBar1.SimpleText := 'Number of invalid references: '+IntToStr(fRowCount - 1);
  btnStop.Enabled := FALSE;

  if fRowCount = 1 then
  begin
    MessageDlg('No invalid references detected.',mtInformation,[mbOK],0);
    btnRemove.Enabled := FALSE;
  end
  else
  begin
    btnRemove.Enabled := TRUE;
  end;

end;

procedure TForm1.DoAnalyzeBranch;
var
  I: Integer;
  Keys: TStringList;
  Path: String;
begin
  Keys := TStringList.Create;
  try
    Path := fRegistry.CurrentPath;
    fRegistry.GetKeyNames(Keys);
    for I := 0 to Keys.Count - 1 do
    begin
      if fRegistry.OpenKey(Keys[I], FALSE) then
      begin
        DoAnalyzeKey(Keys[I]);
        if fStopFlag then Break;
        if fRegistry.HasSubKeys then DoAnalyzeBranch;
      end;

      if fStopFlag then Break;

      NormalizeRegistryPath(Path);
      if not fRegistry.OpenKey(Path, FALSE) then
        raise exception.Create('Can not open key '+Path);
    end;
  finally
    Keys.Free;
  end;
end;

procedure TForm1.DoAnalyzeKey(const Key: String);
var
  I: Integer;
  Values: TStringList;
  DataType: TRegDataType;
  StringValue: String;
  RegKeyInfo: TRegKeyInfo;
  SystemTime: TSystemTime;
  StringDate: String;
begin
  Values := TStringList.Create;
  try
    fRegistry.GetValueNames(Values);
    for I := 0 to Values.Count - 1 do
    begin

      DataType := fRegistry.GetDataType(Values[I]);
      if (DataType = rdString) or (DataType = rdExpandString) then
      begin
        StatusBar1.SimpleText := 'Analyzing: '+Key;
        { Let the applocation to process messages,
          so the text would be on the status bar
          while we are still in the loop }
        Application.ProcessMessages;

        if fStopFlag then Break;

        StringValue := fRegistry.ReadString(Values[I]);

        if (not DoAnalyzeValue(Key, Values[I])) or
           (not DoAnalyzeValue(Key, StringValue)) then
        begin
          if StringGrid1.RowCount = fRowCount then
            StringGrid1.RowCount := fRowCount + 10;

          fRegistry.GetKeyInfo(RegKeyInfo);
          FileTimeToSystemTime(RegKeyInfo.FileTime, SystemTime);
          DateTimeToString(StringDate, 'mm/dd/yyyy hh:mmAM/PM', SystemTimeToDateTime(SystemTime));


          StringGrid1.Cells[nKeyName, fRowCount] := fCurrentKeyValue + ': ' +fRegistry.CurrentPath;
          StringGrid1.Cells[nFileTime, fRowCount]:= StringDate;
          StringGrid1.Cells[nValueName, fRowCount]   := Values[I];
          StringGrid1.Cells[nValueString, fRowCount] := StringValue;

          { If there is no rows selected yet then select the first one }
          if fNoSelection then
          begin
            fNoSelection := FALSE;
            StringGrid1.Selection := TGridRect(Rect(0, 1, 4, 1));
          end;

          Inc(fRowCount);
        end;
      end;
    end;
  finally
    Values.Free;
  end;
end;


function TForm1.DoAnalyzeValue(const Key, Value: String): Boolean;
var
  DriveType: UINT;
  Path: String;
  FileName: String;
begin
  Result := TRUE;

  { Verify if the string can be treated as path (and file name)}
  if Length(Value) < 3 then Exit;
  if not (UpCase(Value[1]) in ['C'..'Z']) then Exit;
  if Pos(';', Value) > 0 then Exit;
  if Pos(',', Value) > 0 then Exit;
  if Pos(' ', Value) > 0 then Exit;
  if (Value[2] <> ':') or (Value[3] <> '\') then Exit;


  Root[0] := Value[1];
  DriveType := GetDriveType(Root);
  if (DriveType = DRIVE_FIXED) then
  begin
    if (ExtractFileExt(Value) = '') then
    begin
      { No extension, try to treat the value as path }
      Path := Value;
      if (Path[Length(Path)] <> '\') then
        Path := Value + '\';

      if not SetCurrentDirectory(PChar(Path)) then
      begin
        Result := FALSE;
        Exit;
      end;
    end
    else
    begin
      Path := ExtractFilePath(Value);
      if not SetCurrentDirectory(PChar(Path)) then
      begin
        Result := FALSE;
        Exit;
      end;
      FileName := ExtractFileName(Value);
      if (GetFileAttributes(PChar(Value)) = -1) then
      begin
        Result := FALSE;
        Exit;
      end;
    end;
  end;
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  StringGrid1.Cells[nKeyName, 0] := 'Registry Key';
  StringGrid1.Cells[nFileTime, 0] := 'Last Modification';
  StringGrid1.Cells[nValueName, 0] := 'String Value';
  StringGrid1.Cells[nValueString, 0] := 'File/Path reference';
  fRowCount := 1;
  btnRemove.Enabled := FALSE;
  btnStop.Enabled := FALSE;
  fNoSelection := TRUE;
end;


procedure TForm1.btnRemoveClick(Sender: TObject);
var
  I: Integer;
  Msg: String;
  Count: Integer;
  Selection: TGridRect;
  RootKey: Longint;
  Path: String;

  procedure ParseKeyValue(const S: String);
  var
    I: Integer;
    Key: String;
  begin
    I := Pos(':', S);
    Key := Copy(S, 1, I-1);
    Path := Copy(S, I+2 , Length(S));
    NormalizeRegistryPath(Path);

    if Key = 'HKEY_CURRENT_USER' then
      RootKey := HKEY_CURRENT_USER
    else if Key = 'HKEY_USERS' then
      RootKey := HKEY_USERS
    else if Key = 'HKEY_LOCAL_MACHINE' then
      RootKey := HKEY_LOCAL_MACHINE;
  end;

begin
  Selection := StringGrid1.Selection;
  Count := Selection.Bottom - Selection.Top + 1;

  if Count = 1 then
    Msg := 'Are you sure you want to remove selected entry from the Registry?'
  else
    Msg := 'Are you sure you want to remove ' +
                   IntToStr(Selection.Bottom - Selection.Top + 1) +
                ' selected entries from the Registry?';

  if MessageDlg(Msg, mtWarning, [mbYes,mbNo], 0) = mrYes then
  begin
    for I := Selection.Top to Selection.Bottom do
    begin
      ParseKeyValue(StringGrid1.Cells[nKeyName, I]);
      fRegistry.RootKey := RootKey;

      if not fRegistry.OpenKey(Path, FALSE) then
        raise Exception.Create('Error opening registry key '+Path);

      fRegistry.DeleteValue(StringGrid1.Cells[nValueName, I]);
    end;

    { Initiate re-scanning }
    btnStartClick(self);

  end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Integer;
  var CanSelect: Boolean);
begin
  { Display values in the edit controls
    only when there is any data in the grid }
  if not (fNoSelection) then
  begin
    edKey.Text        := StringGrid1.Cells[nKeyName, Row];
    edTime.Text       := StringGrid1.Cells[nFileTime, Row];
    edValueName.Text  := StringGrid1.Cells[nValueName, Row];
    edValue.Text      := StringGrid1.Cells[nValueString, Row];
  end;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  { Set the stop flag, so the registry scanning process can stop }
  fStopFlag := TRUE;
end;

end.
</delphi>
0

Obydwa przykłady: Szczawika i Gala pracują poprawnie. Sprawdziłem z ciekawości ;)
Jednak przykład Gala jest gotowym przykładem i proponuje dodać go do artykułów o przeszukiwaniu rejestru, a jak wiecie wszędzie jest o przeszukiwaniu dysku a rejestrem nikt nie chce się pobawić :D

0

Kiedyś pisałem edytor rejestru bo mi się spodobał ten co był w pakiecie Norton (chyba od 2002 go nie dają czy od 2003). Wyszukiwanie w tle jak się edytuje rejestr, wyszukiwanie uszkodzonych części etc. Wszystko łanie i prawie skończone, ale dysk padł i mi się do tego wracać nie chciało.

Pisanie programu do czyszczenia kompa ze śmieci dla mnie nie ma sensu. Jest już tyle tego i ciągle nowe powstają. Jeden z ulubionych pomysłów młodych programistów po "chce napisać wirusa/trojana".

Co do art'a. Jestem zbyt leniwy, a i teraz studia się zaczynają. Rejestr ciekawa rzecz, ale jej nie używam w programach.

0
Misiekd napisał(a)

Do tego trzeba rekurencji i GetKeyNames, GetValueNames, HasSubKeys i może jeszcze GetDataInfo, GetDataSize, GetDataType, GetKeyInfo

Takimi tekstami tylko zniechęcasz ludzi.

0
Gal napisał(a)

Takimi tekstami tylko zniechęcasz ludzi.

to co Twoim zdaniem powinienem cały kod napisać i podać pytającemu, żeby się nie zniechęcił?? Jak ma problem a ja wiem, jakby go można rozwiązać (lub czego do tego użyć) a nie mam gdzieś całości działającej napisanej to podaje hasła żeby było wiadomo w którą stronę iść. Jeśli ktoś ma głowe na karku to po przeczytaniu opisu w helpie tych funkcji będzie wiedział jak to napisać.

Sorki jeśli uraziłem Twoją dumę takim postem, ale moje zdanie jest taki, że danie gotowca komuś to najgorsza metoda.

1 użytkowników online, w tym zalogowanych: 0, gości: 1