iT邦幫忙

0

檔案搜尋+日期+大小+keyword【Delphi 附例】

  • 分享至 

  • xImage
  •  

延續上一篇利用call back function Enumerate搜尋子目錄下檔案,今天再繼續完成一些功能:依日期+大小+keyword條件搜尋。 Source Code+Exe GitHub
雖然,Delphi好似已經沒落了,網上找到的Delphi文章都是N年前的,不然就是英文,或簡中為主。不過,溫故知新,把檔案的功能搞清楚、發掘 TSearchRec的用法、列舉回呼的方式...這就是本文的動機。
另一個主要動機是:Windows檔案總管的"搜尋",總是讓我..等很久...,常常只是簡單給個keyword,游標就開始繞圈圈...當掉,不知道是為何? <如圖> 可能是它想得太多? 想要總管一切? ps.還常常不能輸入中文
https://ithelp.ithome.com.tw/upload/images/20210901/20111373vBciEGvoq8.jpg
https://ithelp.ithome.com.tw/upload/images/20210901/20111373s4FPJTpl7h.jpg
完成的Source + exe 在此,想先睹為快的,可下載試試。
以下摘錄流程、重點說明。程式畫面如下
https://ithelp.ithome.com.tw/upload/images/20210901/20111373jqhF2ZXJBu.jpg
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圖檔...


圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

尚未有邦友留言

立即登入留言