paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-20 12:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 51675 #f7005c6649 from trunk:

Browse Source 
LazUtils: Revert r51038 #10e166f60e. Fixes bug in CopyDirTree. Issue #0029695.
........

git-svn-id: branches/fixes_1_6@51687 -
This commit is contained in:
maxim 2016-02-24 22:26:09 +00:00
parent aede9c3c21
commit c66d69cc37
2 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/lazutils/fileutil.inc
View File

@ -696,8 +696,6 @@ end;
function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;
var
Searcher: TCopyDirTree;
RelPath: String;
B: Boolean;
begin
Result:=False;
Searcher:=TCopyDirTree.Create;
@ -710,10 +708,11 @@ begin
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;
{$ifdef CaseInsensitiveFilenames}
if AnsiStartsText(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$ELSE}
if AnsiStartsStr(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$ENDIF}
Searcher.Search(SourceDir);
Result:=Searcher.FCopyFailedCount=0;
finally

2
components/lazutils/fileutil.pas
View File

@ -33,7 +33,7 @@ interface
uses
Classes, SysUtils,
Masks, LazUTF8, LazFileUtils;
Masks, LazUTF8, LazFileUtils, StrUtils;
{$if defined(Windows) or defined(darwin)}
{$define CaseInsensitiveFilenames}