Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 189
  • Last Modified:

search for direcotry using mask

Hi,

I need function which will search for folder using mask and return the whole
found directory brach.
For example I have directory structure on my HDD
c:\MyDir123\Mydir456\MyDir789

While searching for Mydir4* it should return c:\MyDir123\Mydir456

Maybe someone has such function?

Regards
Tom
0
Tomazaz
Asked:
Tomazaz
  • 4
  • 3
1 Solution
 
2266180Commented:
you will write a function using findfirst/findnext for everything and call it recursivly for all subfolders and for each folder call again findfirst but with the mask. I'll do a small demo for you if you think it's out of your hands
0
 
2266180Commented:
here is the demo. this will return the first found directory. you can modify the code to return all directories found, by removing the "exit" and adding another parameter to the function of type tstrings and add all found directories to the list.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function finddir(path:string; mask:string):string;
var
  r: TSearchRec;
begin
  if (path<>'') and (path[length(path)]<>'\') then
    path:=path+'\';
  if FindFirst(Path + '*.*', faAnyFile, r) = 0 then
  begin
    if findfirst(path+mask, fadirectory, r) = 0 then
    begin
      result:=path+r.Name;
      findclose(r);
      exit;
    end;
    repeat
        if (r.Attr and faDirectory = faDirectory) then
           result:=finddir(path+r.name, mask);
    until FindNext(r) <> 0;
    FindClose(r);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  showmessage(finddir('c:\windows','sys*'));
end;

end.
0
 
TomazazAuthor Commented:
<<I'll do a small demo for you if you think it's out of your hands>>

That would be nice!
0
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!

 
TomazazAuthor Commented:
This function search only in directory which is set in path. How modify this function to search inside sub-categories also?
0
 
2266180Commented:
sorry, there is a bug in the function. I used the same searchrec variable for both searches. my bad:

here is the corrected version that also searches in subdirectories:

function finddir(path:string; mask:string):string;
var
  r,r2: TSearchRec;
begin
  if (path<>'') and (path[length(path)]<>'\') then
    path:=path+'\';
  if FindFirst(Path + '*.*', faAnyFile, r) = 0 then
  begin
    if findfirst(path+mask, fadirectory, r2) = 0 then
    begin
      result:=path+r2.Name;
      findclose(r2);
      exit;
    end;
    repeat
        if (r.Attr and faDirectory = faDirectory) then
           result:=finddir(path+r.name, mask);
    until FindNext(r) <> 0;
    FindClose(r);
  end;
end;
0
 
2266180Commented:
well, I'm a little ashaimed for this (I don't always make such mistakes).

here is the corrected AND tested version:

function finddir(path:string; mask:string):string;
var
  r,r2: TSearchRec;
begin
  result:='';
  if (path<>'') and (path[length(path)]<>'\') then
    path:=path+'\';
  if FindFirst(Path + '*.*', faAnyFile, r) = 0 then
  begin
    if findfirst(path+mask, fadirectory, r2) = 0 then
    begin
      result:=path+r2.Name;
      findclose(r2);
      exit;
    end;
    repeat
        if (r.Attr and faDirectory = faDirectory) and (r.name<>'.') and (r.name<>'..') then
        begin
           result:=finddir(path+r.name, mask);
           if result<>'' then break;
        end;
    until FindNext(r) <> 0;
    FindClose(r);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  showmessage(finddir('c:\windows','catroot*'));
end;
0
 
TomazazAuthor Commented:
Excelent.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now