Solved

Getting all matching filenames in a dir and all sub dirs

Posted on 2002-06-04
9
474 Views
Last Modified: 2010-05-18
Hi...

I need to get a list of all the filenames (including the path) that match a wildcard in a directory and all its dub directories.

For example:

Given the wildcard *.mp3, and a base directory, the program should go through that base directory and all its subdirectories to get all the paths and filenames of all the matching files.  I would like this done in a reusable function so that in my code, I can write something like:

GetMatchingFiles('*.mp3', 'C:\MP3', AStringList);

The program would then put all the paths and filenames into the stringlist I passed it.

If someone could do this, it would be a VERY big help!

Thanks! :D

Matt
0
Comment
Question by:mdavis1982
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
9 Comments
 
LVL 17

Expert Comment

by:inthe
ID: 7054087
hi,
here is a example:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure GatherFiles(Const Lines: TStrings; Const Dir,Match: String);
var
Rec: TSearchRec;
Found: Integer;
Begin
// Add files
Found:= FindFirst(Dir+'\'+Match, faAnyFile, Rec);
While Found = 0 do
begin
Application.ProcessMessages;
If (Rec.Attr AND faDirectory) = 0 Then Lines.Add(Dir+'\'+Rec.Name);
Found := FindNext(Rec);
End;
FindClose(Rec);
// Find directories (Without match)
Found:= FindFirst(Dir+'\*.*', faAnyFile, Rec);
While Found = 0 do
begin
Application.ProcessMessages;
If ((Rec.Attr AND faDirectory)>0) AND
(Rec.Name<>'.') AND
(Rec.Name<>'..') Then GatherFiles(Lines,Dir+'\'+Rec.Name,Match);
Found := FindNext(Rec);
End;
FindClose(Rec);
End;

procedure TForm1.Button1Click(Sender: TObject);
var
sl : tstringlist;
begin
ComboBox1.items.Clear;
sl := tstringlist.create;
GatherFiles(sl,'C:','*.dll');
//add to comboboxbox from stringlist;
combobox1.Items.AddStrings(sl);
//or straight to combobox:
//GatherFiles(ComboBox1.Items,'C:','*.dll');
If ComboBox1.Items.Count>0 Then
ComboBox1.Text:= ComboBox1.Items[0];
ShowMessage('Found '+IntToStr(ComboBox1.Items.Count)+' matching files.');
end;

end.

0
 
LVL 17

Expert Comment

by:inthe
ID: 7054089
add sl.free also i missed that :)
0
 
LVL 1

Expert Comment

by:bes67
ID: 7054202
try this unit

unit FileSearch;

interface

uses SysUtils, Classes;

procedure GetMatchingFiles(StartDirectory: String; FileName: String; SearchResult: TStrings);

implementation

procedure GetMatchingFiles(StartDirectory:String; FileName:String; SearchResult: TStrings);
var FindList: TStringList;

procedure FileSearch(SearchString: String);
var Finished: Boolean;      
    sr: TSearchRec;  
    res: Integer;      
    path, mask, dir, newdir: string;    
begin
  Finished := false;
  dir := SearchString;
  path := ExtractFilePath(SearchString);
  mask := ExtractFileName(SearchString);
  res := FindFirst(SearchString, faAnyFile, sr);
  while res = 0 do
  begin
    if ((FileGetAttr(path + sr.Name) and faDirectory) = 0) then
        Findlist.Add(path + sr.Name);
    res := FindNext(sr);
  end;
  newdir := ExtractFilePath(SearchString) + '*.*';
  res := FindFirst(newdir, faDirectory, sr);
  while res = 0 do
  begin
    if ((sr.Name <> '.') and (sr.Name <> '..'))
    then
    begin
      newdir := ExtractFilePath(dir) + sr.Name + '\' + mask;
      FileSearch(newdir);
    end;
    res := FindNext(sr);
  end;
end;

begin
  FindList := TStringList.Create;
  try
    if StartDirectory <> '\' then
      StartDirectory := StartDirectory + '\';
    FileSearch(StartDirectory+FileName);
    SearchResult.Assign(FindList);
  finally
    FindList.Free;
  end;
end;

end.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7054917
:)
I'll also add my code ... it's been used quite a lot so it works for sure

you simply create an instance of TFileList
then call AddFiles of ParseSource
with ParseSource you can use multiple masks like : 'delph?.*;*.dp?;g??d.?xe'
AddFiles only adds only files with one mask


-----------------------



unit FileStuff_NEW;

interface

uses Windows, Classes, SysUtils, FileCtrl, ShellAPI;

type
  PFileEntry = ^TFileEntry;
  TFileEntry = packed record
    Source: string;
    Destination: string;
    Size: Integer;
  end;

  TFileList = class(TList)
  private
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    function GetItem(Index: Integer): TFileEntry;
    procedure SetItem(Index: Integer; Item: TFileEntry);
  public
    constructor Create;
    destructor Destroy;override;

    function Add(FileEntry: TFileEntry): Integer;overload;
    function Add: PFileEntry;overload;
    procedure Delete(Index: Integer);
    property Items[Index: Integer]: TFileEntry read GetItem write SetItem;
  end;


function FajlSajz(const FileName: string): Integer;
procedure AddFiles(FilesList: TFileList; const Src, Dst, Ext: string);
function ParseSource(const Source, Dest: string; FilesList: TFileList): Integer;
function GetSysIconIndex(const FileName: string; Small: Boolean = true): Integer;


implementation

{ TFileList }

constructor TFileList.Create;
begin
     inherited;
end;

destructor TFileList.Destroy;
begin
     inherited;
end;

function TFileList.Add(FileEntry: TFileEntry): Integer;
var lpFE: PFileEntry;
begin
     New(lpFE);
     lpFE^:=FileEntry;
     Result := inherited Add(lpFE);
end;

function TFileList.Add: PFileEntry;
begin
     New(Result);
     inherited Add(Result);
end;

procedure TFileList.Delete(Index: Integer);
begin
     inherited Delete(Index);
end;

procedure TFileList.Notify(Ptr: Pointer; Action: TListNotification);
begin
     if Action = lnDeleted then begin
        PFileEntry(Ptr)^.Source:='';     // clear the string references if any
        PFileEntry(Ptr)^.Destination:='';// just in case
        Dispose(Ptr);
     end;
     inherited Notify(Ptr, Action);
end;

function TFileList.GetItem(Index: Integer): TFileEntry;
begin
     Result:=PFileEntry(inherited Items[Index])^;
end;

procedure TFileList.SetItem(Index: Integer; Item: TFileEntry);
begin
     PFileEntry(inherited Items[Index])^:=Item;
end;


{ other functions }

function FajlSajz(const FileName: string): Integer;
var SR: TSearchRec;
begin
     Result:=-1;
     if FindFirst(FileName, faAnyfile xor faDirectory, SR) = 0 then begin
        Result:=SR.Size;
        FindClose(SR);
     end;
end;

procedure AddFiles(FilesList: TFileList; const Src, Dst, Ext: string);
var SR: TSearchRec;
    SrcPath: string;
begin
     SrcPath:=ExtractFilePath(Src);
     if FindFirst(Src, faAnyFile xor faDirectory, SR) = 0 then begin
        with FilesList.Add^ do begin
          Size:=SR.Size;
          Source:=SrcPath + SR.Name;
          if Ext = '' then
             Destination:=Dst + SR.Name
          else
             Destination:=Dst + ChangeFileExt(SR.Name, Ext);
        end;

        while FindNext(SR) = 0 do begin
           with FilesList.Add^ do begin
             Size:=SR.Size;
             Source:=SrcPath + SR.Name;
             if Ext = '' then
                Destination:=Dst + SR.Name
             else
                Destination:=Dst + ChangeFileExt(SR.Name, Ext);
             
           end;
        end;
        SysUtils.FindClose(SR);
     end;
end;

function ParseSource(const Source, Dest: string; FilesList: TFileList): Integer;
var
    Files: TStringList;
    Src, Dst, Ext: string;
    DstIsDir, HasWildCards: boolean;
    I: Integer;
label OneFile;
begin
     Result:=0;
     if (Source = '')or(FilesList = nil) then exit;
     FilesList.Clear;
     Files:=TStringList.Create;
     try
        Src:=Source;
        Dst:=Dest;
        DstIsDir:=DirectoryExists(Dst);
        if DstIsDir then if Dst[Length(Dst)] <> '\' then Dst:=Dst + '\';
        while Src[1] = ';' do Delete(Src, 1, 1);
        while Src[Length(Src)] = ';' do Delete(Src, Length(Src), 1);
        Files.Text:=StringReplace(Src, ';', #13#10, [rfReplaceAll]);
        HasWildCards:=((Pos('*', Src) > 0)or(Pos('?', Src) > 0));

        if Files.Count = 1 then
           if not HasWildCards then begin
              if DstIsDir then Dst:=Dst + ExtractFileName(Src);
              if FileExists(Src) then
                 with FilesList.Add^do begin
                   Source:=Src;
                   Destination:=Dst;
                   Size:=FajlSajz(Src);
                 end;
              GoTo OneFile;
           end;

        if Files.Count > 0 then begin
           if not DstIsDir then begin
              Ext:=ExtractFileExt(Dst);
              Dst:=ExtractFilePath(Dst);
           end;
           for I:=0 to Files.Count-1 do begin
               Src:=Files.Strings[I];
               AddFiles(FilesList, Src, Dst, Ext);
           end;
        end;
OneFile:
     finally
        Result:=FilesList.Count;
        FreeAndNil(Files);
     end;
end;

function GetSysIconIndex(const FileName: string; Small: Boolean = true): Integer;
const siIco: array[Boolean] of Integer = (0, SHGFI_SMALLICON);
var SFI: TSHFileInfo;
begin
     SHGetFileInfo(PChar(FileName), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or siIco[Small]);
     Result:=SFI.iIcon;
end;



end.


-------------
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 7054940
ahh sorry .. forgot about all the subdirs also :)
I can add that also if it's really important :)
you can modify it yourself ... just add a check in the AddFiles function wheter an entry is a directory if so then call ParseSource again :)
0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 400 total points
ID: 7055701
well, and my version (just as sceleton) :-))

procedure FindFile(PathFileName : string; IncludeSubDirs : Boolean);
var
 srec : TSearchRec;
 FHandle : integer;
 Path, FileName : String;
begin
Path := ExtractFilePath(PathFileName);
FileName := ExtractFileName(PathFileName);
// CurrentDirectory
if findfirst(PathFileName,faanyfile,srec) = 0 then
begin
  repeat
    If Not(srec.attr and fadirectory > 0) then
    begin

           // FileFound do something with it
           showmessage('Found :'+Path+SRec.Name);  // Here i do something, maybe fill a stringlist

    end;
  Until findnext(srec) <> 0;
end;
FindClose(SRec);
{ SubDirectories }
If IncludeSubDirs then
begin
  if FindFirst(Path+'*.*',FaAnyFile,Srec) = 0 then
  begin
    repeat
      // StartRecursion
      if not(Srec.Name[1] = '.') and (srec.attr and fadirectory > 0)then
        FindFile(Path + Srec.Name + '\' + FileName,IncludeSubDirs)
    Until findnext(srec) <> 0;
  end;
  FindClose(SRec);
end;
end;

to call

findfiles('c:\*.mp3',true);

meikl ;-)
0
 

Expert Comment

by:gavar
ID: 7056478
And here's my code

procedure enumFiles(filename:String);
begin
  // called once for every matching filename
end;

procedure GetFileList(Path,Filter:String);
var
  sr : TSearchRec;
begin
  if path[length(path)]<>'\' then path := path + '\';
  if FindFirst(path+filter, faAnyFile, sr) = 0 then
  begin
    if (sr.filename<>'.') or (sr.filename<>'..') then
       if sr.attr = faDirectory then getfilelist(path+sr.filename,filter) else enumfiles(path+sr.filename);
    while FindNext(sr) = 0 do
    begin
      if (sr.filename<>'.') or (sr.filename<>'..') then
         if sr.attr = faDirectory then getfilelist(path+sr.filename,filter) else enumfiles(path+sr.filename);
    end;
    FindClose(sr);
  end;
end;
0
 
LVL 10

Expert Comment

by:Jacco
ID: 7057127
A lot of code to choose from!! :-)
0
 

Author Comment

by:mdavis1982
ID: 7057925
Thank you!

Yours was the only answer that actually worked properly!  All the rest had a bug in which if the base directory contained nothing but Sub Directories, they didn't gather any files!

Thanks you so much...

It has been a real help...

Matt
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…

710 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question