档案搜寻+日期+大小+keyword【Delphi 附例】

延续上一篇利用call back function Enumerate搜寻子目录下档案，今天再继续完成一些功能：依日期+大小+keyword条件搜寻。 Source Code+Exe GitHub
虽然，Delphi好似已经没落了，网上找到的Delphi文章都是N年前的，不然就是英文，或简中为主。不过，温故知新，把档案的功能搞清楚、发掘 TSearchRec的用法、列举回呼的方式...这就是本文的动机。
另一个主要动机是：Windows档案总管的"搜寻"，总是让我..等很久...，常常只是简单给个keyword，游标就开始绕圈圈...当掉，不知道是为何? <如图> 可能是它想得太多? 想要总管一切? ps.还常常不能输入中文


完成的Source + exe 在此，想先睹为快的，可下载试试。
以下摘录流程、重点说明。程序画面如下

FormCreate 建立五个 TStringList 存放：目录名、档名、档大小、档日期
一个imgType 存放预设的图档类型

//--- imgType 图档类型
  imgType := TStringList.Create;
  with imgType do begin
    Append('*.JPG');
    Append('*.JPEG');
    Append('*.BMP');
    Append('*.WMF');
    Append('*.EMF');
    Append('*.PNG');
  end;

搜寻条件设定：
checkBox1 是否包括子目录，更改公用变数subAlso
chkImage 是否只搜寻图片档
rdSize 档案大小之设定
rdDate 档案日期之设定
btnCalendar 跳出 Calendar选日期
btnStop 中断搜寻 (ps.在搜寻回圈中要加 Application.ProcessMessage)

...略
 Status := FindNext(SRec);
 Application.ProcessMessages;   // 加这行  即时回应 stop

btnGoClick 启动筛选动作
列举功能主程序，如下：
code有点长，因为加上了三个筛选条件，Case xxx of 搭配if
TSearchRec 取用了 Name Size TimeStamp
再来就是 FindFirst FindNext 的运用

//--- 执行筛选的主要程序
//--- sDir 目标Folder   SMASK 筛选条件   Attr档案属性
//--- kSize 档案大小限制  AddFile执行加入动作
procedure TfrmSeeker.EnumFiles(subYes:Boolean; sDir, SMASK: string; Attr, kSize: integer; AddFile: TEnumProc);
var
  SRec: TSearchRec;
  Status   : Integer;  // 回传 0 表示有找到符合者
  bContinue: Boolean;
  theDate : TDateTime;
begin
  sDir := sDir+'\';
  // exam each valid file and invoke the callback func
  //--- 找现在的这一层
  Status := FindFirst(sDir+SMASK, faAnyFile, SRec);
  try
    While Status = 0 do
    begin
      //--- 下一行 if 的意思是： ( 只要档案 )
      //--- 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;
        //--- 大小 & 日期 之条件
        case sizeFlag of
          // size= All and 日期之三种条件
          0: begin
             if dateFlag=0 then AddRec(sDir, sRec,bContinue);
             if dateFlag=1 then begin
               if (sRec.TimeStamp>=dateBound) then
                    AddRec(sDir, sRec,bContinue);
             end;
             if dateFlag=2 then begin
               if (sRec.TimeStamp< dateBound) then
                    AddRec(sDir, sRec,bContinue);
             end;
          end;
          // size >= kSize
          1: begin
             if dateFlag=0 then begin
                if SRec.Size>= kSize*1024 then AddRec(sDir, sRec,bContinue);
             end;
             if dateFlag=1 then begin
               if (SRec.Size>= kSize*1024) and
                  (sRec.TimeStamp>=dateBound) then
                    AddRec(sDir, sRec,bContinue);
             end;
             if dateFlag=2 then begin
               if (SRec.Size>= kSize*1024) and
                  (sRec.TimeStamp< dateBound) then
                    AddRec(sDir, sRec,bContinue);
             end;

          end;

          // size < kSize
          2: begin
             if dateFlag=0 then begin
                if SRec.Size< kSize*1024 then AddRec(sDir, sRec,bContinue);
             end;
             if dateFlag=1 then begin
               if (SRec.Size< kSize*1024) and
                  (sRec.TimeStamp>=dateBound) then
                    AddRec(sDir, sRec,bContinue);
             end;
             if dateFlag=2 then begin
               if (SRec.Size< kSize*1024) and
                  (sRec.TimeStamp< dateBound) then
                    AddRec(sDir, sRec,bContinue);
             end;

          end;

       end;  // FindFirst end

       if not bContinue then Break;
       if flagStop then Break;
      End;   // If end
      //--- 继续找
      Status := FindNext(SRec);
      Application.ProcessMessages;   // 加这行  即时回应 stop
    end;    // while 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;
         //--- callback to itself
         if (SRec.Name<>'.') and (SRec.Name<>'..') then begin
            EnumFiles(subYes, sDir + SRec.name, SMASK, Attr,kSize, AddRec);
         end;
         //--- 继续找
         Status := FindNext(SRec);
         if flagStop then Break;
         // 加这行才能即时中断执行
         Application.ProcessMessages;
       end;
     finally
       FindClose(SRec);
     end;
  end;
end;

上一段，呼叫callback回呼函数 AddRec，执行加入动作。

//--- AddRec 接收参数 sRec， 把 Name, Size,Date 加入 List
procedure TfrmSeeker.AddRec(vDir: string; vRec : TSearchRec; var bCont:Boolean);
begin
  if vRec.Attr = faDirectory then dirList.Add(vRec.Name);
  if (vRec.Attr and faArchive)=0 then Exit;    // 不是档案的Exit

  ListBox1.Items.Add(vDir+vRec.Name);
  fList.Add(vRec.Name);
  fSize.Add(intToStr(round(vRec.Size/1024)));   // size KB
  fDate.Add(DateTimeToStr(vRec.TimeStamp));     // file DateTime
  bCont := True;
end;

OKAY That's all
当然，後续还可以开发其它功能：copy paste 、常用keyword存档、show图档...