Delphi 列举(筛选)子目录下符合档案【附例】

Purpose：运用’回呼函数Callback’，列举(筛选)子目录下符合档案
Enviro：Delphi RAD 10.4 Win 64x
//---实作下列这段话
Start by defining a type for your function/procedure
type
TMyProc = procedure(Param1: Integer);

Then you can use your procedure type anywhere, as long as your procedure's signature matches your type. To call your callback from within, you can use something like this:

procedure DoAndCallBack(MyProc: TMyProc)
begin
MyProc(1);
end;
步骤：上段话分两步骤

Step 1-1. 定义一个Type EnumProc 参数：档名、档案属性
type
TEnumProc = procedure(fNa: string; vAttr:integer; var bCont:Boolean) of object;

Step 1-2. 创建一个该类别的实体AddRec()，写码，写入要执行的事

//--- AddRec 实作TEnumProc类别， 把档案加入 List//--- 接受参数 fNa档名  vAttr档案属性procedure TfrmSeek.AddRec(fNa: string; vAttr:integer; var bCont:Boolean);begin  memo1.Lines.Add(fNa);  if vAttr = faDirectory then dirList.Add(fNa);  if (vAttr and faArchive)  <>0 then fList.Add(fNa);  bCont := True;end;

Step 2. 如何呼叫它
写一个Procedure，参数：subYes 是否包含子目录
procedure TfrmSeek.EnumFiles(subYes:Boolean; sDir, SMASK: string; Attr: Integer; AddFile: TEnumProc);
完整代码请详见 Source Code

只找一层
//--- 找现在这一层

 //--- 找现在这一层  Status := FindFirst(sDir+SMASK, faAnyFile, SRec);  try    while Status = 0 do    begin      //--- 下一行的意思是： ( 只要档案啦 )      //--- SRec.Attr 和Attr 做AND运算，如果<>0，表示有此属性      //--- 而且不是Folder ，也不是 '.' 或者'..'      if (SRec.Attr and Attr <> 0) and (FileExists(sDir + SRec.name)) and        not ((SRec.Attr and faDirectory <> 0) and ((SRec.name = '.') or (SRec.name = '..'))) then      begin        bContinue := True;        //--- 加入 List        AddRec( sDir+SRec.name, SRec.Attr ,bContinue );        if not bContinue then Break;        if flagStop then Break;      end;      //--- 继续找      Status := FindNext(SRec);      Application.ProcessMessages;    end;  finally    FindClose(SRec);  end;

再找子目录层

//--- 找子目录层  if subYes then begin     Status := FindFirst(sDir + '*.*', faDirectory, SRec);     try       while Status = 0 do       begin         //--- add to directory list         if (SRec.Attr = faDirectory) and ((SRec.Name<>'.') and (SRec.Name<>'..')) then         begin            dirList.Add(SRec.Name);            memo2.Lines.Add(sRec.Name);         end;         if (SRec.Name<>'.') and (SRec.Name<>'..') then begin            EnumFiles(subYes, sDir + SRec.name, SMASK, Attr, AddRec);         end;         //--- 继续找         Status := FindNext(SRec);         if flagStop then Break;         // 加这行才能即时中断执行         Application.ProcessMessages;       end;     finally       FindClose(SRec);     end;  end;

Step 3. 在btnGo 呼叫它
EnumFiles(subAlso,path, filter,faAnyFile, AddRec);

注：Global Variables 宣告
DirCount : integer;
dirList : TStringList;
fList : TStringList;
flagStop : Boolean; //--- 中断执行

成果： 範例 Source + Exec

2021/8/24