'===========================================================================
' Subject: DIR FUNCTION FOR QBASIC           Date: 03-23-98 (20:10)       
' Author:  Mike Anderson                     Code: QBasic                 
' Origin:  MikeAinIA@aol.com               Packet: DOS.ABC
'===========================================================================
' This is a version of Dave Cleary's DIR.BAS function for
' QBasic 1.x.  The InterruptX routine is by Douggie Greene
' The conversion is by Mike Anderson

DEFINT A-Z

DECLARE SUB InterruptX (IntNum%, Regs AS ANY)
DECLARE FUNCTION Dir$ (FileSpec$, attr%)

TYPE FileFindBuf
	DOS            AS STRING * 19
	CreateTime     AS STRING * 1
	Attributes     AS INTEGER
	AccessTime     AS INTEGER
	AccessDate     AS INTEGER
	filesize       AS LONG
	filename       AS STRING * 13
END TYPE

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 SetDTA = &H1A00, DOS = &H21
CONST FindFirst = &H4E00, FindNext = &H4F00

DIM SHARED Regs AS RegTypeX

'--------------------------------------------------------------------
'This shows how to call DIR$ to find all matching files
'
'-------------------------start of demo code-------------------------

SCREEN 0
CLS

attr% = 16
FileSpec$ = "C:\qb45\*.*"          'Make this any path/file spec
Found$ = Dir$(FileSpec$, attr%)     'check for the first file

x = 1
DO WHILE LEN(Found$)
   PRINT Found$
   Found$ = Dir$("", attr%)
   x = x + 1
   IF x MOD 20 = 0 THEN INPUT r$
LOOP
PRINT x; "  Files found"

END


'Hex data for interrupt routine

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

'--------------------------------------------------------------------
FUNCTION Dir$ (FileSpec$, attribute%) STATIC

DIM DTA AS FileFindBuf
null$ = CHR$(0)

'-----  Set up our own DTA so we don't destroy COMMAND$
'       (although QBasic doesn't have a Command$ !)

Regs.ax = SetDTA                    'Set DTA function
Regs.dx = VARPTR(DTA)               'DS:DX points to our DTA
Regs.ds = -1                        'Use current value for DS
CALL InterruptX(DOS, Regs)          'Do the interrupt

IF LEN(FileSpec$) THEN
	FileSpecZ$ = FileSpec$ + null$
	Regs.ax = FindFirst
	Regs.cx = attribute%
	Regs.dx = SADD(FileSpecZ$)
	Regs.ds = -1
ELSE
	Regs.ax = FindNext
END IF

DTA.filename = ""
CALL InterruptX(DOS, Regs)

IF Regs.flags AND 1 THEN
	Dir$ = ""
ELSE
	null = INSTR(DTA.filename, CHR$(0))  'Get the filename found 
	Flnam$ = LEFT$(DTA.filename, null)
	Dir$ = Flnam$
END IF

END FUNCTION

SUB InterruptX (IntNum, Regs AS RegTypeX) STATIC

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