Forum > General

increment filename if exists (google chrome style)

<< < (3/3)

bobonwhidbey:
The code that was presented in this thread works well when you want to create the lowest (version) number for your file. But often I want to use a version number that's one higher than the highest number. This was pointed out by Lansdowne. The FindFirst function works very well to solve this problem. Here's my code, borrowing heavily from the code in this thread, with the entire sample project attached.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Math; type   { TForm1 }   TForm1 = class(TForm)    NextBtn: TButton;    LastBtn: TButton;    Edit1: TEdit;    Msg: TLabel;    procedure ButtonClick(Sender: TObject);    procedure FormShow(Sender: TObject);  private  public  end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } type  TFileErr = (fnOK, fnInv, fnNonEx, fnNotWrit); var  aPath, aExtension: rawbytestring; function IsDirectoryWritable: TFileErr;var  Chk_FileName, S: rawbytestring;  Chk_H: THandle;begin  if (aPath <> '') and not DirectoryExists(aPath) then    exit(fnNonEx);// folder not found  Chk_FileName := aPath + 'chkazz3456.czz';  Chk_H := FileCreate(PChar(Chk_FileName), fmCreate, 438);  if Chk_H = feInvalidHandle then    exit(fnNotWrit)  // Folder Not Writeable  else  begin    // check if file can be written to    s := 'WriteSomeText';    if FileWrite(Chk_H, S[1], Length(S)) > 0 then Result := fnOK    else      exit(fnNotWrit);  // Folder Not Writeable  end;  FileClose(Chk_H);  DeleteFile(Chk_FileName);  Result := fnOK;end; function CreateUniqueFileName(InFile: rawbytestring; var OutFile: rawbytestring;  LowNum: boolean = True): TFileErr;   function LastFile: rawbytestring;  var    RetVar: boolean;    Last, L, R: integer;    SearchRec: TSearchRec;    s, Num: string;  begin     // Recursive Dir Search    s := UpperCase(InFile);    RetVar := False;    Last := 0;    if FindFirst(aPath + '*' + aExtension, faAnyFile, SearchRec) = 0 then      if UpperCase(SearchRec.Name) <> s then        while not RetVar and (FindNext(SearchRec) = 0) do        begin          s := SearchRec.Name;          L := pos('(', s);          R := pos(')', s);          if (L > 0) and (R - L > 1) then          begin            Num := copy(s, 1, R - 1);            Num := copy(Num, L + 1);            Last := max(Last, strtointDef(Num, 0));          end;          s := s;        end; // while     FindClose(SearchRec); { *Converted from FindClose* }    Result := aPath + InFile + ' (' + IntToStr(Last + 1) + ')' + aExtension;  end;   function NextAvailableFile: rawbytestring;  var    k: integer;  begin   // file exists so scan until first available is found;    k := 0;    repeat      Inc(k);      Result := aPath + InFile + ' (' + IntToStr(k) + ')' + aExtension;    until not FileExists(Result);  end; var  fn: TFileErr;begin  Result := fnOK;  if not fileexists(InFile) then    OutFile := InFile  else  begin    OutFile := '';    aPath := ExtractFilePath(InFile);    aExtension := ExtractFileExt(InFile);    InFile := ExtractFileName(ExcludeTrailingPathDelimiter(InFile));    InFile := copy(InFile, 1, length(InFile) - length(aExtension));    if InFile = '' then  exit(fnInv);// invalid file name    fn := IsDirectoryWritable;    if fn = fnNotWrit then exit(fn)    else if LowNum then      OutFile := NextAvailableFile    else      OutFile := LastFile;  end;end; procedure TForm1.ButtonClick(Sender: TObject);const  ErrMess: array[tFileErr] of string =    ('OK', 'Invalid file', 'Non-existent folder', 'File unwritable');var  aFileName, newFile: rawbytestring;  f: textfile;  b: boolean;  fn: TFileErr;begin  aFileName := Edit1.Text;  b := TButton(Sender).tag = 0;   fn := CreateUniqueFileName(aFileName, NewFile, b);  if fn = fnOK then  // gets new file name  begin    Msg.Caption := NewFile;    Assignfile(F, NewFile);    rewrite(f);    closefile(f);  end  else    Msg.Caption := ErrMess[fn];end; procedure TForm1.FormShow(Sender: TObject);begin  Msg.Caption := '';  Edit1.Text := 'test.txt';end; end.

Navigation

[0] Message Index

[*] Previous page

Go to full version