Link to home
Start Free TrialLog in
Avatar of mdavis1982
mdavis1982

asked on

Getting all matching filenames in a dir and all sub dirs

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
Avatar of inthe
inthe

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.

add sl.free also i missed that :)
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.
:)
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.


-------------
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 :)
ASKER CERTIFIED SOLUTION
Avatar of kretzschmar
kretzschmar
Flag of Germany image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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;
A lot of code to choose from!! :-)
Avatar of mdavis1982

ASKER

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