paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 04:42:38 +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; end;
function ForceDirectory(DirectoryName: string): boolean; function ForceDirectory(DirectoryName: string): boolean;
var i: integer; var
i: integer;
Dir: string; Dir: string;
begin begin
DirectoryName:=AppendPathDelim(DirectoryName); DirectoryName:=AppendPathDelim(DirectoryName);
i:=1; i:=1;
while i<=length(DirectoryName) do begin while i<=length(DirectoryName) do begin
if DirectoryName[i] in AllowDirectorySeparators then 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); Dir:=copy(DirectoryName,1,i-1);
if not DirPathExists(Dir) then begin if (Dir<>'') and not DirPathExists(Dir) then begin
Result:=CreateDirUTF8(Dir); Result:=CreateDirUTF8(Dir);
if not Result then exit; if not Result then exit;
end; end;
@ -556,7 +560,6 @@ begin
Result:=true; Result:=true;
end; end;
function FileIsText(const AFilename: string): boolean; function FileIsText(const AFilename: string): boolean;
var var
FileReadable: Boolean; FileReadable: Boolean;