{ $Id$ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by the Free Pascal development team Disk functions from Delphi's sysutils.pas See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} { The Diskfree and Disksize functions need a file on the specified drive, since this is required for the statfs system call. These filenames are set in drivestr[0..26], and have been preset to : 0 - '.' (default drive - hence current dir is ok.) 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system ) 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system ) 3 - '/' (C: equivalent of dos is the root partition) 4..26 (can be set by your own applications) ! Use AddDisk() to Add new drives ! They both return -1 when a failure occurs. } Const FixDriveStr : array[0..3] of pchar=( '.', '/fd0/.', '/fd1/.', '/.' ); var Drives : byte; DriveStr : array[4..26] of pchar; Procedure AddDisk(const path:string); begin if not (DriveStr[Drives]=nil) then FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1); GetMem(DriveStr[Drives],length(Path)+1); StrPCopy(DriveStr[Drives],path); inc(Drives); if Drives>26 then Drives:=4; end; Function DiskFree(Drive: Byte): Longint; var fs : statfs; Begin if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then Diskfree:=fs.bavail*fs.bsize else Diskfree:=-1; End; Function DiskSize(Drive: Byte): Longint; var fs : statfs; Begin if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then DiskSize:=fs.blocks*fs.bsize else DiskSize:=-1; End; Function GetCurrentDir : String; begin GetDir (0,Result); end; Function SetCurrentDir (Const NewDir : String) : Boolean; begin {$I-} ChDir(NewDir); result := (IOResult = 0); {$I+} end; Function CreateDir (Const NewDir : String) : Boolean; begin {$I-} MkDir(NewDir); result := (IOResult = 0); {$I+} end; Function RemoveDir (Const Dir : String) : Boolean; begin {$I-} RmDir(Dir); result := (IOResult = 0); {$I+} end; { $Log$ Revision 1.5 2000-01-07 16:41:40 daniel * copyright 2000 Revision 1.4 1999/04/26 09:34:32 peter * fixed diskfree,disksize * dir functions now return error status instead of true Revision 1.3 1999/04/26 07:40:40 michael + Fixed removedir Revision 1.2 1999/04/08 11:31:00 peter * removed warnings Revision 1.1 1998/10/11 13:42:04 michael + Added disk and directory functions }