'===========================================================================
' Subject: FLOPPY DRIVE FUNCTIONS             Date: Unknown Date           
'  Author: Unknown Author(s)                  Code: QB, PDS                
'  Origin: FidoNet QUIK_BAS Echo            Packet: DISK.ABC
'===========================================================================
' Function FLOPPYDRIVEREADY checks if disk is in drive
' Function FLOPPYWRITEOK checks if disk is write protected

'$INCLUDE: 'QB.BI'

DECLARE FUNCTION FloppyDriveReady% (Drive$, ErrCode%)
DECLARE FUNCTION FloppyWriteOK% (Drive$)

DIM SHARED Register AS RegType, XRegister AS RegTypeX

A = FloppyDriveReady%("A", ErrCode%)

IF ErrCode% = -1 THEN PRINT "Disk in drive." ELSE PRINT "Drive not ready."

FUNCTION FloppyDriveReady% (Drive$, ErrCode%)
'returns True (-1) if the floppy drive specified in Drive$
'has a disk in it. If the function returns False (0), ErrCode%
'contains the DOS error code.
'by Douglas H. Lusher, April, 1993

Drive% = (ASC(Drive$) OR 32) - 97

'reset floppy drive
Register.ax = 0
Register.dx = Drive%
CALL INTERRUPT(&H13, Register, Register)

Register.ax = &H401
Register.cx = &H101
Register.dx = Drive%
CALL INTERRUPT(&H13, Register, Register)

'call the interrupt twice since if a disk has just been inserted,
'the first time gives a wrong answer
Register.ax = &H401
Register.cx = &H101
Register.dx = Drive%
CALL INTERRUPT(&H13, Register, Register)
FloppyDriveReady% = ((Register.flags AND 1) = 0)
ErrCode% = ((Register.ax AND &HFF00) \ &H100) AND &HFF

END FUNCTION

FUNCTION FloppyWriteOK% (Drive$)
'returns True (-1) if the disk in the specified floppy drive
'is not write protected
'by Douglas H. Lusher, April 1993

Drive% = (ASC(Drive$) OR 32) - 97

'reset floppy drive
XRegister.ax = 0
XRegister.dx = Drive%
CALL INTERRUPTX(&H13, XRegister, XRegister)
XRegister.ax = &H401
XRegister.cx = &H101
XRegister.dx = Drive%
CALL INTERRUPTX(&H13, XRegister, XRegister)

Buffer$ = SPACE$(512)
'read from the disk
XRegister.ax = &H201
XRegister.es = VARSEG(Buffer$)
XRegister.bx = SADD(Buffer$)
XRegister.cx = &H101
XRegister.dx = Drive%
CALL INTERRUPTX(&H13, XRegister, XRegister)

'try writing back to the disk
XRegister.ax = &H301
XRegister.es = VARSEG(Buffer$)
XRegister.bx = SADD(Buffer$)
XRegister.cx = &H101
XRegister.dx = Drive%
CALL INTERRUPTX(&H13, XRegister, XRegister)
FloppyWriteOK% = ((XRegister.flags AND 1) = 0)
ErrCode% = ((XRegister.ax AND &HFF00) \ &H100) AND &HFF

END FUNCTION