DECLARE FUNCTION RStr$ (X%, LX%)
DECLARE FUNCTION FmtTime$ (T%)
DECLARE FUNCTION FmtDate$ (FDate%)
DECLARE FUNCTION FindFirst% (Attr%, FIleName$, DEntry AS ANY)
DECLARE FUNCTION FindNext% (DEntry AS ANY)
DECLARE SUB PrintDirEntry (DR AS ANY, FindStatus%)
DECLARE SUB SetDTA (DTA AS ANY)
DECLARE SUB TransferDTA2DIR (DEntry AS ANY)

DEFINT A-Z

'Microsoft BASIC module to read directory entries
'PROGRAM - DIR_READ.BAS
'BASIC Version 7.0 users should change the next
'line to use the QBX.BI file instead of QB.BI
'$INCLUDE: 'QB.BI'
TYPE DataTransferArea
	Reserved1   AS STRING * 21
	Attribute   AS STRING * 1
	FileTime    AS INTEGER
	FileDate    AS INTEGER
	FileSize    AS LONG
	FIleName    AS STRING * 13
END TYPE

TYPE DirectoryRecord
	FIleName    AS STRING * 13
	FileSize    AS LONG
	FileDate    AS INTEGER
	FileTime    AS INTEGER
	FileAttb    AS INTEGER
END TYPE

DIM SHARED InRegsX AS RegTypeX
DIM SHARED OutRegsX AS RegTypeX
DIM SHARED DTA AS DataTransferArea
DIM DirEntry AS DirectoryRecord
  
	CLS
	INPUT "Enter file specification: "; filespec$
	CALL SetDTA(DTA)
  
	FindStatus = FindFirst(0, filespec$, DirEntry)
	CALL PrintDirEntry(DirEntry, FindStatus)
	FindStatus = FindNext(DirEntry)

  'IF FindStatus <> 0 then there are no more files
  '   or no match was found or no prev call to
  '   FindFirst
	WHILE FindStatus = 0
		CALL PrintDirEntry(DirEntry, FindStatus)
		FindStatus = FindNext(DirEntry)
		CALL SetDTA(DTA)
	WEND

END

FUNCTION FindFirst (Attr, FIleName$, DEntry AS DirectoryRecord)
	InRegsX.AX = &H4E00
	InRegsX.CX = Attr

' DOS requires an ASCIIZ string so add CHR$(0)

	 Spec$ = FIleName$ + CHR$(0)
' Version 7.0 users change VARSEG to SSEG
	 InRegsX.DS = VARSEG(Spec$) ' Load DS:DX with
	 InRegsX.DX = SADD(Spec$)   ' address of Spec$
	 CALL InterruptX(&H21, InRegsX, OutRegsX)

' The next line sets an error as default condition

	FindFirst = OutRegsX.AX

' Check if carry flag is clear in the next line

	IF (OutRegsX.Flags AND 1) = 0 THEN
		CALL TransferDTA2DIR(DEntry)
		FindFirst = 0 'Clear error condition setting
	END IF
END FUNCTION

FUNCTION FindNext (DEntry AS DirectoryRecord)
   DTA.FIleName = SPACE$(13)
	InRegsX.AX = &H4F00
	CALL InterruptX(&H21, InRegsX, OutRegsX)
	FindNext = OutRegsX.AX
	IF (OutRegsX.Flags AND 1) = 0 THEN
		CALL TransferDTA2DIR(DEntry)
		FindNext = 0
	END IF
END FUNCTION

FUNCTION FmtDate$ (FDate)
	Day = FDate AND &H1F
	Month = (FDate AND &H1E0) \ 32
	Year = (FDate AND &HFE00) \ 512 + 1980
	FmtDate$ = RStr$(Month, 2) + "-" + RStr$(Day, 2) + "-" + RStr$(Year, 4)
END FUNCTION

FUNCTION FmtTime$ (T%)
	Seconds = (T% AND &H1F) * 2
	Minutes = (T% AND &H7E0) \ 32
  
	Hours = (T% < 0) * (-16) + ((T% AND &H7FFF) \ 2048)
	Abbr$ = " am"
	IF Hours = 12 THEN Abbr$ = " pm"
	IF Hours = 0 THEN Hours = 12
  
	IF Hours > 12 THEN   'Reset to 12 hour clock
		Hours = Hours MOD 12
		Abbr$ = " pm"
	END IF
	FmtTime$ = RStr$(Hours, 2) + ":" + RStr$(Minutes, 2) + ":" + RStr$(Seconds, 2) + Abbr$
END FUNCTION

SUB GetDTAAddr (Segment, Offset)  'Subprogram not used but included for your convenience
	InRegsX.AX = &H2F00
	CALL InterruptX(&H21, InRegsX, OutRegsX)
	Segment = OutRegsX.ES   'Return address of DTA
	Offset = OutRegsX.BX    'Segment:Offset format
END SUB

SUB PrintDirEntry (DR AS DirectoryRecord, FindStatus)
	FmtStr$ = "\          \  ##,###,###  " + "\        \ \           \  ###"
	IF FindStatus = 0 THEN
		PRINT USING FmtStr$; DR.FIleName; DR.FileSize; FmtDate$(DR.FileDate); FmtTime$(DR.FileTime); DR.FileAttb
	ELSE
		PRINT "Error on file lookup"
		SELECT CASE FindStatus
			CASE 2
				PRINT "File not found"
			CASE 3
				PRINT "Path not found"
			CASE 18
				PRINT "Match not found"
			CASE ELSE
				PRINT "Unknown error #"; FindStatus
		END SELECT
	END IF
END SUB

FUNCTION RStr$ (X%, LX%)
	X$ = STR$(X%)
	RStr$ = RIGHT$("00000" + RIGHT$(X$, LEN(X$) - 1), LX%)
END FUNCTION

SUB SetDTA (DTA AS DataTransferArea)
	InRegsX.AX = &H1A00
	InRegsX.DS = VARSEG(DTA)
	InRegsX.DX = VARPTR(DTA)   'Use for records
	CALL InterruptX(&H21, InRegsX, OutRegsX)
END SUB

SUB TransferDTA2DIR (DEntry AS DirectoryRecord)
	DEntry.FIleName = DTA.FIleName
	DEntry.FileSize = DTA.FileSize
	DEntry.FileDate = DTA.FileDate
	DEntry.FileTime = DTA.FileTime
	DEntry.FileAttb = ASC(DTA.Attribute)
END SUB