Search SubDirectories with DirectoryMask

jcop · Beiträge: 27 WinXP, Vista Delphi 2009, Vb.NET

Hallo ,

I'm looking for a method to search subdirectories, Following is something that I've already figured out. (found on the about.delphi website)

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

procedure GetSubDirectories(const directory : string; list : TStrings) ;
var
  sr : TSearchRec;
begin
  try
    if FindFirst(IncludeTrailingPathDelimiter(directory) + '*.*', faDirectory, sr) < 0 then
      Exit
    else
    repeat
      if ((sr.Attr and faDirectory <> 0) AND (sr.Name <> '.') AND (sr.Name <> '..')) then
        List.Add(IncludeTrailingPathDelimiter(directory) + sr.Name) ;
    until FindNext(sr) <> 0;
  finally
    SysUtils.FindClose(sr) ;
  end;
end;

Now when I call this procedure with the default

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

GetSubDirectories(sAcFolder, sl) ;
        
        ShowMessage('Number of subfolders in ' + sAcFolder + ': ' + IntToStr(sl.Count)) ;
        MyDetAcFrame.cmb_Texture.items.clear;
        for iACTexFol := 0 to sl.Count - 1 do
          MyDetAcFrame.cmb_Texture.items.Add(sl[iACTexFol]);
          inc(iACTexFol);

then I get all directories which are located under sAcFolder. But Now I want to create adirectorymask so only directories starting with "texture.*" get listed. I know I can add this mask inside the main getsubdirectories procedure but I want this to be as general as possible cause I want to add other masks also. I've also tried to add another string to the getsubdirecties something like this

markieren

Delphi-Quelltext

1:	procedure GetSubDirectories(const directory, DirMask: string; list: TStrings);

and replace the '*.*' with the DirMask but this doesn't work.

kind regards,
Johan

Moderiert von Narses: Überflüssige Zeilenumbrüche/Leerzeilen entfernt.

Narses · Verfasst: Mo 05.10.09 13:37

Moin!

jcop hat folgendes geschrieben :

But Now I want to create adirectorymask so only directories starting with "texture.*" get listed. I know I can add this mask inside the main getsubdirectories procedure but I want this to be as general as possible cause I want to add other masks also. I've also tried to add another string to the getsubdirecties something like this

markieren

Delphi-Quelltext

1:	procedure GetSubDirectories(const directory, DirMask: string; list: TStrings);

and replace the '*.*' with the DirMask but this doesn't work.

Was heisst denn "geht nicht" genau?

Zeig doch mal deinen Code. :idea:

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

jcop · Beiträge: 27 WinXP, Vista Delphi 2009, Vb.NET

Moin!

Just ignore this message, after reading your reply it stroke me :think:

that this actually works, but I only added 'texture' as a search reference, hence I always ended up with 1 match, but since my folders are named "texture", "texture.1", "texture.2". I had to change the dirmask to 'texture*.*' now this is working.

Full code below.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

procedure GetSubDirectories(const directory, Dirmask : string; list : TStrings) ;
var
  sr : TSearchRec;
begin
  try
    if FindFirst(IncludeTrailingPathDelimiter(directory) + (Dirmask), faDirectory, sr) < 0 then
      Exit
    else
    repeat
      if ((sr.Attr and faDirectory <> 0) AND (sr.Name <> '.') AND (sr.Name <> '..')) then
        List.Add(IncludeTrailingPathDelimiter(directory) + sr.Name) ;
    until FindNext(sr) <> 0;
  finally
    SysUtils.FindClose(sr) ;
  end;
end;

Use following to use the getsubdirectories.

markieren

Delphi-Quelltext

1:	GetSubDirectories(sAcFolder, 'Texture.', sl) ;

Regards,
Johan

Moderiert von Narses: Überflüssige Zeilenumbrüche/Leerzeilen entfernt.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme