Recent

Author Topic: CopyDirTree bug?  (Read 3583 times)

M.A.R.C.

  • Jr. Member
  • **
  • Posts: 68
CopyDirTree bug?
« on: September 22, 2016, 02:34:58 am »
Create a new project, drop a Tbutton and add this to its click event:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. begin
  3.   if not CopyDirTree('C:\Temp\dir1','C:\Temp\dir2') then
  4.     ShowMessage('The folder could not be copied.');
  5. end;
  6.  


Create C:\Temp\dir1 and C:\Temp\dir2, put some files in dir1. Compile, Run and click the button. The contents of dir1 are not copied to dir2.

Windows 10 x64, Lazarus 1.6

Regards,

MRisco.


GetMem

  • Hero Member
  • *****
  • Posts: 3355
Re: CopyDirTree bug?
« Reply #1 on: September 22, 2016, 07:02:11 am »
It works fine for me. Insufficient privileges perhaps? Try this:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. begin
  3.   if not CopyDirTree('C:\Temp\dir1','C:\Temp\dir2') then
  4.     ShowMessage(SysErrorMessage(GetLastOSError));  
  5. end;

ASerge

  • Hero Member
  • *****
  • Posts: 1796
Re: CopyDirTree bug?
« Reply #2 on: September 22, 2016, 03:00:06 pm »
Create C:\Temp\dir1 and C:\Temp\dir2, put some files in dir1. Compile, Run and click the button. The contents of dir1 are not copied to dir2.
It looks like bug
CopyDirTree source Lazaruz 1.6
Code: Pascal  [Select][+][-]
  1. function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;
  2. var
  3.   Searcher: TCopyDirTree;
  4.   RelPath: String;
  5.   B: Boolean;
  6. begin
  7.   Result:=False;
  8.   Searcher:=TCopyDirTree.Create;
  9.   try
  10.     // Destination directories are always created. User setting has no effect!
  11.     Flags:=Flags+[cffCreateDestDirectory];
  12.     Searcher.FFlags:=Flags;
  13.     Searcher.FCopyFailedCount:=0;
  14.     Searcher.FSourceDir:=LazFileUtils.TrimFilename(SetDirSeparators(SourceDir));
  15.     Searcher.FTargetDir:=LazFileUtils.TrimFilename(SetDirSeparators(TargetDir));
  16.  
  17.     // Don't even try to copy to a subdirectory of SourceDir.
  18.     B := TryCreateRelativePath(LazFileUtils.ExpandFilenameUtf8(Searcher.FSourceDir),
  19.       LazFileUtils.ExpandFilenameUtf8(Searcher.FTargetDir), False, True, RelPath);
  20.     if B and ((Copy(RelPath,1,2) = '..') or (RelPath = '')) then Exit; // !!!!!!!!THIS!!!!!
  21.  
  22.     Searcher.Search(SourceDir);
  23.     Result:=Searcher.FCopyFailedCount=0;
  24.   finally
  25.     Searcher.Free;
  26.   end;
  27. end;              
  28.  
Error at line 20 or early. After the previous lines B = True and RelPath = '..\Dir1', so the function ends with False without taking any action (and no errors)

rvk

  • Hero Member
  • *****
  • Posts: 4479
Re: CopyDirTree bug?
« Reply #3 on: September 22, 2016, 03:14:46 pm »
It's because of this bug:
http://bugs.freepascal.org/view.php?id=29695

It's already fixed in Lazarus 1.7 (trunk).


Bart

  • Hero Member
  • *****
  • Posts: 4298
    • Bart en Mariska's Webstek
Re: CopyDirTree bug?
« Reply #4 on: September 22, 2016, 04:04:45 pm »
And merged to 1.6.2, so it'll be fixed in the nest release.

Bart

Sieben

  • Full Member
  • ***
  • Posts: 215
Re: CopyDirTree bug?
« Reply #5 on: March 19, 2021, 04:14:44 pm »
It's still - or again - not working properly, because a call like this:

Code: Pascal  [Select][+][-]
  1. if CopyDirTree('/home/heita/dir','/home/heita/dir2') then

fails to pass this test:

Code: Pascal  [Select][+][-]
  1.     // Don't even try to copy to a subdirectory of SourceDir.
  2.     {$ifdef CaseInsensitiveFilenames}
  3.       if AnsiStartsText(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
  4.     {$ELSE}
  5.       if AnsiStartsStr(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
  6.     {$ENDIF}  

despite being a legal request. Simple solution would imo be to add AppendPathDelim() to the preparation of the paths:

Code: Pascal  [Select][+][-]
  1.     Searcher.FSourceDir:=AppendPathDelim(TrimFilename(SetDirSeparators(SourceDir)));
  2.     Searcher.FTargetDir:=AppendPathDelim(TrimFilename(SetDirSeparators(TargetDir)));

New bug report or reopen the one mentioned above...?

(And how about switching to System.FileNameCaseSensitive instead of {$ifdef CaseInsensitiveFilenames}?)
Lazarus 2.0.10, FPC 3.2.0, .deb install on Ubuntu Xenial 32 / Gtk2 / Unity7

Bart

  • Hero Member
  • *****
  • Posts: 4298
    • Bart en Mariska's Webstek
Re: CopyDirTree bug?
« Reply #6 on: March 19, 2021, 10:43:30 pm »
Please file a new bugreport.

Bart

Sieben

  • Full Member
  • ***
  • Posts: 215
Re: CopyDirTree bug?
« Reply #7 on: March 20, 2021, 12:29:35 pm »
Bug filed as #38644.
Lazarus 2.0.10, FPC 3.2.0, .deb install on Ubuntu Xenial 32 / Gtk2 / Unity7

Bart

  • Hero Member
  • *****
  • Posts: 4298
    • Bart en Mariska's Webstek
Re: CopyDirTree bug?
« Reply #8 on: March 20, 2021, 05:56:39 pm »
Thank you.
Fixed in r64845.

Please test and close the bugreport if OK.

Bart

Sieben

  • Full Member
  • ***
  • Posts: 215
Re: CopyDirTree bug?
« Reply #9 on: March 20, 2021, 07:08:13 pm »
Tested OK and closed report. Thank you once more.
« Last Edit: March 20, 2021, 08:47:26 pm by Sieben »
Lazarus 2.0.10, FPC 3.2.0, .deb install on Ubuntu Xenial 32 / Gtk2 / Unity7

 

TinyPortal © 2005-2018