需求如下說明
1. 可以定義檢查路徑，路徑需可設多個
2. 可以設定副檔名，如：jpg、png等，大小寫不分
3. 可以設定天數，例如：90、100天
4. 可以往下尋找次目錄的所有檔案，目錄可能會有很多層
5. 判斷該檔案建立的時間距離目前時間的天數
此版會刪除含以下子目錄 過期之檔案 設定時
請特別注意
下圖未勾刪除
下圖 勾刪除 按儲存後 正式刪除
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IOUtils, Types, inifiles;
type
TchkFileForm = class(TForm)
Memo1: TMemo;
Button1: TButton;
Days: TEdit;
Label1: TLabel;
Label2: TLabel;
TLabel3: TLabel;
Label3: TLabel;
FileExt: TEdit;
Label4: TLabel;
Memo2: TMemo;
Label5: TLabel;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
procedure run();
function dayDec(s,e : String):Integer;
function chkExt(ext: String):Boolean;
procedure getDirs(Path: String);
procedure getFiles(Path: String);
end;
var
chkFileForm: TchkFileForm;
myinifile:TInifile;
implementation
{$R *.dfm}
procedure TchkFileForm.Button1Click(Sender: TObject);
var
s1 : TStringList;
myFile : TextFile;
begin
// days
myinifile.writeinteger('setini','Days', strtoint(Days.Text));
// FileExt
myinifile.writestring('setini', 'FileExt', FileExt.Text);
// 正式刪除
myinifile.writebool('setini', 'isDel', CheckBox1.Checked);
//
// 路徑資料
s1:=TStringList.Create;
s1.Text:=Memo1.Text;
s1.SaveToFile('chkFilePath.txt');
s1.Free;
ShowMessage('儲存完成！');
run();
end;
procedure TchkFileForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myinifile.Destroy;
end;
procedure TchkFileForm.FormShow(Sender: TObject);
var
myFile : TextFile;
text : string;
filename:string;
begin
filename := ExtractFilePath(paramstr(0))+'chkFile.ini';
myinifile := TInifile.Create(filename);
// days
Days.Text := inttostr(myinifile.readinteger('setini', 'Days', 90));
// FileExt
FileExt.Text := myinifile.ReadString('setini', 'FileExt', 'jpg,png');
// 正式刪除
CheckBox1.Checked := myinifile.readbool('setini', 'isDel', False);
// 路徑資料
if FileExists('chkFilePath.txt') then
begin
Memo1.Lines.LoadFromFile('chkFilePath.txt');
end;
run();
end;
// 執行設定目錄
procedure TchkFileForm.run();
var
i : Integer;
Path : String;
begin
Memo2.Clear;
for i := 0 to memo1.lines.count-1 do
begin
Path := Memo1.Lines[i];
getDirs(Path)
end;
Memo2.Lines.Add('執行完成！');
end;
// 取出子目錄
procedure TchkFileForm.getDirs(Path: String);
var
dfs: TStringDynArray;
pathstr: String;
begin
if directoryexists(Path) then
begin
Memo2.Lines.Add(Path);
getFiles(Path); // 取出目錄內檔案
dfs := TDirectory.GetFileSystemEntries(Path);
for pathstr in dfs do getDirs(pathstr);
end;
end;
// 取出目錄內檔案 檢查是否預期 刪除
procedure TchkFileForm.getFiles(Path: String);
var
files : TStringDynArray;
dir : TDirectory;
fname, ext : String;
toDay,fiDay : string;
dd,sday : Integer;
begin
toDay := FormatDateTime('yyyy/mm/dd', NOW);
sday := StrToInt(Days.Text);
files := dir.GetFiles(Path);
for fname in files do
begin
ext := ExtractFileExt(fname);
if chkExt(ext) then
begin
fiDay := FormatDateTime('yyyy/mm/dd', FileDateToDateTime(FileAge(fname)));
dd := dayDec(fiDay, toDay);
if dd >= sday then
begin
Memo2.Lines.Add(fname);
if CheckBox1.Checked then
begin
Memo2.Lines.Add(ext + '=>' +fiDay + '=>' + IntToStr(dd) + ' 已刪除！');
DeleteFile(fname);
end else
begin
Memo2.Lines.Add(ext + '=>' +fiDay + '=>' + IntToStr(dd) + ' 可刪除！');
end;
end;
end;
end;
end;
// 計算日期差
function TchkFileForm.dayDec(s,e : String):Integer;
var
d1:TDate;
d2:TDate;
begin
d1:=StrToDate(s);
d2:=StrToDate(e);
Result := trunc(Double(d2)-Double(d1));
end;
// 確認副檔名
function TchkFileForm.chkExt(ext: String):Boolean;
var
a: TStringList;
x: integer;
s: String;
begin
ext := UpperCase(ext);
a := TStringList.Create;
a.StrictDelimiter := true; // Delphi7 沒有這個屬性 :~(
a.Delimiter := ','; // 指定逗點為分割字元
a.DelimitedText := FileExt.Text; // 要被分割的字串
for x:=0 to (a.Count-1) do
begin
s := '.'+UpperCase(a[x]);
if ext = s then Result := true;
end;
end;
end.
沒有留言:
張貼留言