Title: Delete Files from FileMask older than X days
Question: This function was prompted by the new MS SQL Express 2005 Database which does not include a SQL Agent that can set up Database Maintenance Plans. This means that it does not have the functionality to delete backup files older than X number of days automatically.
I have written function PurgeFiles() that can perfom this task.
function PurgeFiles(const AFileMask : string; AOlderThanDays : word; AFailOnError : boolean = false) : integer;
Delete files (AFileMask) from a directory that are older than AOlderThanDays days.
Returns number of files deleted, but will raise an exception if unable to delete a file (eg. Read Only attribute) if AFailOnError is true.
NOTE : AOlderThanDays = 0 will delete ALL files matching mask
Examples
// No Error Check
iDel : integer;
iDel := PurgeFiles('c:\temp\*.txt',7); // Delete all txt files older than 7 days
// With Error check
try
iDel := PurgeFiles('c:\temp\*.bak,20,true);
except
// handle your error here
end
Answer:
// =================================================================
// Delete files (mask) from a directory that are older than X days
// Returns number of files deleted, but will raise an exception if
// unable to delete a file (eg. Read Only attribute) if
// AFailOnError is true.
//
// NOTE : AOlderThanDays = 0 will delete ALL files matching mask
// =================================================================
uses Windows,SysUtils;
function PurgeFiles(const AFileMask : string; AOlderThanDays : word;
AFailOnError : boolean = false) : integer;
var rDirInfo : TSearchRec;
iResult,iError : integer;
dtFileDate,dtNow : TDateTime;
sFilePath,sErrMess : string;
begin
iResult := 0;
dtNow := Date;
sFilePath := ExtractFilePath(AFileMask);
iError := FindFirst(AFileMask,faAnyFile,rDirInfo);
// Itterate thru files found with mask
while iError = 0 do begin
// Eclude Directories
if (rDirInfo.Name '.') and (rDirInfo.Name '..') and
(rDirInfo.Attr and faDirectory faDirectory) then begin
dtFileDate := FileDateToDateTime(rDirInfo.Time);
// Does the file meet deletion days criteria ?
if trunc(dtNow - dtFileDate) + 1 AOlderThanDays then begin
// Delete the file - raise exception if fail and AFailOnError set
if not DeleteFile(sFilePath + rDirInfo.Name) and
AFailOnError then begin
sErrMess := 'PurgFiles() Failed on file' + #13#10 +
sFilePath + rDirInfo.Name + #13#10#13#10 +
SysErrorMessage(GetLastError);
raise Exception.Create(sErrMess);
end;
inc(iResult);
end;
end;
iError := FindNext(rDirInfo);
if iError 0 then FindClose(rDirInfo); // Release FindFirt Allocs
end;
Result := iResult;
end;