Increment a file name when the file already exists in a folder (Views: 101)


I am trying to write a simple backup utility for my projects. The utility recursivley searches folders looking for *.dpr files when it finds one it looks to see if a *.dof file is available and then extracts the FileVersion number from this, using this information it then creates a zip file with all the project files in it. It works so far and creates files like Project1-v1.0.0.0.zip. The problem is if the file already exists in the selected backup folder I wish to increment the file name so all versions are kept, e.g. if Project1-v1.0.0.0.zip already exists then generate a filename of Project1-v1.0.0.0-1.zip. If Project1-v1.0.0.0-1.zip exists then generate a file name Project1-v1.0.0.0-2.zip etc. to make sure no files are overwritten.


Variants are the easiest way of dealing with these properties.

function GetNextBackupFileName(AFolder, AFile: string): string;
  v, v1: Integer;
  Body, Ext: string;
  sr: TSearchRec;

  function FileExt(FileName: string): string;
    Result := ExtractFileExt(FileName);

  function FileBody(FileName: string): string;
    Result := ChangeFileExt(FileName, '');

  function GetPostFix(FileName: string): Integer;
    Result := StrToIntDef(Copy(FileBody(FileName), Length(Body) + 1, 255), 0);

  Result := AFile;
  v := 0;
  Body := FileBody(AFile);
  Ext := FileExt(AFile);
  if FindFirst(AFolder + Body + '*' + Ext, faAnyFile xor faDirectory, sr) = 0 then
      v1 := GetPostFix(sr.Name);
      if v1 < v then
        v := v1;
      FindNext(sr) <> 0;
    Result := Body + IntToStr(v - 1) + Ext;

Used like this:

procedure TForm1.Button1Click(Sender: TObject);
  BackupFolder, BaseFileName: string;
  BackupFolder := 'C:\BackupFolder\';
  BaseFileName := 'Project1-v1.0.0.0.zip';
  Label1.Caption := GetNextBackupFileName(BackupFolder, BaseFileName);
  FileClose(FileCreate(BackupFolder + Label1.Caption));

<< Back to main page