Ich hab die Tipps von Christian umgesetzt. Hat aber dennoch nicht funktioniert. Aber ihr habt trotzdem richtig gelegen. Ich hab ne neue Suchroutine von
Delphi-Treff: Rekursive Dateisuche genommen und siehe da: es funktioniert.
Das sieht jetzt folgendermaßen aus:
Delphi-Quellcode:
procedure GetFilesInDirectory(Directory: String; Fileobject: String;
List: TStrings;
WithSubDirs, ClearList: Boolean);
procedure ScanDir(const Directory: String);
var
SR: TSearchRec;
begin
if FindFirst(Directory + Fileobject, faAnyFile and not faDirectory, SR) = 0 then try
repeat
List.Add(Directory + SR.Name)
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
if WithSubDirs then begin
if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then try
repeat
if ((SR.attr and faDirectory) = faDirectory) and
(SR.Name <> '.') and (SR.Name <> '..') then
ScanDir(Directory + SR.Name + '\');
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
end;
end;
begin
List.BeginUpdate;
try
if ClearList then
List.Clear;
if Directory = '' then Exit;
if Directory[Length(Directory)] <> '\' then
Directory := Directory + '\';
ScanDir(Directory);
finally
List.EndUpdate;
end;
end;
procedure TForm1.btnSuchenClick(Sender: TObject);
var
Suchobjekt: String;
i, i0: Integer;
test: tmsgdlgbtn;
begin
If Edit1.Text = 'Zu durchsuchendes Verzeichnis' then
begin
OrdnerauswahlClick;
end else
If Memo1.Lines[0] = 'Bitte geben Sie das/die zu suchende(n) Objekt(e) ein!' then
begin
Showmessage('Bitte geben Sie das/die zu suchende(n) Objekt(e) ein!');
end
else
begin
screen.Cursor := crHourglass;
For i := 0 to Memo1.Lines.Count-1 do
begin
Suchobjekt := Memo1.Lines[i];
If not CheckBox1.Checked then
begin
Suchobjekt := '*' + Suchobjekt + '*';
end;
GetFilesInDirectory(Edit1.Text, Suchobjekt, clbSuchergebnisse.Items, True, False);
end;
If clbSuchergebnisse.Items.Count = 0 then
StatusBar1.Panels[0].Text := 'Es wurden keine Objekte gefunden.';
If clbSuchergebnisse.Items.Count = 1 then
StatusBar1.Panels[0].Text := 'Es wurde 1 Objekt gefunden.';
If clbSuchergebnisse.Items.Count > 1 then
StatusBar1.Panels[0].Text := 'Es wurden ' + IntToStr(clbSuchergebnisse.Items.Count)
+ ' Objekte gefunden.';
For i := Memo1.Lines.Count+1 downto 1 do
begin
For i0 := 1 to clbSuchergebnisse.Count do
begin
If Memo1.Lines[i-1] = ExtractFileName(clbSuchergebnisse.Items[i0-1]) then
begin
Memo1.Lines.Delete(i-1);
end;
end;
end;
screen.Cursor := crDefault;
end;
end;
Allerdings hängt er etwas bei längeren Listen. Also ich bin hingegangen und hab nach bestimmt 500 bis 600 Dateien suchen lassen, und wenn ich dann mal zwischendurch das Fenster wechsel und dann wieder zurückkehre, sehe ich das ganze Fenster erst mal nur in weiß, und wenn die Suche dann fertig ist, sehe ich aber alles wieder in ordentlicher Form.