+ Implemented ForceDirectories for Delphi compatibility

rtl/objpas/sysconst.pp

@@ -29,6 +29,7 @@ resourcestring
   SArgumentMissing       = 'Missing argument in format "%s"';
   SAssertError           = '%s (%s, line %d)';
   SAssertionFailed       = 'Assertion failed';
+  SCannotCreateEmptyDir  = 'Cannot create empty directory'; 
   SControlC              = 'Control-C hit';
   SDiskFull              = 'Disk Full';
   SDispatchError         = 'No variant method call dispatch';
@@ -225,7 +226,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2004-09-03 19:26:42  olle
+  Revision 1.14  2005-01-14 12:59:25  michael
+  + Implemented ForceDirectories for Delphi compatibility
+
+  Revision 1.13  2004/09/03 19:26:42  olle
     + added maxExitCode to all System.pp
     * constrained error code to be below maxExitCode in RunError et. al.
 

rtl/objpas/sysutils/diskh.inc

@@ -20,10 +20,14 @@ Function GetCurrentDir : String;
 Function SetCurrentDir (Const NewDir : String) : Boolean;
 Function CreateDir (Const NewDir : String) : Boolean;
 Function RemoveDir (Const Dir : String) : Boolean;
+Function ForceDirectories(Const Dir: string): Boolean;
 
 {
   $Log$
-  Revision 1.1  2003-10-06 21:01:06  peter
+  Revision 1.2  2005-01-14 12:59:25  michael
+  + Implemented ForceDirectories for Delphi compatibility
+
+  Revision 1.1  2003/10/06 21:01:06  peter
     * moved classes unit to rtl
 
   Revision 1.5  2002/09/07 16:01:22  peter

rtl/objpas/sysutils/sysutils.inc

@@ -459,6 +459,35 @@ begin
     end;
 end;
 
+{ ---------------------------------------------------------------------
+    Diskh functions, OS independent.
+  ---------------------------------------------------------------------}
+  
+
+function ForceDirectories(Const Dir: string): Boolean;
+
+var
+  E: EInOutError;
+  ADir : String;
+  
+begin
+  Result:=True;
+  ADir:=ExcludeTrailingPathDelimiter(Dir);
+  if (ADir='') then
+    begin
+    E:=EInOutError.Create(SCannotCreateEmptyDir);
+    E.ErrorCode:=3;
+    Raise E;
+    end;
+  if Not DirectoryExists(ADir) then 
+    begin 
+    Result:=ForceDirectories(ExtractFilePath(ADir));
+    If Result then
+      CreateDir(ADir);
+    end;  
+end;
+                                  
+
 {
   Revision 1.1  2003/10/06 21:01:06  peter
     * moved classes unit to rtl