Добрый день !
Задача - удалять все файлы по маске старше определенной даты в папке и всех ее подпапках, для этого есть:
1. Есть работающая функция удаления файлов, скажем, по маске *.txt в папке c:\111\ и всех ее подпапках (рекурсия):
Цитата:
function KillDir (Dir: AnsiString): boolean;
var
Sr: SysUtils.TSearchRec;
begin
{$I-}
if (Dir <> '') and (Dir[length(Dir)] = '\') then
Delete(Dir, length(dir), 1);
if FindFirst(Dir + '\*.*', faDirectory + faHidden + faSysFile +
faReadonly + faArchive, Sr) = 0
then
repeat
if (Sr.Name = '.') or (Sr.Name = '..') then
continue;
if (Sr.Attr and faDirectory <> faDirectory) then
begin
if AnsiLowerCase(ExtractFileExt(sr.Name)) = '.txt'
then
begin
FileSetReadOnly(Dir + '\' + sr.Name, False);
DeleteFile(Dir + '\' + sr.Name);
end
end
else
KillDir(Dir + '\' + sr.Name);
until FindNext(sr) <> 0;
FindClose(sr);
RemoveDir(Dir); // Удалит пустой каталог
KillDir := (FileGetAttr(Dir) = -1);
end;
|
Вызываем ее по кнопке:
2. И есть рабочая процедура удаления по дате создания файлов (удалять файлы старше 14 дней):
Цитата:
procedure TForm1.Button1Click(Sender: TObject);
begin
SetCurrentDir('c:\111\');
if FindFirst('*.txt', faAnyFile, searchResult) = 0 then
begin
repeat
if FileDateToDateTime(searchResult.time) <= (date-14) then
begin
deletefile(searchResult.name);
end;
until FindNext(searchResult) <> 0;
FindClose(searchResult);
end;
end;
|
ВОПРОС:
как бы в функцию добавить фильтр по дате с процедуры или в процедуре вызвать функцию так, чтобы удаление прошло полноценно.
Спасибо.