Recent

Author Topic: increment filename if exists (google chrome style)  (Read 719 times)

Ericktux

  • Sr. Member
  • ****
  • Posts: 257
increment filename if exists (google chrome style)
« on: May 16, 2022, 08:05:35 am »
hello friends, good day to all, a question, if I have the text:

happy_monchito

How can I make it increment as long as the same text already exists, resulting in:

happy_monchito
happy_monchito (1)
happy_monchito (2)
happy_monchito (3)

the same way google chrome does when downloading a file that already exists.

Zvoni

  • Hero Member
  • *****
  • Posts: 1221
Re: increment filename if exists (google chrome style)
« Reply #1 on: May 16, 2022, 08:39:53 am »
Check if FileExists (*hint*)
If Yes, FindAllFiles (*hint*) with that Pattern (into a StringList)
Sort the StringList
If StringList.Count>1 Then Read the last Entry of the List
    Check the "number" inside the paranthesis at the end of that entry
    Add plus 1
    Construct the "new" Filename
Else Set Filename to FileName (1)
« Last Edit: May 16, 2022, 10:18:06 am by Zvoni »
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad

Warfley

  • Hero Member
  • *****
  • Posts: 828
Re: increment filename if exists (google chrome style)
« Reply #2 on: May 16, 2022, 09:32:10 am »
This would require a custom compare function (as in string compare 2>10), which makes this actually quite complicated.

I would recommend the much easier solution, to simply count up, check if file with the current number does exist, if it doesn't use the number to create the file

Zvoni

  • Hero Member
  • *****
  • Posts: 1221
Re: increment filename if exists (google chrome style)
« Reply #3 on: May 16, 2022, 09:47:03 am »
I would recommend the much easier solution, to simply count up, check if file with the current number does exist, if it doesn't use the number to create the file
Warfly,
he would still have to check first, if the Filename without number already exists.
Then Count up, and what you said
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad

Lansdowne

  • New Member
  • *
  • Posts: 17
Re: increment filename if exists (google chrome style)
« Reply #4 on: May 16, 2022, 11:13:41 am »
This would require a custom compare function (as in string compare 2>10), which makes this actually quite complicated.

I would recommend the much easier solution, to simply count up, check if file with the current number does exist, if it doesn't use the number to create the file

I am not sure counting is necessary, nor is it foolproof.
Suppose the following files already exist:
greatest_hits
greatest_hits (1986)
greatest_hits (1987)
greatest_hits (1988)
Then the counting method would append the number 4 to the name which makes no sense.
What we would expect is either 1 (simplest non-existent name) or 1989 (so the newest name is always the highest number).

Simplest non-existent name:
Code: Pascal  [Select][+][-]
  1. function GetUniqueName(ThisDir, ThisName :string) :string);
  2. const FmtStr='%s (%d)';
  3. var sufx: integer;
  4.    TryThis: string;  //i omitted this at first
  5. begin
  6. if trim(ThisName)='' then begin
  7.    // something to do if an empty string is provided ; for example:
  8.   ThisName:='unnamed';
  9. end;
  10. if not FileExists(ThisDir+ThisName) then begin
  11.    result:=ThisName;
  12.    exit
  13. end;
  14. sufx:=0;
  15. repeat
  16.    inc(sufx);
  17.    TryThis:=Format(FmtStr,[ThisName,sufx]);
  18. until not FileExists(ThisDir+TryThis);
  19. result:=TryThis
  20. end;
  21.  
« Last Edit: May 16, 2022, 11:22:44 am by Lansdowne »

Handoko

  • Hero Member
  • *****
  • Posts: 4581
  • My goal: build my own game engine using Lazarus
Re: increment filename if exists (google chrome style)
« Reply #5 on: May 16, 2022, 11:15:44 am »
edit:
I found a bug in my code. I will post a newer version later.



This is how I will do:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   end;
  18.  
  19. var
  20.   Form1: TForm1;
  21.  
  22. implementation
  23.  
  24. function GetCounter(const S: string): Integer;
  25. var
  26.   NumStr: string;
  27.   TmpStr: string;
  28.   C:      Char;
  29. begin
  30.   Result := 0;
  31.   if RightStr(S, 1) <> ')' then Exit;
  32.  
  33.   NumStr := '';
  34.   TmpStr := S;
  35.   repeat
  36.     TmpStr := LeftStr(TmpStr, Length(TmpStr)-1);
  37.     C      := S[Length(TmpStr)];
  38.     if (C < '0') or (C > '9') then Break;
  39.     NumStr := C + NumStr;
  40.   until False;
  41.  
  42.   if TryStrToInt(S, Result) then Exit;
  43.   Result := 0;
  44. end;
  45.  
  46. function NewFile1(const S: string): string;
  47. var
  48.   Name:      string;
  49.   Extension: string;
  50.   Tail:      string;
  51.   Counter:   Integer;
  52. begin
  53.   Result    := '';
  54.   Extension := ExtractFileExt(S);
  55.   Name      := LeftStr(S, Length(S)-Length(Extension));
  56.   Counter   := 0;
  57.   repeat
  58.     case Counter > 0 of
  59.       True:  Tail := ' (' + Counter.ToString + ')';
  60.       False: Tail := '';
  61.     end;
  62.     if not(FileExists(Name + Tail + Extension)) then
  63.     begin
  64.       Result := Name + Tail + Extension;
  65.       Exit
  66.     end;
  67.     if Counter >= MaxInt then Exit;
  68.     Inc(Counter);
  69.   until False;
  70. end;
  71.  
  72. function NewFile2(const S: string): string;
  73. var
  74.   Name:      string;
  75.   Extension: string;
  76.   Tail:      string;
  77.   Counter:   Integer;
  78. begin
  79.   Result    := '';
  80.   Extension := ExtractFileExt(S);
  81.   Name      := LeftStr(S, Length(S)-Length(Extension));
  82.   Counter   := GetCounter(Name);
  83.   repeat
  84.     case Counter > 0 of
  85.       True:  Tail := ' (' + Counter.ToString + ')';
  86.       False: Tail := '';
  87.     end;
  88.     if not(FileExists(Name + Tail + Extension)) then
  89.     begin
  90.       Result := Name + Tail + Extension;
  91.       Exit
  92.     end;
  93.     if Counter >= MaxInt then Exit;
  94.     Inc(Counter);
  95.   until False;
  96. end;
  97.  
  98. {$R *.lfm}
  99.  
  100. { TForm1 }
  101.  
  102. procedure TForm1.Button1Click(Sender: TObject);
  103. begin
  104.   ShowMessage(NewFile1('project1.lpi'));
  105.   ShowMessage(NewFile2('project1.lpi'));
  106. end;
  107.  
  108. 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
« Last Edit: May 16, 2022, 11:39:37 am by Handoko »

Lansdowne

  • New Member
  • *
  • Posts: 17
Re: increment filename if exists (google chrome style)
« Reply #6 on: May 16, 2022, 11:32:43 am »
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

  • Hero Member
  • *****
  • Posts: 4581
  • My goal: build my own game engine using Lazarus
Re: increment filename if exists (google chrome style)
« Reply #7 on: May 16, 2022, 11:52:26 am »
This is the bug-fixed version for reply #5.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   end;
  18.  
  19. var
  20.   Form1: TForm1;
  21.  
  22. implementation
  23.  
  24. function GetCounter(var S: string): Integer;
  25. var
  26.   NumStr: string;
  27.   TmpStr: string;
  28.   C:      Char;
  29. begin
  30.   Result := 0;
  31.   if RightStr(S, 1) <> ')' then Exit;
  32.  
  33.   NumStr := '';
  34.   TmpStr := S;
  35.   repeat
  36.     TmpStr := LeftStr(TmpStr, TmpStr.Length-1);
  37.     C      := S[TmpStr.Length];
  38.     if (C < '0') or (C > '9') then
  39.     begin
  40.       if C <> '(' then Exit;
  41.       if TryStrToInt(NumStr, Result) then
  42.       begin
  43.         S := LeftStr(TmpStr, TmpStr.Length-1).Trim;
  44.         Exit;
  45.       end;
  46.       Result := 0;
  47.       Exit;
  48.     end;
  49.     NumStr := C + NumStr;
  50.   until TmpStr.Length <= 1;
  51. end;
  52.  
  53. function NewFile1(const S: string): string;
  54. var
  55.   Name:      string;
  56.   Extension: string;
  57.   Tail:      string;
  58.   Counter:   Integer;
  59. begin
  60.   Result    := '';
  61.   Extension := ExtractFileExt(S);
  62.   Name      := LeftStr(S, S.Length - Extension.Length);
  63.   Counter   := 0;
  64.   repeat
  65.     case Counter > 0 of
  66.       True:  Tail := ' (' + Counter.ToString + ')';
  67.       False: Tail := '';
  68.     end;
  69.     if not(FileExists(Name + Tail + Extension)) then
  70.     begin
  71.       Result := Name + Tail + Extension;
  72.       Exit;
  73.     end;
  74.     if Counter >= MaxInt then Exit;
  75.     Inc(Counter);
  76.   until False;
  77. end;
  78.  
  79. function NewFile2(const S: string): string;
  80. var
  81.   Name:      string;
  82.   Extension: string;
  83.   Tail:      string;
  84.   Counter:   Integer;
  85. begin
  86.   Result    := '';
  87.   Extension := ExtractFileExt(S);
  88.   Name      := LeftStr(S, S.Length - Extension.Length);
  89.   Counter   := GetCounter(Name);
  90.   repeat
  91.     case Counter > 0 of
  92.       True:  Tail := ' (' + Counter.ToString + ')';
  93.       False: Tail := '';
  94.     end;
  95.     if not(FileExists(Name + Tail + Extension)) then
  96.     begin
  97.       Result := Name + Tail + Extension;
  98.       Exit;
  99.     end;
  100.     if Counter >= MaxInt then Exit;
  101.     Inc(Counter);
  102.   until False;
  103. end;
  104.  
  105. {$R *.lfm}
  106.  
  107. { TForm1 }
  108.  
  109. procedure TForm1.Button1Click(Sender: TObject);
  110. begin
  111.   ShowMessage(NewFile1('project1.lpi'));
  112.   ShowMessage(NewFile2('project1.lpi'));
  113. end;
  114.  
  115. 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

  • Hero Member
  • *****
  • Posts: 938
Re: increment filename if exists (google chrome style)
« Reply #8 on: May 16, 2022, 02:17:36 pm »
Somemore code.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.  
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31. function CreateUniqueFileName(Var AFileName:RawByteString):Integer;
  32. var Extracted_Path,Extracted_FileName,Extracted_Extension:RawByteString;
  33.   i:integer;
  34. begin
  35.   // using integer as result to allow for various error
  36.   // result 0 = valid name located;  1= invalid file
  37.   // you can have extra codes for various other checks not done here
  38.   if AFileName='' then  exit(1);// invalid file name
  39.   if not fileexists(AFileName) then exit(0);
  40.   // file exists so scan until not found;
  41.   // extract file properties
  42.   Extracted_Path:=ExtractFilePath(AFileName);
  43.   Extracted_Extension:=ExtractFileExt(AFileName);
  44.   Extracted_FileName:=ExtractFileName(ExcludeTrailingPathDelimiter(AFileName));
  45.   Extracted_FileName:=copy(Extracted_FileName,1,length(Extracted_FileName)-length(Extracted_Extension));
  46.   if Extracted_FileName='' then  exit(1);// invalid file name
  47.   i:=0;
  48.   repeat
  49.     inc(i);
  50.     AFileName:=Extracted_Path+Extracted_FileName+' ('+inttostr(i)+')'+Extracted_Extension;
  51.   until Not FileExists(AFileName);
  52.   result:=0;
  53. end;
  54.  
  55. procedure TForm1.Button1Click(Sender: TObject);
  56. var filename:RawByteString;
  57.     f:textfile;
  58. begin
  59.   filename:='m:\testfiles\Test';
  60.   if CreateUniqueFileName(filename)=0 then
  61.   begin
  62.     ShowMessage(filename);
  63.     Assignfile(F,filename);
  64.     rewrite(f);
  65.     closefile(f);
  66.   end;
  67. end;
  68.  
  69. end.
  70.  
  71.  
« Last Edit: May 16, 2022, 05:56:00 pm by Josh »
Development Installation Lazarus 1.3, FPC 2.7.1,Windows 7/8 32/64, OSX, *nix

Test Environment Lazarus & FPC Trunk on Windows and OSX (Cocoa Mainly on OSX). Testing also Crosscompile windows to OSX.. 
Any posts made from 2015 will be based on Lazarus Trunk.

Josh

  • Hero Member
  • *****
  • Posts: 938
Re: increment filename if exists (google chrome style)
« Reply #9 on: May 16, 2022, 08:34:47 pm »
moded code to check for valid folders and whether folder is writeable.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.  
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. function CreateUniqueFileName(Var AFileName:RawByteString):Integer;
  33. const Res_OK=0;Res_Invalid_File=2;Res_Folder_Not_Exist=3;Res_Folder_Not_Writeable=5;
  34. var Extracted_Path,Extracted_FileName,Extracted_Extension:RawByteString;
  35.   i:integer;
  36.  
  37.   function IsDirectoryWritable: Integer;
  38.   var
  39.     Chk_FileName,S: RawByteString;
  40.     Chk_H: THandle;
  41.   begin
  42.     if not DirectoryExists(Extracted_Path) then exit(Res_Folder_Not_Exist);// folder not found
  43.     Chk_FileName := Extracted_Path+'chkazz3456.czz';
  44.     Chk_H := FileCreate(PChar(Chk_FileName),fmCreate, 438);
  45.     if Chk_H=feInvalidHandle then result:=Res_Folder_Not_Writeable  // Folder Not Writeable
  46.     else
  47.     begin
  48.       // check if file can be written to
  49.       s:='WriteSomeText';
  50.       if FileWrite(Chk_H,S[1],Length(S)) > 0 then Result := Res_OK
  51.       else result:=Res_Folder_Not_Writeable;  // Folder Not Writeable
  52.     end;
  53.     FileClose(Chk_H);
  54.     DeleteFile(Chk_FileName);
  55.   end;
  56.  
  57. begin
  58.   // using integer as result to allow for various error
  59.   // result value matches ioresult codes
  60.   // result 0 = valid name located
  61.   // 2= invalid file
  62.   // 3=Folder Does Not Exist
  63.   // 5= Folder Not Writeable
  64.   // you can have extra codes for various other checks not done here
  65.   if AFileName='' then  exit(Res_Invalid_File);// invalid file name
  66.   // extract file properties
  67.   Extracted_Path:=ExtractFilePath(AFileName);
  68.   Extracted_Extension:=ExtractFileExt(AFileName);
  69.   Extracted_FileName:=ExtractFileName(ExcludeTrailingPathDelimiter(AFileName));
  70.   Extracted_FileName:=copy(Extracted_FileName,1,length(Extracted_FileName)-length(Extracted_Extension));
  71.   if Extracted_FileName='' then  exit(Res_Invalid_File);// invalid file name
  72.   I:=IsDirectoryWritable;
  73.   if I<>Res_OK then exit(I);
  74.   if not fileexists(AFileName) then exit(Res_OK);
  75.   // file exists so scan until not found;
  76.   i:=0;
  77.   repeat
  78.     inc(i);
  79.     AFileName:=Extracted_Path+Extracted_FileName+' ('+inttostr(i)+')'+Extracted_Extension;
  80.   until Not FileExists(AFileName);
  81.   result:=Res_OK;
  82. end;
  83.  
  84. procedure TForm1.Button1Click(Sender: TObject);
  85. var filename:RawByteString;
  86.     f:textfile;
  87. begin
  88.   filename:='m:\testfiles\Test2©';
  89.   case CreateUniqueFileName(filename) of
  90.     0:begin
  91.         ShowMessage(filename);
  92.         Assignfile(F,filename);
  93.         rewrite(f);
  94.         closefile(f);
  95.       end;
  96.     2:ShowMessage('invalid file');
  97.     3:ShowMessage('Folder Does Not Exist');
  98.     5:ShowMessage('Folder Not Writeable');
  99.   end;
  100. end;
  101.  
  102. end.
« Last Edit: May 16, 2022, 11:47:27 pm by Josh »
Development Installation Lazarus 1.3, FPC 2.7.1,Windows 7/8 32/64, OSX, *nix

Test Environment Lazarus & FPC Trunk on Windows and OSX (Cocoa Mainly on OSX). Testing also Crosscompile windows to OSX.. 
Any posts made from 2015 will be based on Lazarus Trunk.

bobonwhidbey

  • Hero Member
  • *****
  • Posts: 537
    • Double Dummy Solver - free download
Re: increment filename if exists (google chrome style)
« Reply #10 on: May 20, 2022, 07:14:07 pm »
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  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Math;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     NextBtn: TButton;
  16.     LastBtn: TButton;
  17.     Edit1: TEdit;
  18.     Msg: TLabel;
  19.     procedure ButtonClick(Sender: TObject);
  20.     procedure FormShow(Sender: TObject);
  21.   private
  22.   public
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.lfm}
  31.  
  32. { TForm1 }
  33.  
  34. type
  35.   TFileErr = (fnOK, fnInv, fnNonEx, fnNotWrit);
  36.  
  37. var
  38.   aPath, aExtension: rawbytestring;
  39.  
  40. function IsDirectoryWritable: TFileErr;
  41. var
  42.   Chk_FileName, S: rawbytestring;
  43.   Chk_H: THandle;
  44. begin
  45.   if (aPath <> '') and not DirectoryExists(aPath) then
  46.     exit(fnNonEx);// folder not found
  47.   Chk_FileName := aPath + 'chkazz3456.czz';
  48.   Chk_H := FileCreate(PChar(Chk_FileName), fmCreate, 438);
  49.   if Chk_H = feInvalidHandle then
  50.     exit(fnNotWrit)  // Folder Not Writeable
  51.   else
  52.   begin
  53.     // check if file can be written to
  54.     s := 'WriteSomeText';
  55.     if FileWrite(Chk_H, S[1], Length(S)) > 0 then Result := fnOK
  56.     else
  57.       exit(fnNotWrit);  // Folder Not Writeable
  58.   end;
  59.   FileClose(Chk_H);
  60.   DeleteFile(Chk_FileName);
  61.   Result := fnOK;
  62. end;
  63.  
  64. function CreateUniqueFileName(InFile: rawbytestring; var OutFile: rawbytestring;
  65.   LowNum: boolean = True): TFileErr;
  66.  
  67.   function LastFile: rawbytestring;
  68.   var
  69.     RetVar: boolean;
  70.     Last, L, R: integer;
  71.     SearchRec: TSearchRec;
  72.     s, Num: string;
  73.   begin     // Recursive Dir Search
  74.     s := UpperCase(InFile);
  75.     RetVar := False;
  76.     Last := 0;
  77.     if FindFirst(aPath + '*' + aExtension, faAnyFile, SearchRec) = 0 then
  78.       if UpperCase(SearchRec.Name) <> s then
  79.         while not RetVar and (FindNext(SearchRec) = 0) do
  80.         begin
  81.           s := SearchRec.Name;
  82.           L := pos('(', s);
  83.           R := pos(')', s);
  84.           if (L > 0) and (R - L > 1) then
  85.           begin
  86.             Num := copy(s, 1, R - 1);
  87.             Num := copy(Num, L + 1);
  88.             Last := max(Last, strtointDef(Num, 0));
  89.           end;
  90.           s := s;
  91.         end; // while
  92.  
  93.     FindClose(SearchRec); { *Converted from FindClose* }
  94.     Result := aPath + InFile + ' (' + IntToStr(Last + 1) + ')' + aExtension;
  95.   end;
  96.  
  97.   function NextAvailableFile: rawbytestring;
  98.   var
  99.     k: integer;
  100.   begin   // file exists so scan until first available is found;
  101.     k := 0;
  102.     repeat
  103.       Inc(k);
  104.       Result := aPath + InFile + ' (' + IntToStr(k) + ')' + aExtension;
  105.     until not FileExists(Result);
  106.   end;
  107.  
  108. var
  109.   fn: TFileErr;
  110. begin
  111.   Result := fnOK;
  112.   if not fileexists(InFile) then
  113.     OutFile := InFile
  114.   else
  115.   begin
  116.     OutFile := '';
  117.     aPath := ExtractFilePath(InFile);
  118.     aExtension := ExtractFileExt(InFile);
  119.     InFile := ExtractFileName(ExcludeTrailingPathDelimiter(InFile));
  120.     InFile := copy(InFile, 1, length(InFile) - length(aExtension));
  121.     if InFile = '' then  exit(fnInv);// invalid file name
  122.     fn := IsDirectoryWritable;
  123.     if fn = fnNotWrit then exit(fn)
  124.     else if LowNum then
  125.       OutFile := NextAvailableFile
  126.     else
  127.       OutFile := LastFile;
  128.   end;
  129. end;
  130.  
  131. procedure TForm1.ButtonClick(Sender: TObject);
  132. const
  133.   ErrMess: array[tFileErr] of string =
  134.     ('OK', 'Invalid file', 'Non-existent folder', 'File unwritable');
  135. var
  136.   aFileName, newFile: rawbytestring;
  137.   f: textfile;
  138.   b: boolean;
  139.   fn: TFileErr;
  140. begin
  141.   aFileName := Edit1.Text;
  142.   b := TButton(Sender).tag = 0;
  143.  
  144.   fn := CreateUniqueFileName(aFileName, NewFile, b);
  145.   if fn = fnOK then  // gets new file name
  146.   begin
  147.     Msg.Caption := NewFile;
  148.     Assignfile(F, NewFile);
  149.     rewrite(f);
  150.     closefile(f);
  151.   end
  152.   else
  153.     Msg.Caption := ErrMess[fn];
  154. end;
  155.  
  156. procedure TForm1.FormShow(Sender: TObject);
  157. begin
  158.   Msg.Caption := '';
  159.   Edit1.Text := 'test.txt';
  160. end;
  161.  
  162. end.
Win10 64-bit / Lazarus 32-bit 2.2.2 / FPC 3.2.2

 

TinyPortal © 2005-2018