paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 13:29:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Implemented ForceDirectories for Delphi compatibility

Browse Source
This commit is contained in:
michael 2005-01-14 12:59:25 +00:00
parent 74cc20070d
commit e05a92537d
3 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
rtl/objpas/sysconst.pp
View File

@ -29,6 +29,7 @@ resourcestring
SArgumentMissing = 'Missing argument in format "%s"'; SArgumentMissing = 'Missing argument in format "%s"';
SAssertError = '%s (%s, line %d)'; SAssertError = '%s (%s, line %d)';
SAssertionFailed = 'Assertion failed'; SAssertionFailed = 'Assertion failed';
SCannotCreateEmptyDir = 'Cannot create empty directory';
SControlC = 'Control-C hit'; SControlC = 'Control-C hit';
SDiskFull = 'Disk Full'; SDiskFull = 'Disk Full';
SDispatchError = 'No variant method call dispatch'; SDispatchError = 'No variant method call dispatch';
@ -225,7 +226,10 @@ end;
end. end.
{ {
$Log$ $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 + added maxExitCode to all System.pp
* constrained error code to be below maxExitCode in RunError et. al. * constrained error code to be below maxExitCode in RunError et. al.

6
rtl/objpas/sysutils/diskh.inc
View File

@ -20,10 +20,14 @@ Function GetCurrentDir : String;
Function SetCurrentDir (Const NewDir : String) : Boolean; Function SetCurrentDir (Const NewDir : String) : Boolean;
Function CreateDir (Const NewDir : String) : Boolean; Function CreateDir (Const NewDir : String) : Boolean;
Function RemoveDir (Const Dir : String) : Boolean; Function RemoveDir (Const Dir : String) : Boolean;
Function ForceDirectories(Const Dir: string): Boolean;
{ {
$Log$ $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 * moved classes unit to rtl
Revision 1.5 2002/09/07 16:01:22 peter Revision 1.5 2002/09/07 16:01:22 peter

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

@ -459,6 +459,35 @@ begin
end; end;
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 Revision 1.1 2003/10/06 21:01:06 peter
* moved classes unit to rtl * moved classes unit to rtl