Jak oczyścić rejestr windows z niepotrzebnych i nie aktualnych plików? Proszę o kody źródłowe.
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ąć.
Danko napisał(a)
Proszę o kody źródłowe.
[rotfl] [rotfl]
aleś mnie rozbawił, a z <ort>komentażami </ort>czy bez :D
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...
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
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ść...
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;
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
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.
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]
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
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>
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
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.
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.
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.