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

LazUtils: Prevent ForceDirectory trying to create directories with empty name. Issue #37133

Browse Source 
git-svn-id: branches/fixes_2_0@63479 -
This commit is contained in:
mattias 2020-06-28 17:02:37 +00:00
parent 279ac8e978
commit 6290d23d56
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/lazutils/lazfileutils.pas
View File

@ -538,15 +538,19 @@ begin
end;
function ForceDirectory(DirectoryName: string): boolean;
var i: integer;
var
i: integer;
Dir: string;
begin
DirectoryName:=AppendPathDelim(DirectoryName);
i:=1;
while i<=length(DirectoryName) do begin
if DirectoryName[i] in AllowDirectorySeparators then begin
// optimize paths like \foo\\bar\\foobar
while (i<length(DirectoryName)) and (DirectoryName[i+1] in AllowDirectorySeparators) do
Delete(DirectoryName,i+1,1);
Dir:=copy(DirectoryName,1,i-1);
if not DirPathExists(Dir) then begin
if (Dir<>'') and not DirPathExists(Dir) then begin
Result:=CreateDirUTF8(Dir);
if not Result then exit;
end;
@ -556,7 +560,6 @@ begin
Result:=true;
end;
function FileIsText(const AFilename: string): boolean;
var
FileReadable: Boolean;