schnellere Procedure gesucht

[bluescreen25]

Hallo, kennt einer eine schnellere und komfortablere Procedure zum Auslesen von Ordnerstrukturen ?

Diese hier geht 2x durch die gleichen Strukturen und kann auch nur eine DateiMask.

Delphi-Quellcode:

procedure Tmediaarchiv_frm.FindAllFiles(RootFolder: string; Mask: string = '*.*'; Recurse: Boolean = True);
var SR: TSearchRec;
 begin
   RootFolder := IncludeTrailingPathDelimiter(RootFolder);
    if Recurse then
    if FindFirst(RootFolder + '*.*', faAnyFile, SR) = 0 then
      try
        repeat
          if not Flag_File_search_stop then
          if SR.Attr and faDirectory = faDirectory then
            // --> ein Verzeichnis wurde gefunden
            //   der Verzeichnisname steht in SR.Name
            //   der vollständige Verzeichnisname (inkl. darüberliegender Pfade) ist
            //       RootFolder + SR.Name
            if (SR.Name <> '.') and (SR.Name <> '..') then
              FindAllFiles(RootFolder + SR.Name, Mask, Recurse);
              application.ProcessMessages;
              mediaplayer_frm.search_scroll_txt.Enabled := true; //Aktivierung
              mediaplayer_frm.search_scroll_txt.visible := true;
              mediaplayer_frm.stop_search_btn.Visible := true;
        until FindNext(SR) <> 0;
      finally
        FindClose(SR);
        mediaarchiv_frm.search_files_end_timer.Enabled := true;
        mediaarchiv_frm.search_files_end_timer.Interval := 1500;
      end;
    if FindFirst(RootFolder + Mask, faAnyFile, SR) = 0 then
      try
        repeat
          if not Flag_File_search_stop then
          if SR.Attr and faDirectory <> faDirectory then
          begin
          // --> eine Datei wurde gefunden
          //   der Dateiname steht in SR.Name
          //   der vollständige Dateiname (inkl. Pfadangabe) ist
          //       RootFolder + SR.Name

          // folgende Zeile schreibt den vollständigen Namen in eine Listbox
           PlayList.Add(RootFolder + SR.Name);
           mediaplayer_frm.PlayList_ListBox.Items.add(SR.Name);
           mediaarchiv_frm.search_files_end_timer.Enabled:= false;//Verzögerung
           mediaplayer_frm.search_scroll_txt.Enabled := true; //Aktivierung
           mediaplayer_frm.search_scroll_txt.visible := true;
           mediaplayer_frm.stop_search_btn.Visible := true;
        end;
        until FindNext(SR) <> 0 ;
      finally
        FindClose(SR);
        mediaarchiv_frm.search_files_end_timer.Enabled := true;
        mediaarchiv_frm.search_files_end_timer.Interval := 1500;
      end;
 end;

[marabu]

Mein Code sieht anders aus: klick

Grüße vom marabu

EDIT: Angepasst an die verschiedenen Bedürfnisse aus deinen anderen threads kann das dann (ungetestet) so aussehen:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TDemoForm = class(TForm)
    ListBox: TListBox;
    FindButton: TButton;
    CancelButton: TButton;
    procedure FindButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
  private
    CanceledByUser: boolean;
    procedure AllFilesWithExtension(folder: string; s, ext: TStrings);
  end;

var
  DemoForm: TDemoForm;

implementation

{$R *.dfm}

procedure TDemoForm.AllFilesWithExtension(folder: string; s, ext: TStrings);
var
  sr: TSearchRec;
begin
  folder := IncludeTrailingPathDelimiter(folder);
  if FindFirst(folder + '*.*', faAnyFile, sr) = 0 then
  try
    repeat
      Application.ProcessMessages;
      if (sr.Name = '.') or (sr.Name = '..') then
        Continue
      else
      if (sr.Attr and faDirectory) = faDirectory then
        AllFilesWithExtension(folder + sr.Name, s, ext)
      else
      begin
        if ext.IndexOf(ExtractFileExt(sr.Name)) <> -1 then
          s.Add(folder + sr.Name);
      end;
    until CanceledByUser or (FindNext(sr) <> 0);
  finally
    FindClose(sr);
  end;
