mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 12:31:38 +01:00
127 lines
2.9 KiB
PHP
127 lines
2.9 KiB
PHP
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1998 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.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
|
|
|
|
}
|