mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-11 18:10:47 +01:00
* DiskFree/DiskSize updated
This commit is contained in:
Tomas Hajny
parent
70c2d1a1de
commit
bbba28c00e
155
rtl/os2/dos.pas
155
rtl/os2/dos.pas
@ -139,8 +139,15 @@ procedure getcbreak(var breakvalue:boolean);
|
|||||||
procedure setcbreak(breakvalue:boolean);
|
procedure setcbreak(breakvalue:boolean);
|
||||||
procedure getverify(var verify:boolean);
|
procedure getverify(var verify:boolean);
|
||||||
procedure setverify(verify : boolean);
|
procedure setverify(verify : boolean);
|
||||||
function diskfree(drive:byte):int64;
|
|
||||||
function disksize(drive:byte):int64;
|
{$IFDEF INT64}
|
||||||
|
function DiskFree (Drive: byte) : int64;
|
||||||
|
function DiskSize (Drive: byte) : int64;
|
||||||
|
{$ELSE}
|
||||||
|
function DiskFree (Drive: byte) : longint;
|
||||||
|
function DiskSize (Drive: byte) : longint;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
procedure findfirst(const path:pathstr;attr:word;var f:searchRec);
|
procedure findfirst(const path:pathstr;attr:word;var f:searchRec);
|
||||||
procedure findnext(var f:searchRec);
|
procedure findnext(var f:searchRec);
|
||||||
procedure findclose(var f:searchRec);
|
procedure findclose(var f:searchRec);
|
||||||
@ -196,15 +203,15 @@ var i,p1:longint;
|
|||||||
{$ASMMODE INTEL}
|
{$ASMMODE INTEL}
|
||||||
function CheckFile (FN: ShortString):boolean; assembler;
|
function CheckFile (FN: ShortString):boolean; assembler;
|
||||||
asm
|
asm
|
||||||
mov ax, 4300h
|
mov ax, 4300h
|
||||||
mov edx, FN
|
mov edx, FN
|
||||||
inc edx
|
inc edx
|
||||||
call syscall
|
call syscall
|
||||||
mov ax, 0
|
mov ax, 0
|
||||||
jc @LCFstop
|
jc @LCFstop
|
||||||
test cx, 18h
|
test cx, 18h
|
||||||
jnz @LCFstop
|
jnz @LCFstop
|
||||||
inc ax
|
inc ax
|
||||||
@LCFstop:
|
@LCFstop:
|
||||||
end;
|
end;
|
||||||
{$ASMMODE ATT}
|
{$ASMMODE ATT}
|
||||||
@ -573,7 +580,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure settime(hour,minute,second,sec100:word);
|
procedure settime(hour,minute,second,sec100:word);
|
||||||
|
(* TODO: Syscall 58h (__settime) should be used instead!!! *)
|
||||||
begin
|
begin
|
||||||
asm
|
asm
|
||||||
movb 8(%ebp),%ch
|
movb 8(%ebp),%ch
|
||||||
@ -637,13 +644,15 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function diskfree(drive:byte):int64;
|
{$IFDEF INT64}
|
||||||
|
|
||||||
var fi:TFSinfo;
|
function DiskFree (Drive: byte): int64;
|
||||||
rc:longint;
|
|
||||||
|
var FI: TFSinfo;
|
||||||
|
RC: longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if (os_mode=osDOS) or (os_mode = osDPMI) then
|
if (os_mode = osDOS) or (os_mode = osDPMI) then
|
||||||
{Function 36 is not supported in OS/2.}
|
{Function 36 is not supported in OS/2.}
|
||||||
asm
|
asm
|
||||||
movb 8(%ebp),%dl
|
movb 8(%ebp),%dl
|
||||||
@ -666,22 +675,22 @@ begin
|
|||||||
else
|
else
|
||||||
{In OS/2, we use the filesystem information.}
|
{In OS/2, we use the filesystem information.}
|
||||||
begin
|
begin
|
||||||
RC:=dosqueryFSinfo(drive,1,FI,sizeof(FI));
|
RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
|
||||||
if RC=0 then
|
if RC = 0 then
|
||||||
diskfree:=FI.free_clusters*FI.sectors_per_cluster*
|
DiskFree := int64 (FI.Free_Clusters) *
|
||||||
FI.bytes_per_sector
|
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
|
||||||
else
|
else
|
||||||
diskfree:=-1;
|
DiskFree := -1;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function disksize(drive:byte):int64;
|
function DiskSize (Drive: byte): int64;
|
||||||
|
|
||||||
var fi:TFSinfo;
|
var FI: TFSinfo;
|
||||||
RC:longint;
|
RC: longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if (os_mode=osDOS) or (os_mode = osDPMI) then
|
if (os_mode = osDOS) or (os_mode = osDPMI) then
|
||||||
{Function 36 is not supported in OS/2.}
|
{Function 36 is not supported in OS/2.}
|
||||||
asm
|
asm
|
||||||
movb 8(%ebp),%dl
|
movb 8(%ebp),%dl
|
||||||
@ -705,15 +714,96 @@ begin
|
|||||||
else
|
else
|
||||||
{In OS/2, we use the filesystem information.}
|
{In OS/2, we use the filesystem information.}
|
||||||
begin
|
begin
|
||||||
RC:=dosqueryFSinfo(drive,1,FI,sizeof(FI));
|
RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
|
||||||
if RC=0 then
|
if RC = 0 then
|
||||||
disksize:=FI.total_clusters*FI.sectors_per_cluster*
|
DiskSize := int64 (FI.Total_Clusters) *
|
||||||
FI.bytes_per_sector
|
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
|
||||||
else
|
else
|
||||||
disksize:=-1;
|
DiskSize := -1;
|
||||||
end;
|
end;
|
||||||
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}
|
||||||
|
|
||||||
procedure SearchRec2DosSearchRec (var F: SearchRec);
|
procedure SearchRec2DosSearchRec (var F: SearchRec);
|
||||||
|
|
||||||
const NameSize = 255;
|
const NameSize = 255;
|
||||||
@ -1084,7 +1174,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.24 2000-05-21 16:06:38 hajny
|
Revision 1.25 2000-05-28 18:20:16 hajny
|
||||||
|
* DiskFree/DiskSize updated
|
||||||
|
|
||||||
|
Revision 1.24 2000/05/21 16:06:38 hajny
|
||||||
+ FSearch and Find* reworked
|
+ FSearch and Find* reworked
|
||||||
|
|
||||||
Revision 1.23 2000/04/18 20:30:02 hajny
|
Revision 1.23 2000/04/18 20:30:02 hajny
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user