Increment a file name when the file already exists in a folder (Views: 27)
Problem/Question/Abstract: 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. Answer: Variants are the easiest way of dealing with these properties. function GetNextBackupFileName(AFolder, AFile: string): string; var v, v1: Integer; Body, Ext: string; sr: TSearchRec; function FileExt(FileName: string): string; begin Result := ExtractFileExt(FileName); end; function FileBody(FileName: string): string; begin Result := ChangeFileExt(FileName, ''); end; function GetPostFix(FileName: string): Integer; begin Result := StrToIntDef(Copy(FileBody(FileName), Length(Body) + 1, 255), 0); end; begin Result := AFile; v := 0; Body := FileBody(AFile); Ext := FileExt(AFile); if FindFirst(AFolder + Body + '*' + Ext, faAnyFile xor faDirectory, sr) = 0 then begin repeat v1 := GetPostFix(sr.Name); if v1 < v then v := v1; until FindNext(sr) <> 0; FindClose(sr); Result := Body + IntToStr(v - 1) + Ext; end; end; Used like this: procedure TForm1.Button1Click(Sender: TObject); var BackupFolder, BaseFileName: string; begin BackupFolder := 'C:\BackupFolder\'; BaseFileName := 'Project1-v1.0.0.0.zip'; Label1.Caption := GetNextBackupFileName(BackupFolder, BaseFileName); FileClose(FileCreate(BackupFolder + Label1.Caption)); end; |