Forum > General

increment filename if exists (google chrome style)

<< < (2/3) > >>

Handoko:
edit:
I found a bug in my code. I will post a newer version later.


This is how I will do:


--- 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; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  end; var  Form1: TForm1; implementation function GetCounter(const S: string): Integer;var  NumStr: string;  TmpStr: string;  C:      Char;begin  Result := 0;  if RightStr(S, 1) <> ')' then Exit;   NumStr := '';  TmpStr := S;  repeat    TmpStr := LeftStr(TmpStr, Length(TmpStr)-1);    C      := S[Length(TmpStr)];    if (C < '0') or (C > '9') then Break;    NumStr := C + NumStr;  until False;   if TryStrToInt(S, Result) then Exit;  Result := 0;end; function NewFile1(const S: string): string;var  Name:      string;  Extension: string;  Tail:      string;  Counter:   Integer;begin  Result    := '';  Extension := ExtractFileExt(S);  Name      := LeftStr(S, Length(S)-Length(Extension));  Counter   := 0;  repeat    case Counter > 0 of      True:  Tail := ' (' + Counter.ToString + ')';      False: Tail := '';    end;    if not(FileExists(Name + Tail + Extension)) then    begin      Result := Name + Tail + Extension;      Exit    end;    if Counter >= MaxInt then Exit;    Inc(Counter);  until False;end; function NewFile2(const S: string): string;var  Name:      string;  Extension: string;  Tail:      string;  Counter:   Integer;begin  Result    := '';  Extension := ExtractFileExt(S);  Name      := LeftStr(S, Length(S)-Length(Extension));  Counter   := GetCounter(Name);  repeat    case Counter > 0 of      True:  Tail := ' (' + Counter.ToString + ')';      False: Tail := '';    end;    if not(FileExists(Name + Tail + Extension)) then    begin      Result := Name + Tail + Extension;      Exit    end;    if Counter >= MaxInt then Exit;    Inc(Counter);  until False;end; {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);begin  ShowMessage(NewFile1('project1.lpi'));  ShowMessage(NewFile2('project1.lpi'));end; end.

- Not properly tested, may contain bug
- NewFile2 is smarter, see line #82
- Max counter is the value of MaxInt, see line #67 and #93
- Not tested on unicode characters

Lansdowne:
I have just seen Handoko's reply, and of course my shorter solution did not consider the filename extension.

so it would produce " greatest_hits.docx (1)" which is not wanted.

so in my model the extension would be need to be dealt with the same way as the "ThisDir" as a parameter to the Function.

Handoko:
This is the bug-fixed version for reply #5.


--- 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; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  end; var  Form1: TForm1; implementation function GetCounter(var S: string): Integer;var  NumStr: string;  TmpStr: string;  C:      Char;begin  Result := 0;  if RightStr(S, 1) <> ')' then Exit;   NumStr := '';  TmpStr := S;  repeat    TmpStr := LeftStr(TmpStr, TmpStr.Length-1);    C      := S[TmpStr.Length];    if (C < '0') or (C > '9') then    begin      if C <> '(' then Exit;      if TryStrToInt(NumStr, Result) then      begin        S := LeftStr(TmpStr, TmpStr.Length-1).Trim;        Exit;      end;      Result := 0;      Exit;    end;    NumStr := C + NumStr;  until TmpStr.Length <= 1;end; function NewFile1(const S: string): string;var  Name:      string;  Extension: string;  Tail:      string;  Counter:   Integer;begin  Result    := '';  Extension := ExtractFileExt(S);  Name      := LeftStr(S, S.Length - Extension.Length);  Counter   := 0;  repeat    case Counter > 0 of      True:  Tail := ' (' + Counter.ToString + ')';      False: Tail := '';    end;    if not(FileExists(Name + Tail + Extension)) then    begin      Result := Name + Tail + Extension;      Exit;    end;    if Counter >= MaxInt then Exit;    Inc(Counter);  until False;end; function NewFile2(const S: string): string;var  Name:      string;  Extension: string;  Tail:      string;  Counter:   Integer;begin  Result    := '';  Extension := ExtractFileExt(S);  Name      := LeftStr(S, S.Length - Extension.Length);  Counter   := GetCounter(Name);  repeat    case Counter > 0 of      True:  Tail := ' (' + Counter.ToString + ')';      False: Tail := '';    end;    if not(FileExists(Name + Tail + Extension)) then    begin      Result := Name + Tail + Extension;      Exit;    end;    if Counter >= MaxInt then Exit;    Inc(Counter);  until False;end; {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);begin  ShowMessage(NewFile1('project1.lpi'));  ShowMessage(NewFile2('project1.lpi'));end; end.
- Not properly tested, may contain bugs
- NewFile2 is smarter, see line #89
- Max counter is the value of MaxInt, see line #74 and #100
- Not tested on unicode characters

