2009. július 16., csütörtök
Increment a file name when the file already exists in a folder
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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése