paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 07:08:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

laztuils: fixed FileIsInPath for different utf8 lengths

Browse Source
This commit is contained in:
mattias 2023-08-03 13:44:20 +02:00
parent e9a8d45aad
commit 478c8209a6
1 changed files with 25 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
components/lazutils/fileutil.inc
View File

@ -162,15 +162,35 @@ end;
function FileIsInPath(const Filename, Path: string): boolean;
var
ExpFile: String;
ExpPath: String;
l: integer;
ExpFile, ExpPath: String;
l, p, PathDelimCount: integer;
begin
ExpFile:=CleanAndExpandFilename(Filename);
ExpPath:=CleanAndExpandDirectory(Path);
l:=length(ExpPath);
Result:=(l>0) and (length(ExpFile)>l) and (ExpFile[l] in AllowDirectorySeparators)
and (CompareFilenames(ExpPath,LeftStr(ExpFile,l))=0);
p:=1;
PathDelimCount:=0;
while p<=l do
begin
if ExpPath[p] in AllowDirectorySeparators then inc(PathDelimCount);
inc(p);
end;
p:=1;
l:=length(ExpFile);
while p<=l do
begin
if ExpFile[p] in AllowDirectorySeparators then
begin
dec(PathDelimCount);
if PathDelimCount=0 then
begin
Result:=CompareFilenames(LeftStr(ExpFile,p),ExpPath)=0;
exit;
end;
end;
inc(p);
end;
Result:=false;
end;
function FileIsInDirectory(const Filename, Directory: string): boolean;