Josh:
Somemore code.


--- 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; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  private   public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 }function CreateUniqueFileName(Var AFileName:RawByteString):Integer;var Extracted_Path,Extracted_FileName,Extracted_Extension:RawByteString;  i:integer;begin  // using integer as result to allow for various error  // result 0 = valid name located;  1= invalid file  // you can have extra codes for various other checks not done here  if AFileName='' then  exit(1);// invalid file name  if not fileexists(AFileName) then exit(0);  // file exists so scan until not found;  // extract file properties  Extracted_Path:=ExtractFilePath(AFileName);  Extracted_Extension:=ExtractFileExt(AFileName);  Extracted_FileName:=ExtractFileName(ExcludeTrailingPathDelimiter(AFileName));  Extracted_FileName:=copy(Extracted_FileName,1,length(Extracted_FileName)-length(Extracted_Extension));  if Extracted_FileName='' then  exit(1);// invalid file name  i:=0;  repeat    inc(i);    AFileName:=Extracted_Path+Extracted_FileName+' ('+inttostr(i)+')'+Extracted_Extension;  until Not FileExists(AFileName);  result:=0;end; procedure TForm1.Button1Click(Sender: TObject);var filename:RawByteString;    f:textfile;begin  filename:='m:\testfiles\Test';  if CreateUniqueFileName(filename)=0 then  begin    ShowMessage(filename);    Assignfile(F,filename);    rewrite(f);    closefile(f);  end;end; end.  

Josh:
moded code to check for valid folders and whether folder is writeable.


--- 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; type   { TForm1 }   TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  private   public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } function CreateUniqueFileName(Var AFileName:RawByteString):Integer;const Res_OK=0;Res_Invalid_File=2;Res_Folder_Not_Exist=3;Res_Folder_Not_Writeable=5;var Extracted_Path,Extracted_FileName,Extracted_Extension:RawByteString;  i:integer;   function IsDirectoryWritable: Integer;  var    Chk_FileName,S: RawByteString;    Chk_H: THandle;  begin    if not DirectoryExists(Extracted_Path) then exit(Res_Folder_Not_Exist);// folder not found    Chk_FileName := Extracted_Path+'chkazz3456.czz';    Chk_H := FileCreate(PChar(Chk_FileName),fmCreate, 438);    if Chk_H=feInvalidHandle then result:=Res_Folder_Not_Writeable  // 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 := Res_OK      else result:=Res_Folder_Not_Writeable;  // Folder Not Writeable    end;    FileClose(Chk_H);    DeleteFile(Chk_FileName);  end; begin  // using integer as result to allow for various error  // result value matches ioresult codes  // result 0 = valid name located  // 2= invalid file  // 3=Folder Does Not Exist  // 5= Folder Not Writeable  // you can have extra codes for various other checks not done here  if AFileName='' then  exit(Res_Invalid_File);// invalid file name  // extract file properties  Extracted_Path:=ExtractFilePath(AFileName);  Extracted_Extension:=ExtractFileExt(AFileName);  Extracted_FileName:=ExtractFileName(ExcludeTrailingPathDelimiter(AFileName));  Extracted_FileName:=copy(Extracted_FileName,1,length(Extracted_FileName)-length(Extracted_Extension));  if Extracted_FileName='' then  exit(Res_Invalid_File);// invalid file name  I:=IsDirectoryWritable;  if I<>Res_OK then exit(I);  if not fileexists(AFileName) then exit(Res_OK);  // file exists so scan until not found;  i:=0;  repeat    inc(i);    AFileName:=Extracted_Path+Extracted_FileName+' ('+inttostr(i)+')'+Extracted_Extension;  until Not FileExists(AFileName);  result:=Res_OK;end; procedure TForm1.Button1Click(Sender: TObject);var filename:RawByteString;    f:textfile;begin  filename:='m:\testfiles\Test2©';  case CreateUniqueFileName(filename) of    0:begin        ShowMessage(filename);        Assignfile(F,filename);        rewrite(f);        closefile(f);      end;    2:ShowMessage('invalid file');    3:ShowMessage('Folder Does Not Exist');    5:ShowMessage('Folder Not Writeable');  end;end; end.

Navigation

[0] Message Index

[#] Next page

[*] Previous page

Go to full version