频道分类

Delphi递归删除列表文件以外的所有文件

作者:admin 来源: 日期:2020/5/28 8:10:02 人气: 标签:

 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SearchInDir(sDirectory: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  SearchInDir('D:\其他\A我的代码\Fire\bin\VLC');
end;

procedure TForm1.SearchInDir(sDirectory: string);
var
  pSearchRec: TSearchRec; // TSearchRec是delphi为我们定义好的一个记录类型。
  // 用于记录文件的各个参数,比如大小,属性,文件名等等;
  sPath, sFile: string;
begin
  try
    // 检查目录名后面是否有'\'
    if Copy(sDirectory, Length(sDirectory), 1) <> '\' then
      sPath := sDirectory + '\'
    else
      sPath := sDirectory;

    { FindFirst 是用来寻找目标目录下的第一个文件,当成功找到文件时,返回0
      FindFirst的三个参数:1.路径与文件后缀(C:\*.*)
      2.文件类型;
      3.TSearchRec类型变量(用于储存文件的参数) }
    if FindFirst(sPath + '*.*', faAnyFile, pSearchRec) = 0 then
    begin
      repeat
        sFile := Trim(pSearchRec.Name);

        // 排除自身文件夹,与父文件夹
        if sFile = '.' then
          Continue;
        if sFile = '..' then
          Continue;

        sFile := sPath + pSearchRec.Name;

        // 文件夹的情况(递归)
        if (pSearchRec.Attr and faDirectory) <> 0 then
          SearchInDir(sFile)
        else

          // 文件的情况
          if (pSearchRec.Attr and faAnyFile) = pSearchRec.Attr then
          begin
            if Memo2.Lines.IndexOf(sFile) < 0 then
            begin
              DeleteFile(sFile);
              Memo1.Lines.add(sFile);
            end;
          end;

        { FindNext 寻找下一个
          TSearchRec(sr) 是一个文件信息的纪录,
          当FindFirst返回SearchRec时,你可以通过SearchRec.Name获取文件名,
          以及 SearchRec.Size获取文件大小等信息 }
      until FindNext(pSearchRec) <> 0;

      { FindClose 释放由FindFirst分配的内存。FindClose停止一个FindFirst/FindNext序列。
        FindClose 在16位的操作系统中没有用处,但在32位系统中是需要的,
        所以为了最大的FindFirst/FindNext序列完成的可能性应该调用FindClose结束。 }
      FindClose(pSearchRec);

    end;
  except

  end;
end;

end.