end;

procedure TDemoForm.FindButtonClick(Sender: TObject);
var
  ext: TStringList;
begin
  ext := TStringList.Create;
  ext.Sorted := true;
  ext.Add('.mp3');
  ext.Add('.wav');
  ListBox.Clear;
  CanceledByUser := false;
  AllFilesWithExtension('C:\', ListBox.Items, ext);
  ext.Free;
end;

procedure TDemoForm.CancelButtonClick(Sender: TObject);
begin
  CanceledByUser := true;
end;

end.

[bluescreen25]

Ui, auf den ersten Blick sieht das schon etwas anders aus, aber nur etwas...lol

Wenn ich das richtig sehe, durchläuft der auch alle Unterordner und nimmt die Files im ersten Durchlauf ?

[bluescreen25]

Hallo, kannst du mir nochmal aushelfen ?

Ich habe deine Procedure mal eingesetzt und diese füllt mir die ListBox, nur:

eigendlich soll eine TStringList (PlayList) und eine Listbox gefüllt werden, oder nur die TStringList, woraus ich mir die Listbox extrahieren kann.

Die PlayList:TStringlist erhält die Dateien inkl. Pfade, die Listbox dann nur die Dateinamen...

Die Indexe der Listen müssen natürlich übereinstimmen.

[marabu]

Hallo bluescreen25,

ich habe dir doch schon versucht zu helfen: klick

Hast du Probleme mit dem Code?

Freundliche Grüße vom marabu

[bluescreen25]

Erstmal besten Dank. Der Code läuft auf jeden Fall schonmal schneller, als mein alter.

Nach ein paar Problemen habe ich es am laufen. Das mit dem ListBox.Style = lbVirtual muss ich mir mal in Ruhe anschauen. Zugegebenermaßen bin ich noch nicht ganz fit in Delphi, mache das seit 5 Wochen. Muss mir zwischendurch immer wieder die Grundlagen durchlesen.

Playlist = TStringList
PlayList_ListBox = TListBox

Delphi-Quellcode:

procedure Tmediaarchiv_frm.Dir_to_PlayList;
var ext: TStringList;
    dir: string;
  begin
    dir := mediaplayer_frm.spSkinSelectDirectoryDialog1.Directory;
    ext := TStringList.Create;
    ext.Sorted := false;
    ext.Add('.mp3');
    ext.Add('.wav');
    Flag_File_search_stop := false;
    AllFilesWithExtension(dir,Playlist,ext);
    ext.Free;
    end;

Für die DateiMask werde ich das noch umschreiben, so das der User das in meiner Config selber einstellen kann.

Delphi-Quellcode:

procedure Tmediaarchiv_frm.AllFilesWithExtension(folder: string; s, Ext: TStrings);
var
  sr: TSearchRec;

begin
  folder := IncludeTrailingPathDelimiter(folder);
  if FindFirst(folder + '*.*', faAnyFile, sr) = 0 then
  try
    repeat
      Application.ProcessMessages;
      if (sr.Name = '.') or (sr.Name = '..') then
        Continue
      else
      if (sr.Attr and faDirectory) = faDirectory then
        AllFilesWithExtension(folder + sr.Name, s, ext)
      else
      begin
        if ext.IndexOf(ExtractFileExt(sr.Name)) <> -1 then
          s.add(folder + sr.Name);
        if ext.IndexOf(ExtractFileExt(sr.Name)) <> -1 then    // <--- das musste so 2x rein, weil er sonst die Mask in der ListBox nicht beachtet hat...keine Ahnung warum !
          mediaplayer_frm.PlayList_ListBox.Items.add(sr.Name);
        end;                                                   
    until Flag_File_search_stop or (FindNext(sr) <> 0);
  finally
    FindClose(sr);
  end;
end;

Was ich wohl verwunderlich finde, ist das wenn ich mehrmals die gleichen Ordner in die Playlist/Listbox adde, dann spielt der die angefügten Dateien, welche es oben in der der Liste schon gibt nicht ab. Hat aber nichts mit deiner Procedure zu tun, war vorher schon so.

[negaH]

Delphi-Quellcode:

procedure Tmediaarchiv_frm.AllFilesWithExtension(const Path: String; List, Extenstions: TStrings); 
var
  Tick: Cardinal;

  procedure DoSearch(const Path: String);
  var 
    SR: TSearchRec; 
  begin 
    if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then 
    try 
      repeat 
        if GetTickCount >= Tick then
        begin
          Tick := GetTickCount + 100; 
          Application.ProcessMessages;
        end;
  
        if (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then 
          DoSearch(Path + SR.Name + '\')
        else
          if Extension.IndexOf(ExtractFileExt(SR.Name)) >= 0 then
            List.Add(Path + SR.Name);

      until FindNext(SR) <> 0; 
    finally 
      FindClose(SR); 
    end; 

begin 
  List.BeginUpdate;
  try
    Tick := GetTickCount + 100;
    DoSearch(ExtractFilePath(Path) + '\');
  finally
    List.EndUpdate;
  end;
end;

Mehrere Bemerkungen:

1.) Parameter, besonders LongsString sollten CONST sein und nicht ständig geändert werden. In deinem original Code rufst du rekursiv immer den Pfad OHNE Delimiter auf und erzeugst mit Folder := IncludeTrailingPathDelimiter(folder) ständig Kopien des Strings. Bei einer Ordnerbaumtiefe von 10 Ebenen würde deine originale Routinen also 10 temporäre Strings mehr auf dem Stack speichern. Obige Methode geht anders vor indem sie von Anfang an sicher stellt das Path ein CONST ist und schon beim Aufrufe korrekt mit '\' expandiert wurde.

2.) List == mediaplayer_frm.PlayList_ListBox.Items wird mit .BeginUpdate/.EndUpdate gelockt und somit nicht ständig neu gezeichnet. Die TStrings dieser VCL Objekte wie TListBox, TMemo, TComboBox sind nur Handler um direkt auf das Windows Fenster Handle mit seiner internen Liste zuzugreifen. Das dauert alles sehr sehr lange und ist ineffizient.

3.) Ein ständiger Aufruf von Application.ProcesssMessages ist immer schlecht. Erstens weil in deinem Source der Aufruf viel zu häufig erfolgte und zweitens weil die Methode Tmediaarchiv_frm.AllFilesWithExtension() nicht mehr reentrant ist. Das bedeutet das durch den Aufruf von Application.ProcessMessages könnte der Benutzer einen Buttondrücken der dann wiederum Tmediaarchiv_frm.AllFilesWithExtension() aufruft. Es entsteht also eine "Rekursion" durch Mehrfachaufruf von Tmediaarchiv_frm.AllFilesWithExtension() die aber immer auf der gleichen Liste arbeitet !!
Man muß also sicherstellen das Tmediaarchiv_frm.AllFilesWithExtension() nicht merhfach aufgerufen werden kann, zb. indm man die Buttons disabled.

4.) if (SR.Attr and faDirectory) = faDirectory then, ist nicht nur ineffizienter sondern könnte auch fehlerhaft sein. Dies ist ein Integer-Vergleich und keine Boolsche Abfrage mehr. Falls faDirectory zb. $80000000 wäre, also das Vorzeichenbit eines Integer und SR.Attr als Integer deklariert wäre so würde es unter Umständen zb. in Delphi <= version 3 falsch Abfragen erzeugt.
Besser ist also if SR.Attr and faDirectory <> 0 then;

