paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 03:48:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Prevent CopyDirTree copying to a subdirectory of source: handle unicode characters.

Browse Source 
git-svn-id: trunk@51692 -
This commit is contained in:
bart 2016-02-24 23:07:19 +00:00
parent f09c665b2a
commit 2683bc53a8
3 changed files with 37 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/lazutils/fileutil.inc
View File

@ -709,9 +709,13 @@ begin
// Don't even try to copy to a subdirectory of SourceDir.
{$ifdef CaseInsensitiveFilenames}
if AnsiStartsText(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$ifdef ACP_RTL}
if AnsiStartsText(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$else ACP_RTL}
if Utf8StartsText(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$endif}
{$ELSE}
if AnsiStartsStr(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
if AnsiStartsStr(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$ENDIF}
Searcher.Search(SourceDir);
Result:=Searcher.FCopyFailedCount=0;

1
components/lazutils/fileutil.pas
View File

@ -28,6 +28,7 @@ the LazFileUtils unit.
unit FileUtil;
{$mode objfpc}{$H+}
{$i lazutils_defines.inc}
interface

30
components/lazutils/lazutf8.pas
View File

@ -120,6 +120,8 @@ function UTF8LeftStr(const AText: String; const ACount: Integer): String;
function UTF8RightStr(const AText: String; const ACount: Integer): String;
function UTF8QuotedStr(const S, Quote: string): string;
//Utf8 version of MidStr is just Utf8Copy with same parameters, so it is not implemented here
function Utf8StartsText(const ASubText, AText: string): Boolean;
function Utf8EndsText(const ASubText, AText: string): Boolean;
function UTF8WrapText(S, BreakStr :string; BreakChars :TSysCharSet; MaxCol: integer): string; overload;
function UTF8WrapText(S :string; MaxCol :integer) :string; overload;
@ -2809,6 +2811,34 @@ begin
Result+=copy(S,CopyPos-PChar(S)+1,p-CopyPos)+Quote;
end;
function Utf8StartsText(const ASubText, AText: string): Boolean;
var
TextLen, SubTextLen: PtrInt;
begin
Result := False;
if (ASubText <> '') then
begin
TextLen := Utf8Length(AText);
SubTextLen := Utf8Length(ASubText);
if (TextLen >= SubTextLen) then
Result := (Utf8CompareText(Utf8Copy(AText,1,SubTextLen),ASubText) = 0);
end;
end;
function Utf8EndsText(const ASubText, AText: string): Boolean;
var
TextLen, SubTextLen: PtrInt;
begin
Result := False;
if (ASubText <> '') then
begin
TextLen := Utf8Length(AText);
SubTextLen := Utf8Length(ASubText);
if (TextLen >= SubTextLen) then
Result := (Utf8CompareText(Utf8Copy(AText,TextLen-SubTextLen+1,SubTextLen),ASubText) = 0);
end;
end;
function UTF8WrapText(S, BreakStr :string; BreakChars :TSysCharSet; MaxCol: integer): string;
var
P :PChar;