档案搜寻+日期+大小+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 加入 Listprocedure 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图档...