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

// =================================================================
// 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;