![]() |
Neue Version von FindAllFiles
In der Codelib gibt es bereits die Funktion FindAllFiles. Jedoch liest diese funktion den Ordnerinhalt 2 mal ein, einmal um alle ordner aufzulisten für die rekursion und ein weiteres mal mit einer Maske um nur bestimmte Dateien aufzulisten. Bei Win98 welches solche Anfragen nicht cacht dauert somit das auflisten des Verzeichnisinhaltes doppelt so lange als es eigentlich müsste (und bekanntlich ist die Festplatte nicht gerade das schnellste an einem Rechner). Dementsprechend hab ich die Funktion nocheinmal nachprogrammiert.
Durch Verwendung einer InlineProcedure braucht "IncludeTrailingPathDelimiter" nur einmal aufgerufen werden und nicht bei jedem rekursiven aufruf erneut. Desweiteren kann man per parameter angeben (AddFolderNames) ob Verzeichnisnamen mit aufgelistet werden sollen. In diesem Zusammenhang kann man außerdem festlegen ob auch Verzeichnisse mit aufgelistet werden sollen wo die Maske nicht zutrifft (hat auf die Rekursion keine Auswirkung). Zusätzlich wird im Property Object von TStrings auch noch festgehalten ob es sich bei dem Eintrag um einen Ordner handelt oder nicht (das Property Object wurde dazu auf einen Boolean gecastet). Ist der Wert True so handelt es sich um einen Ordner. Somit ist es zum Beispiel möglich nur TXT-Dateien eines Ordners anzuzeigen + Unterordner. Zu beachten ist dabei das die Ordner und Dateien unsortiert sind, also nicht die Ordner ganz oben in der Liste aufgeführt sind und darunter die Dateien (würde sich aber auch noch anpassen lassen falls das jemandem sooo wichtig ist). um das ganze lauffähig zu bekommen wird noch folgende Datei benötigt: ![]()
Delphi-Quellcode:
[edit=alcaeus]Kleinen Fehler auf Wunsch korrigiert. Mfg, alcaeus[/edit]
procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
procedure LFindAllFiles(AParentFolder: String); var LSearchRec: TSearchRec; begin if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then begin repeat if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then begin if LSearchRec.Attr and faDirectory = faDirectory then begin if AddFolderNames and (IgnoreMaskAtFolderNames or Like(Mask, AnsiLowerCase(LSearchRec.Name))) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True)); if Recurse then LFindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\'); end else if Like(Mask, AnsiLowerCase(LSearchRec.Name)) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False)); end; until FindNext(LSearchRec) <> 0; FindClose(LSearchRec); end; end; begin Mask := AnsiLowerCase(Mask); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder)); end; |
DP-Maintenance
Dieses Thema wurde von "Chakotay1308" von "Neuen Beitrag zur Code-Library hinzufügen" nach "Sonstige Fragen zu Delphi" verschoben.
Quelltext ist jetzt ![]() |
Re: Neue Version von FindAllFiles
Könntest du mal bitte ein Beispiel machen, wie man deine Funktion anwendet?
Delphi-Quellcode:
Das liefert mir nur die Unterordner in dem Root Ordner, aber wo sind die Dateien?
procedure TForm1.Button1Click(Sender: TObject);
var sl : TStringList; i: Integer; begin sl := TStringList.Create; try FindAllFiles(sl, 'd:\Dokumente', '*', True, True, True); for i := 0 to sl.Count - 1 do begin ListBox1.Items.Add((sl.Strings[i])); end; finally FreeAndnIl(sl); end; end; Und das:
Delphi-Quellcode:
liefert mir gar nichts zurück.
FindAllFiles(sl, 'd:\Dokumente');
Und wo werden die Objekte wieder zerstört / freigegeben? Zitat:
|
Re: Neue Version von FindAllFiles
Hallo,
mir gehts wie Luckie:
Delphi-Quellcode:
liefert nichts zurück. Machen wir was falsch?
FindAllFiles(listbox1.items,'c:\','*',True,True,True);
Rainer |
Re: Neue Version von FindAllFiles
Zitat:
|
Re: Neue Version von FindAllFiles
Oh, da hab ich wohl beim zusammenkopieren das testen vergessen :oops: Flocke hat die Lösung (den Fehler) gepostet..
|
Re: Neue Version von FindAllFiles
Hm, so ganz war es das aber auch nicht:
Delphi-Quellcode:
Das bringt mir das CPU fenster mit einer AccesViolation. Ich kann leider mit dem CPU fenster nichts anfangen. :(
procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string = '*'; Recurse: Boolean = True;
AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True); procedure LFindAllFiles(AParentFolder: string); var LSearchRec : TSearchRec; begin if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then begin repeat if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then begin if LSearchRec.Attr and faDirectory = faDirectory then begin if AddFolderNames and (IgnoreMaskAtFolderNames or Like(Mask, AnsiLowerCase(LSearchRec.Name))) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True)); if Recurse then //FindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\'); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder)); end else if Like(Mask, AnsiLowerCase(LSearchRec.Name)) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False)); end; until FindNext(LSearchRec) <> 0; FindClose(LSearchRec); end; end; begin Mask := AnsiLowerCase(Mask); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder)); end; procedure TForm1.Button1Click(Sender: TObject); begin FindAllFiles(ListBox1.Items, 'd:\Dokumente'); //, '*', True, True, True); end; |
Re: Neue Version von FindAllFiles
Vielleicht geht es ja so:
Delphi-Quellcode:
;)
LFindAllFiles(IncludeTrailingPathDelimiter(AParentFolder + LSearchRec.Name));
|
Re: Neue Version von FindAllFiles
@fjeins: "IncludeTrailingPathDelimiter" ist nicht mehr nötig an der Stelle - das ganze wurde bewusst so geändert das der Aufruf dieser Funktion nur ein einziges mal getätigt wird.
Haub auch noch die Fehler rausgemacht:
Delphi-Quellcode:
Beispielaufruf um alle ".txt" dateien aufzulisten die auf Laufwerk C oder in unterordnern von Laufwerk C sich befinden.
procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
procedure LFindAllFiles(AParentFolder: String); var LSearchRec: TSearchRec; begin if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then begin repeat if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then begin if LSearchRec.Attr and faDirectory = faDirectory then begin if AddFolderNames and (IgnoreMaskAtFolderNames or Like(Mask, AnsiLowerCase(LSearchRec.Name))) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True)); if Recurse then LFindAllFiles(AParentFolder + LSearchRec.Name + '\'); end else if Like(Mask, AnsiLowerCase(LSearchRec.Name)) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False)); end; until FindNext(LSearchRec) <> 0; FindClose(LSearchRec); end; end; begin Mask := AnsiLowerCase(Mask); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder)); end;
Delphi-Quellcode:
Bei diesem Beispiel werden die Dateien dann in einer Listbox angezeigt.
ListBox1.Items.BeginUpdate;
FindAllFiles(ListBox1.Items, 'c:\', '*.txt', True); ListBox1.Items.EndUpdate; |
Re: Neue Version von FindAllFiles
Zitat:
So sollte es gehen:
Delphi-Quellcode:
if Recurse then
LFindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\'); |
Re: Neue Version von FindAllFiles
ich hab nochmal die richtige version in meinem Beitrag vom "12.07.2005 07:38" eingefügt.
Die falsche Zeile ist dort auch berichtigt, die Zeile wurde im ersten Beitrag versehentlich falsch geändert... @Flocke: deine Variante war fast richtig, der erste Parameter (FileList) gehört allerdings weg da er von der äußeren Procedure bereits gehalten wird und somit in der inneren nicht nötig ist. |
Re: Neue Version von FindAllFiles
Nein, ich habe deine letzte FindAllFiles Prozedur direkt kopiert und deinen Beispiel-Aufruf. Die Listbox bleibt leer und ich habe bessmmt Text-Dateien auf dem durchsuchten Laufwerk.
|
Re: Neue Version von FindAllFiles
@Luckie: ich hab das ganze heute kurz vor acht nochmal probiert nach dem ich es abgeändert hatte und es hat funktioniert. Kannst du mir dein Testprojekt mal mailen - vielleicht überseh ich ja irgendwas...
|
Re: Neue Version von FindAllFiles
Liste der Anhänge anzeigen (Anzahl: 1)
Im Anhang.
OS ist Windows 2000 SP4 mit allen Patches und drum und darn. |
Re: Neue Version von FindAllFiles
Ich hab den Fehler gefunden. Die Version von Like die ich bei mir in einer Extra-Unit hab ist schon etwas älter und dort sind die Parameter der funktion "like" vertauscht. (wer kommt nur auf die Idee die Parameter im Nachhinein zu vertauschen *grummel*). Hier jetzt die Version die mit der aktuellen "Like" funktion getestet wurde.
Delphi-Quellcode:
procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
procedure LFindAllFiles(AParentFolder: String); var LSearchRec: TSearchRec; begin if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then begin repeat if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then begin if LSearchRec.Attr and faDirectory = faDirectory then begin if AddFolderNames and (IgnoreMaskAtFolderNames or Like(AnsiLowerCase(LSearchRec.Name), Mask)) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True)); if Recurse then LFindAllFiles(AParentFolder + LSearchRec.Name + '\'); end else if Like(AnsiLowerCase(LSearchRec.Name), Mask) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False)); end; until FindNext(LSearchRec) <> 0; FindClose(LSearchRec); end; end; begin Mask := AnsiLowerCase(Mask); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder)); end; |
Re: Neue Version von FindAllFiles
Ah, jetzt geht es. Wie wäre es mit so was:
Delphi-Quellcode:
Also Suche mit mehreren Filtern?
FindAllFiles(ListBox1.Items, 'd:', '*.txt *.jpg', True);
|
Re: Neue Version von FindAllFiles
super Idee, und schon eingebaut
Delphi-Quellcode:
Als Delimiter wird "|" verwendet da dieses Zeischen nicht im Dateinamen vorkommen kann.
procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string = '*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
procedure LFindAllFiles(AParentFolder: string; AMasks: TStrings); function LIsInMasks(AFilename: String): Boolean; var LCount: Integer; begin result := False; for LCount := 0 to AMasks.Count - 1 do begin if Like(AMasks.Strings[LCount], AFilename) then begin result := True; break; end; end; end; var LSearchRec : TSearchRec; begin if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then begin repeat if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then begin if LSearchRec.Attr and faDirectory = faDirectory then begin if AddFolderNames and (IgnoreMaskAtFolderNames or LIsInMasks(AnsiLowerCase(LSearchRec.Name))) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True)); if Recurse then LFindAllFiles(AParentFolder + LSearchRec.Name + '\', AMasks); end else if LIsInMasks(AnsiLowerCase(LSearchRec.Name)) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False)); end; until FindNext(LSearchRec) <> 0; FindClose(LSearchRec); end; end; var LMasks: TStringList; begin LMasks := TStringList.Create; LMasks.Sorted := True; LMasks.Duplicates := dupIgnore; LMasks.Delimiter := '|'; LMasks.DelimitedText := AnsiLowerCase(Mask); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder), LMasks); LMasks.Free; end; Beispielaufruf (Zeigt alle *.txt und *.sys auf Laufwerk C und Unterordnern an)
Delphi-Quellcode:
ListBox1.Items.BeginUpdate;
FindAllFiles(ListBox1.Items, 'c:', '*.txt|*.sys', True); ListBox1.Items.EndUpdate; |
Re: Neue Version von FindAllFiles
Schön dass es jetzt funktioniert :thumb: (dafür dass ich "blinde" Korrekturvorschläge gegeben habe, lag ich gar nicht soooo schlecht... 8) )
Was ich noch schön/besser fände: 1. Du könntest die Suchparameter als Typ definieren, also:
Delphi-Quellcode:
Dann reduzierst du die Anzahl an Parametern und es ist später auch leicht erweiterbar, ohne dass du den Prototypen ändern musst.
TFindAllFilesOption = ( fafoRecurse, fafoAddFolderNames, fafoIgnoreMaskAtFolderNames );
TFindAllFilesOptions = set of TFindAllFilesOption 2. Das "Standard"-Trennzeichen zwischen Patterns ist das Semikolon (das nimmt auf jeden Fall der Explorer im Suchdialog), also: "*.bmp;*.jpg". Ggf. kannst du das ja noch als Parameter machen (aber dann wird die Parameterliste wieder länger). |
Re: Neue Version von FindAllFiles
ich weiß das bei windows standardmäßig ";" verwendet wird. Allerdings kann dieses Zeischen auch im Dateinamen vorkommen und ist somit nicht wirklich geeignet (keine Ahnung warum Microsoft das für die Suche verwendet hat)
|
Re: Neue Version von FindAllFiles
Kann es sein, dass du beim letzten Update (mehrere Masken) wieder die Parameter von "Like" vertauscht hast? Bei mir funktionierte deine sehr hilfreiche Funktion leider nicht.
Nachdem ich die Parameter beim Aufruf von Like vertauscht hab, funktioniert es wunderbar. Aber Hut ab, wirklich eine sehr praktische Funktion! :thumb: |
Re: Neue Version von FindAllFiles
Zitat:
|
Re: Neue Version von FindAllFiles
Ihr habt Recht, ich hatte es schon wieder vertauscht :oops:
Hier also jetzt hoffentlich wieder richtig.
Delphi-Quellcode:
procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string = '*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
procedure LFindAllFiles(AParentFolder: string; AMasks: TStrings); function LIsInMasks(AFilename: String): Boolean; var LCount: Integer; begin result := False; for LCount := 0 to AMasks.Count - 1 do begin if Like(AFilename, AMasks.Strings[LCount]) then begin result := True; break; end; end; end; var LSearchRec : TSearchRec; begin if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then begin repeat if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then begin if LSearchRec.Attr and faDirectory = faDirectory then begin if AddFolderNames and (IgnoreMaskAtFolderNames or LIsInMasks(AnsiLowerCase(LSearchRec.Name))) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True)); if Recurse then LFindAllFiles(AParentFolder + LSearchRec.Name + '\', AMasks); end else if LIsInMasks(AnsiLowerCase(LSearchRec.Name)) then FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False)); end; until FindNext(LSearchRec) <> 0; FindClose(LSearchRec); end; end; var LMasks: TStringList; begin LMasks := TStringList.Create; LMasks.Sorted := True; LMasks.Duplicates := dupIgnore; LMasks.Delimiter := '|'; LMasks.DelimitedText := AnsiLowerCase(Mask); LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder), LMasks); LMasks.Free; end; |
Re: Neue Version von FindAllFiles
Hi,
Du könntest doch anstatt der Masken und der Like einfach die ![]() mfG mirage228 |
Re: Neue Version von FindAllFiles
ich WILL den Delimter ";" nicht verwenden weil das zum Konfilikt führt wenn in einem Dateinamen ";" vorkommt oder man eben danach sucht. Ich finde es bedeutend sinnvoller einen Delimiter zu verwenden der NICHT in Dateinamen vorkommen kann... - Werd mir die Funktion mal mit anschauen, vielleicht kann man da ja irgendwas mit Delimiter setzen...
|
Re: Neue Version von FindAllFiles
Zitat:
Ich befürchte aber, dass PathMatchSpec wirklich nur den Windows Delimiter ";" erlaubt... mfG mirage228 |
Re: Neue Version von FindAllFiles
naja, so wie ich das der hilfe entnommen hab kann ich da nicht mehre Masken verwenden (';') also werd ich da wie bei der Like-Variante das für jede extension einzeln aufrufen und somit spielt der Delimiter keine Rolle. In welcher Delphiunit ist eigentlich die Funktion "PathMatchSpec" defniert?
[Edit]Hat sich erledigt, hab die Funktion selbst eingebunden[/Edit] |
Re: Neue Version von FindAllFiles
Zitat:
Delphi-Quellcode:
mfG
function PathMatchSpec(pszFile, pszSpec: PAnsiChar): BOOL; stdcall;
external 'shlwapi.dll' name 'PathMatchSpecA'; mirage228 |
Re: Neue Version von FindAllFiles
Ich kann die Funktion nicht verwenden da sie wie geahnt bereits den ";" als delimiter zulässt.
Habe ich jetzt allerdings einen Dateinamen "abcdef.txt;.sysa" und suche nach "*.txt*;.sys" so wird mir true zurück gegeben weil "*.txt*" im Dateinamen vorkommt. Das True ist allerdings falsch weil ich ja nur True zurück bekommen will wenn die Datei mit ";.sys" endet was aber nicht der fall ist. (Könnnt mich immer noch drüber aufregen das windows für sowas einen zeischen nimmt welches im Dateinamen zugelassen ist. Zusammengefasst: Folgender aufruf liefert True zurück obwohl er eigentlich false liefern müsste wenn ich ";" nicht als Delimiter verwenden will.
Delphi-Quellcode:
@mirage228: Dein Import war fast richtig. Wie bei fast allen Funktionen gibt es aber eine Ascii-Variante und vermutlichd ann auch noch eine Widestring variante - also muss der import so aussehen damit es funktioniert
PathMatchSpecA('abcdef.txt;.sysa', '*.txt*;.sys')
Delphi-Quellcode:
function PathMatchSpecA(AFilename: PChar; AMask: PChar): Boolean; stdcall external 'shlwapi.dll';
|
Re: Neue Version von FindAllFiles
Zitat:
Schau Dir mal den letzten Abschnitt mit name 'PathMatchSpecA' an ;) Abgeshen davon hast Du natürlich bezüglich des Delimiters recht. Aber wenn Du die Funktion nur intern im Programm brauchst, um z.B. irgendwelche Erweiterungs-DLLs zu suchen, geht das natürlich auch. mfG mirage228 |
Re: Neue Version von FindAllFiles
uj, du hast recht, da hab ich mal wieder nicht richtig hingeschaut wie schon so oft bei Dingen aus diesem Thread... Aber schön zu wissen das es von der Api-Seite her da eine Funktion gibt die man für andere Sachen verwenden kann wo der Delimiter nicht so wichtig ist. (Wenn die Begrenzung auf MaxPath nicht wäre und auch der Delimiter nicht könnte man die Funktion noch supi für normale Texte verwenden, aber leider ist dem ja nicht so)
|
Re: Neue Version von FindAllFiles
könntet ihr der übersichtlichkeits halber mal noch ein projekt in einem archiv posten was einfach bei Button1Click die dateien und ordner eines verzeichnisses listet ?
PS: bei mir fehlt ihm nämlich immer irgendne drivetools.dcu ! |
Re: Neue Version von FindAllFiles
Liste der Anhänge anzeigen (Anzahl: 1)
Hi, hier mal ein kleine Beispielprojekt, welches funktioniert.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:16 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz