CopyDirTree bug
Original Reporter info from Mantis: SergeAnvarov @SergeAnvarov
-
Reporter name: Serge Anvarov
Original Reporter info from Mantis: SergeAnvarov @SergeAnvarov
- Reporter name: Serge Anvarov
Description:
See forum on http://forum.lazarus.freepascal.org/index.php/topic,34127.msg222788.html#msg222788
It looks like regression after resolve for 0028841 bug (http://bugs.freepascal.org/view.php?id=28841)
Steps to reproduce:
Create a new project, drop a TButton and add this to its click event:
procedure TForm1.Button1Click(Sender: TObject);
begin
if not CopyDirTree('C:\Temp\dir1','C:\Temp\dir2') then
ShowMessage('Error?');
end;
Additional information:
CopyDirTree source Lazaruz 1.6
function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;
var
Searcher: TCopyDirTree;
RelPath: String;
B: Boolean;
begin
Result:=False;
Searcher:=TCopyDirTree.Create;
try
// Destination directories are always created. User setting has no effect!
Flags:=Flags+[cffCreateDestDirectory];
Searcher.FFlags:=Flags;
Searcher.FCopyFailedCount:=0;
Searcher.FSourceDir:=LazFileUtils.TrimFilename(SetDirSeparators(SourceDir));
Searcher.FTargetDir:=LazFileUtils.TrimFilename(SetDirSeparators(TargetDir));
// Don't even try to copy to a subdirectory of SourceDir.
B := TryCreateRelativePath(LazFileUtils.ExpandFilenameUtf8(Searcher.FSourceDir),
LazFileUtils.ExpandFilenameUtf8(Searcher.FTargetDir), False, True, RelPath);
if B and ((Copy(RelPath,1,2) = '..') or (RelPath = '')) then Exit; // !!!!!!!!THIS!!!!!
Searcher.Search(SourceDir);
Result:=Searcher.FCopyFailedCount=0;
finally
Searcher.Free;
end;
end;
Error at line !!!!THIS!!!! or early. After the previous lines B = True and RelPath = '..\Dir1', so the function ends with False without taking any action (and no errors)
Mantis conversion info:
- Mantis ID: 30628
- OS: Windows
- OS Build: Windows 7
- Version: 1.6