delphi 删除指定目录下指定日期之前所有文件

最新推荐文章于 2021-05-07 15:08:14 发布

3cts

最新推荐文章于 2021-05-07 15:08:14 发布

阅读量2.8k

点赞数

分类专栏： Delphi技术文章标签： delphi integer string function exe 磁盘

本文链接：https://blog.csdn.net/3cts/article/details/7552331

版权

Delphi技术专栏收录该内容

7 篇文章 0 订阅

订阅专栏

前几天发现客户的图片目录已经超过 60G.。。。磁盘只有 63G.。。。

需要删除指定日期之前的所有图片，保留最近20天左右的图片

要是进目录来删，那是找死，虽然全部不是在同一个目录，但也有成千上万个子目录。找时间来删除肯定是白痴。

用bat? 虽然说可以，只不过，有时候删得相当离谱。

想来想去，只有弄个delphi exe来删除。没想到，速度还蛮快的。又不卡。

程序界面简单如上

以下是相关源码

function  tform1.listmypath(p:string;d:string):string;
var
  r:TsearchRec;
  ret:integer;
  ds,d1,d2,d3:string;
  cdt,chkd:Tdatetime;

begin
   ret:=findfirst(p+'\'+'*.*',faanyfile,r);
   while ret=0 do
   begin
      if r.attr=fadirectory then
      begin
        if (r.name<>'.') and (r.Name<>'..') then
        begin
          //logs.lines.add('正在进入目录:'+r.name+'进行文件检查....');
          listmypath(p+'\'+r.name,d);
        end;
      end
      else
      begin
         ds:=p+'\'+r.name;
         cdt:=GetFilesTime(ds, 0);
         chkd:=strtodatetime(d);

         d1:=datetostr(cdt);
         d2:=datetostr(GetFilesTime(ds, 1));
         d3:=datetostr(GetFilesTime(ds, 2));


         if cdt<chkd then
         begin
            application.ProcessMessages;
            abc.text:='正在删除文件:'+r.name+',创建时间:'+d1;
            tcount:=tcount+1;
            deletefile(ds);
         end;

      end;
      ret:=findnext(r);
   end;
   findclose(r);

end;

function tform1.GetFilesTime(sFilename: String; Timetype: Integer): TDateTime;
var
  ffd: TWin32FindData;
  dft: DWord;
  lft, Time: TFileTime;
  sHandle: THandle;
begin
  sHandle:= Windows.FindFirstFile(PChar(sFileName), ffd);
  if (sHandle <>INVALID_HANDLE_VALUE) then
    begin
      case Timetype of
        0: Time:= ffd.ftCreationTime;
        1: Time:= ffd.ftLastWriteTime;
        2: Time:= ffd.ftLastAccessTime;
      end;
    Windows.FindClose(sHandle);
    FileTimeToLocalFileTime(Time, lft);
    FileTimeToDosDateTime(lft, LongRec(dft).HI, LongRec(dft).Lo);
    Result:= FileDateToDateTime(dft);
  end else Result:= 0;
end;

procedure TForm1.btdelClick(Sender: TObject);
var
pat:string;
pad:string;

begin
   pat:=opa.Text;
   pad:=opd.Text; //用于比较的字符串。
   logs.clear;
   logs.lines.add('正在查询 目录下 '+pat+' 所有文件');
   if pad<>'' then
   begin
   listmypath(pat,pad);
   end;
   abc.text:='总计:'+inttostr(tcount)+'文件已删除!';
   
end;

大概思路是，递归进入各个子目录。如果是目录，则进去子目录。如果不是，则直接进行比较日期之后，进行删除操作。

其中提取到这个文件的准确创建日期这一块可能费了点时间。就是不想直接用r.finddata 里头的东西。太烦人。

也没有多少技术，就是方便我自己罢了。