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

* fix from Forest for #7389

Browse Source 
git-svn-id: trunk@4699 -
This commit is contained in:
florian 2006-09-24 07:13:23 +00:00
parent acab962bb3
commit 34189ac762
1 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -518,30 +518,40 @@ end;
Diskh functions, OS independent.
---------------------------------------------------------------------}
function ForceDirectories(Const Dir: string): Boolean;
var
E: EInOutError;
ADir : String;
ADrv : String;
function DoForceDirectories(Const Dir: string): Boolean;
var
ADir : String;
begin
Result:=True;
ADir:=ExcludeTrailingPathDelimiter(Dir);
if (ADir='') then
begin
E:=EInOutError.Create(SCannotCreateEmptyDir);
E.ErrorCode:=3;
Raise E;
end;
if (ADir='') then Exit;
if Not DirectoryExists(ADir) then
begin
Result:=ForceDirectories(ExtractFilePath(ADir));
Result:=DoForceDirectories(ExtractFilePath(ADir));
If Result then
CreateDir(ADir);
Result := CreateDir(ADir);
end;
end;
begin
Result := False;
ADrv := ExtractFileDrive(Dir);
if (ADrv<>'') and (not DirectoryExists(ADrv)) then Exit;
if Dir='' then
begin
E:=EInOutError.Create(SCannotCreateEmptyDir);
E.ErrorCode:=3;
Raise E;
end;
Result := DoForceDirectories(Dir);
end;
Procedure GetRandomBytes(Var Buf; NBytes : Integer);
Var