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

LazUtils: Better fix "Prevent CopyDirTree copying to a subdirectory of source." Issue #28841.

Browse Source 
git-svn-id: trunk@51038 -
This commit is contained in:
bart 2015-12-26 13:14:11 +00:00
parent cc42e8d513
commit 10e166f60e
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/lazutils/fileutil.inc
View File

@ -696,6 +696,7 @@ end;
function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;
var
Searcher: TCopyDirTree;
Dummy: String;
begin
Result:=False;
Searcher:=TCopyDirTree.Create;
@ -704,11 +705,13 @@ begin
Flags:=Flags+[cffCreateDestDirectory];
Searcher.FFlags:=Flags;
Searcher.FCopyFailedCount:=0;
Searcher.FSourceDir:=TrimFilename(SetDirSeparators(SourceDir));
Searcher.FTargetDir:=TrimFilename(SetDirSeparators(TargetDir));
Searcher.FSourceDir:=LazFileUtils.TrimFilename(SetDirSeparators(SourceDir));
Searcher.FTargetDir:=LazFileUtils.TrimFilename(SetDirSeparators(TargetDir));
// Don't even try to copy to a subdirectory of SourceDir.
if {$if defined(Windows) or defined(darwin)}AnsiStartsText{$ELSE}AnsiStartsStr{$ENDIF}
(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
if TryCreateRelativePath(LazFileUtils.ExpandFilenameUtf8(Searcher.FSourceDir),
LazFileUtils.ExpandFilenameUtf8(Searcher.FTargetDir), False, True, {%H-}Dummy) then Exit;
Searcher.Search(SourceDir);
Result:=Searcher.FCopyFailedCount=0;
finally

2
components/lazutils/fileutil.pas
View File

@ -32,7 +32,7 @@ unit FileUtil;
interface
uses
Classes, SysUtils, strutils,
Classes, SysUtils,
Masks, LazUTF8, LazFileUtils;
{$if defined(Windows) or defined(darwin)}