'===========================================================================
' Subject: DRIVE FUNCTIONS FOR QBASIC         Date: 07-07-98 (08:04)       
'  Author: Mike Anderson                      Code: QBasic                 
'  Origin: MikeAinIA@aol.com                Packet: DISK.ABC
'===========================================================================
' These are Disk Drive functions - Change default and Get Default drive
' for QBasic 1.x.  The InterruptX routine is by Douggie Greene.
' Note: the routines won't work under QB4.x without some name changing.

DEFINT A-Z

DECLARE SUB ChDrive (Drive$)
DECLARE SUB Interruptx (IntNum%, Regs AS ANY)
DECLARE FUNCTION CurDrive$ ()
DECLARE FUNCTION Dir$ (FileSpec$, attr%)

TYPE RegTypeX
		ax    AS INTEGER
		bx    AS INTEGER
		cx    AS INTEGER
		dx    AS INTEGER
		BP    AS INTEGER
		si    AS INTEGER
		DI    AS INTEGER
		flags AS INTEGER
		ds    AS INTEGER
		ES    AS INTEGER
END TYPE

CONST GetDrive = &H1900, ChangeDrive = &HE00

DIM SHARED Regs AS RegTypeX

'--------------------------------------------------------------------
'This shows how to call DIR$ to find all matching files

'-------------------------start of demo code-------------------------

SCREEN 0
CLS
DO
	PRINT
	PRINT "The current default drive is "; CurDrive
	INPUT "Enter the drive to log onto: ", NewDrive$
	IF NewDrive$ = "" THEN EXIT DO
	CALL ChDrive(NewDrive$)
LOOP WHILE NewDrive$ <> ""
END
'-------------------------end of demo code-------------------------

'Hex data for interrupt routine

DATA  &H55, &H8B, &HEC, &H83, &HEC, &H08, &H56, &H57
DATA  &H1E, &H55, &H8B, &H5E, &H06, &H8B, &H47, &H10
DATA  &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA  &H10, &H8B, &H47, &H12, &H3D, &HFF, &HFF, &H75
DATA  &H04, &H1E, &H8F, &H47, &H12, &H8B, &H47, &H08
DATA  &H89, &H46, &HF8, &H8B, &H07, &H8B, &H4F, &H04
DATA  &H8B, &H57, &H06, &H8B, &H77, &H0A, &H8B, &H7F
DATA  &H0C, &HFF, &H77, &H12, &H07, &HFF, &H77, &H02
DATA  &H1E, &H8F, &H46, &HFA, &HFF, &H77, &H10, &H1F
DATA  &H8B, &H6E, &HF8, &H5B, &HCD, &H21, &H55, &H8B
DATA  &HEC, &H8B, &H6E, &H02, &H89, &H5E, &HFC, &H8B
DATA  &H5E, &H06, &H1E, &H8F, &H46, &HFE, &HFF, &H76
DATA  &HFA, &H1F, &H89, &H07, &H8B, &H46, &HFC, &H89
DATA  &H47, &H02, &H89, &H4F, &H04, &H89, &H57, &H06
DATA  &H58, &H89, &H47, &H08, &H89, &H77, &H0A, &H89
DATA  &H7F, &H0C, &H9C, &H8F, &H47, &H0E, &H06, &H8F
DATA  &H47, &H12, &H8B, &H46, &HFE, &H89, &H47, &H10
DATA  &H5A, &H1F, &H5F, &H5E, &H8B, &HE5, &H5D, &HCA
DATA  &H02, &H00

SUB ChDrive (Drive$) STATIC

Regs.ax = ChangeDrive
Regs.dx = ASC(UCASE$(Drive$)) - 65  'Convert Drive$ to DOS drive #
CALL Interruptx(&H21, Regs)

END SUB

FUNCTION CurDrive$

Regs.ax = GetDrive
CALL Interruptx(&H21, Regs)
CurDrive$ = CHR$((Regs.ax AND &HFF) + 65)   'Dos returns a drive #
											'We convert it to a letter
END FUNCTION

SUB Interruptx (IntNum, Regs AS RegTypeX) STATIC
'This routine by Douggie Greene

STATIC filenum, IntOffset, Loaded
		
	' use fixed-length string to fix its position in memory
	' and so we don't mess up string pool before routine
	' gets its pointers from caller

DIM IntCode AS STRING * 200

IF NOT Loaded THEN                     ' loaded will be 0 first time
	FOR k = 1 TO 145
		READ h%
		MID$(IntCode, k, 1) = CHR$(h%)
	NEXT

	'  determine address of interrupt no. offset in IntCode

	IntOffset = INSTR(IntCode$, CHR$(&HCD) + CHR$(&H21)) + 1
	Loaded = -1
END IF

SELECT CASE IntNum

	CASE &H25, &H26, IS > 255               ' ignore these interrupts

	CASE ELSE
		DEF SEG = VARSEG(IntCode)             ' poke interrupt number into
		POKE VARPTR(IntCode) * 1& + IntOffset - 1, IntNum     ' code block
		CALL Absolute(Regs, VARPTR(IntCode$))               ' call routine
END SELECT

END SUB