paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch for #11110, unc drives and forcedirectories from Bart.

Browse Source 
git-svn-id: trunk@10855 -
This commit is contained in:
marco 2008-05-01 15:41:36 +00:00
parent 80fc6fbed2
commit e57c36eaba
1 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/objpas/sysutils/sysutils.inc
View File

@ -533,22 +533,33 @@ var
function DoForceDirectories(Const Dir: string): Boolean;
var
ADir : String;
APath: String;
begin
Result:=True;
ADir:=ExcludeTrailingPathDelimiter(Dir);
if (ADir='') then Exit;
if Not DirectoryExists(ADir) then
begin
Result:=DoForceDirectories(ExtractFilePath(ADir));
APath := ExtractFilePath(ADir);
//this can happen on Windows if user specifies Dir like \user\name/test/
//and would, if not checked for, cause an infinite recusrsion and a stack overflow
if (APath = ADir) then Result := False
else Result:=DoForceDirectories(APath);
If Result then
Result := CreateDir(ADir);
end;
end;
function IsUncDrive(const Drv: String): Boolean;
begin
Result := (Length(Drv) > 2) and (Drv[1] = PathDelim) and (Drv[2] = PathDelim);
end;
begin
Result := False;
ADrv := ExtractFileDrive(Dir);
if (ADrv<>'') and (not DirectoryExists(ADrv)) then Exit;
if (ADrv<>'') and (not DirectoryExists(ADrv))
{$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then Exit;
if Dir='' then
begin
E:=EInOutError.Create(SCannotCreateEmptyDir);