paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 01:59:08 +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. // Don't even try to copy to a subdirectory of SourceDir.
{$ifdef CaseInsensitiveFilenames} {$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} {$ELSE}
if AnsiStartsStr(Searcher.FSourceDir, Searcher.FTargetDir) then Exit; if AnsiStartsStr(Searcher.FSourceDir, Searcher.FTargetDir) then Exit;
{$ENDIF} {$ENDIF}
Searcher.Search(SourceDir); Searcher.Search(SourceDir);
Result:=Searcher.FCopyFailedCount=0; Result:=Searcher.FCopyFailedCount=0;

1
components/lazutils/fileutil.pas
View File

@ -28,6 +28,7 @@ the LazFileUtils unit.
unit FileUtil; unit FileUtil;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$i lazutils_defines.inc}
interface 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 UTF8RightStr(const AText: String; const ACount: Integer): String;
function UTF8QuotedStr(const S, Quote: string): string; function UTF8QuotedStr(const S, Quote: string): string;
//Utf8 version of MidStr is just Utf8Copy with same parameters, so it is not implemented here //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, BreakStr :string; BreakChars :TSysCharSet; MaxCol: integer): string; overload;
function UTF8WrapText(S :string; 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; Result+=copy(S,CopyPos-PChar(S)+1,p-CopyPos)+Quote;
end; 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; function UTF8WrapText(S, BreakStr :string; BreakChars :TSysCharSet; MaxCol: integer): string;
var var
P :PChar; P :PChar;