5.) eine Abfrage von SR.Name = '.' or SR.Name = '..' aber ohne faDirectory ist falsch. Die Bedingung lautet

"wenn Directory und Name nicht '.' und Name nicht '..'" ist dann gehe rekusiv weiter !

Deine Abfrage führt dazu das reguläre Dateien mit Namen '.' oder '..' nicht gefunden werden.
Es ist irrelevant ob laut MS-DOS oder FAT Treiber solche Dateinamen garnicht möglich sind, sie könnten unter Linux/Kylix/Unix oder Win3199 sehr wohl gültig sein.


6.) Performanceverbesserungen:
- Application.ProcessMessages nur alle 100 Millisekunden
- List.Add() führt nicht zum ständigen langsammen Neuzeichnen des GUIs, da .gelockt per .BeginUpdate, .EndUpdate
- unötige Funktion IncludeTrailingPathDelimiter() konnte entfernt werden weil der rekursive Aufrufer mit seinem schon vorhandenen Wissen den Path "in advance" korrekt formatieren kann.
- unnötige LongString Kopien von Path auf dem Stack entfernt
- Boolsche Abfrage (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') in der Reihenfolge optimiert. Falls (SR.Attr and faDirectory <> 0) nicht zutrifft wird auch nicht der langsamme Stringvergleich in (SR.Name <> '.') and (SR.Name <> '..') durchgeführt.

Gruß Hagen

[alzaimar]

Super Hagen. Ich würde aber zwei Korrekturen vornehmen;
Statt:
DoSearch(ExtractFilePath(Path) + '\'); so
DoSearch(ExtractFilePath(Path)); Weil ExtractFilePath schon den letzten Backslash liefert.

Weiterhin eventuell eine klitzekleine kosmetische Korrektur: Der rekursive Aufruf
DoSearch(Path + SR.Name + '\') kann durch
DoSearch(IncludeTrailingPathDelimiter(Path + SR.Name)) ersetzt werden. Ist eigentlich das Gleiche, aber wozu an 3 oder noch mehr Stellen annehmen, das Pfade immer mit einem '\' getrennt werden? Ich versuche, solche Annahmen im Code nicht zu verteilen, sondern, wenns denn geht, zu zentralisieren. Das genau macht 'IncludeTrailingPathDelimiter' bzw. 'IncludeTrailingBackslash', auch wenns eine µs langsamer ist.

[yankee]

wenn ich das richtig verstanden habe, werden die Dateien auf der Platte doch sowieso nicht rekursiv abgespeichert (wie auch auf einer platten Scheibe ). Also könnte Dateien mit allen Unterverzeichnissen sich das nicht zu nutze machen und einfach alle Dateien abfragen, deren Ordnerzuordnung mit etwas anfängt?
Also, falls das jetzt nicht verständlich war, versuche ich meinen Gedankengang mal etwas klarer darzustellen:

Datei 1 Ordner1\subordner1\subsubordner1
Datei 2 Ordner1\subordner2
Datei 3 Ordner1\subordner3\
Datei 4 Ordner2

So stelle ich mir vor, dass das auf der Platte abgespeichert ist.
1. Stelle ich mir das richtig vor
2. Kann man sich das dafür zunutze machen?

[xaromz]

Hallo,

Zitat von yankee:

wenn ich das richtig verstanden habe, werden die Dateien auf der Platte doch sowieso nicht rekursiv abgespeichert (wie auch auf einer platten Scheibe :-D). Also könnte Dateien mit allen Unterverzeichnissen sich das nicht zu nutze machen und einfach alle Dateien abfragen, deren Ordnerzuordnung mit etwas anfängt?
Also, falls das jetzt nicht verständlich war, versuche ich meinen Gedankengang mal etwas klarer darzustellen:

Datei 1 Ordner1\subordner1\subsubordner1
Datei 2 Ordner1\subordner2
Datei 3 Ordner1\subordner3\
Datei 4 Ordner2

So stelle ich mir vor, dass das auf der Platte abgespeichert ist.
1. Stelle ich mir das richtig vor
2. Kann man sich das dafür zunutze machen?

Rekursiv abgespeichert wird auf einer Platte erst mal gar nichts. Aber ein Dateisystem hat normalerweise tatsächlich einen Verzeichnisbaum, d. h. ein Verzeichnis ist eine Liste mit Verweisen auf weitere Verzeichnislisten (Unterverzeichnisse) und Dateien. Mach ja auch Sinn, sonst müsste man bei jedem Dateizugriff die gesamte Verzeichnisstruktur durchsuchen, so hangelt man sich einfach durch den Baum. Außerdem wäre ein Gesamtverzeichnis bei den heutigen Plattengrößen und der Dateianzahl (bei mir > 350.000) eine ganz schön große Struktur, für die ja Platz reserviert werden muss. FAT konnte früher auch nur eine bestimmte Anzahl Dateien/Verzeichnisse im Hauptverzeichnis ablegen, weil die Verzeichnisgröße fest vorgegeben war (in Unterverzeichnissen ging dann IMHO mehr).

Gruß
xaromz