123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225 |
- {
- $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.
- **********************************************************************}
- {$IFDEF INT64}
- function DiskFree (Drive: byte): int64;
- var FI: TFSinfo;
- RC: longint;
- begin
- if (os_mode = osDOS) or (os_mode = osDPMI) then
- {Function 36 is not supported in OS/2.}
- asm
- movb 8(%ebp),%dl
- movb $0x36,%ah
- call syscall
- cmpw $-1,%ax
- je .LDISKFREE1
- mulw %cx
- mulw %bx
- shll $16,%edx
- movw %ax,%dx
- xchgl %edx,%eax
- leave
- ret
- .LDISKFREE1:
- cltd
- leave
- ret
- end
- else
- {In OS/2, we use the filesystem information.}
- begin
- RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
- if RC = 0 then
- DiskFree := int64 (FI.Free_Clusters) *
- int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
- else
- DiskFree := -1;
- end;
- end;
- function DiskSize (Drive: byte): int64;
- var FI: TFSinfo;
- RC: longint;
- begin
- if (os_mode = osDOS) or (os_mode = osDPMI) then
- {Function 36 is not supported in OS/2.}
- asm
- movb 8(%ebp),%dl
- movb $0x36,%ah
- call syscall
- movw %dx,%bx
- cmpw $-1,%ax
- je .LDISKSIZE1
- mulw %cx
- mulw %bx
- shll $16,%edx
- movw %ax,%dx
- xchgl %edx,%eax
- leave
- ret
- .LDISKSIZE1:
- cltd
- leave
- ret
- end
- else
- {In OS/2, we use the filesystem information.}
- begin
- RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
- if RC = 0 then
- DiskSize := int64 (FI.Total_Clusters) *
- int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
- else
- DiskSize := -1;
- end;
- end;
- {$ELSE}
- function DiskFree (Drive: byte): longint;
- var FI: TFSinfo;
- RC: longint;
- begin
- if (os_mode = osDOS) or (os_mode = osDPMI) then
- {Function 36 is not supported in OS/2.}
- asm
- movb 8(%ebp),%dl
- movb $0x36,%ah
- call syscall
- cmpw $-1,%ax
- je .LDISKFREE1
- mulw %cx
- mulw %bx
- shll $16,%edx
- movw %ax,%dx
- xchgl %edx,%eax
- leave
- ret
- .LDISKFREE1:
- cltd
- leave
- ret
- end
- else
- {In OS/2, we use the filesystem information.}
- begin
- RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
- if RC = 0 then
- DiskFree := FI.Free_Clusters *
- FI.Sectors_Per_Cluster * FI.Bytes_Per_Sector
- else
- DiskFree := -1;
- end;
- end;
- function DiskSize (Drive: byte): longint;
- var FI: TFSinfo;
- RC: longint;
- begin
- if (os_mode = osDOS) or (os_mode = osDPMI) then
- {Function 36 is not supported in OS/2.}
- asm
- movb 8(%ebp),%dl
- movb $0x36,%ah
- call syscall
- movw %dx,%bx
- cmpw $-1,%ax
- je .LDISKSIZE1
- mulw %cx
- mulw %bx
- shll $16,%edx
- movw %ax,%dx
- xchgl %edx,%eax
- leave
- ret
- .LDISKSIZE1:
- cltd
- leave
- ret
- end
- else
- {In OS/2, we use the filesystem information.}
- begin
- RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
- if RC = 0 then
- DiskSize := FI.Total_Clusters *
- FI.Sectors_Per_Cluster * FI.Bytes_Per_Sector
- else
- DiskSize := -1;
- end;
- end;
- {$ENDIF}
- 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-05-28 18:21:51 hajny
- + initial implementation
- Revision 1.4 2000/05/21 15:55:11 hajny
- * int64 result for Disk* functions
- Revision 1.3 2000/02/09 16:59:33 peter
- * truncated log
- Revision 1.2 2000/01/07 16:41:45 daniel
- * copyright 2000
- }
|