Entwickler-Ecke :: Thema anzeigen - Search SubDirectories with DirectoryMask

jcop - Mo 05.10.09 12:30
Titel: Search SubDirectories with DirectoryMask

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)

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

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

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 - 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

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

jcop - Mo 05.10.09 13:54

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.

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.

Delphi-Quelltext

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

:think: :think: :think: :think: :think: :think:

Regards,
Johan

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

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!