Solved

Getting all matching filenames in a dir and all sub dirs

Posted on 2002-06-04
9
463 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
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
 
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

708 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now