123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129 |
- {
- $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
- }
|