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;
步骤：上段话分两步骤

1. 定义一个类别Type，当它被呼叫时，执行某事
2. 在Procedure内呼叫它 MyProc

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