Thema: Delphi Speicherüberlauf?

Einzelnen Beitrag anzeigen

Stamper

Registriert seit: 19. Jan 2008
18 Beiträge
 
#8

Re: Speicherüberlauf?

  Alt 13. Mai 2008, 20:48
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 Verzeichnisthen
   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.
  Mit Zitat antworten Zitat