 ' dir$ simulated function
 DECLARE FUNCTION DIRx$ (Filespec$, Filebits%, Filedate$, Filetime$, FileSize&)

 REM Findit is v1.5a of a findfile function for QB v4.5 DOSbox which
 REM emulates a DIR$ function similar to the DIR$ function of BC7.

 ' declare dta structure
 TYPE DTAtype
  Drive AS STRING * 1
  SearchTemplate AS STRING * 11
  SearchAttr AS STRING * 1
  EntryCount AS STRING * 2
  ClusterNumber AS STRING * 2
  Reserved AS STRING * 4
  Filebits AS STRING * 1
  Filetime AS STRING * 2
  Filedate AS STRING * 2
  FileSize AS STRING * 4
  ASCIIZfilename AS STRING * 13
 END TYPE

 ' declare interrupt structure
 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
 DECLARE SUB InterruptX (Intnum AS INTEGER, Inreg AS RegTypeX, Outreg AS RegTypeX)

 ' common error trap variable
 COMMON SHARED Disk.Ready AS INTEGER

 ' prompt for filespec.
 COLOR 15
 PRINT "Enter filespec:";
 LINE INPUT f$

 ' start filefind
 x$ = DIRx$(f$, b%, d$, t$, s&)
 Count = 0
 Total.Bytes# = 0#
 Total.Dirs& = 0&
 Total.Files& = 0&
 CLS
 COLOR 13
 PRINT "Searching: "; f$
 GOSUB Header
 DO
    ' compare result
    IF x$ = "" THEN
       EXIT DO
    END IF

    ' check escape key
    IF INKEY$ = CHR$(27) THEN
       EXIT DO
    END IF

    ' count files
    GOSUB Count.Files1

    ' display file.
    COLOR 15
    PRINT x$; SPACE$(13 - LEN(x$));

    ' check file attributes
    x$ = SPACE$(10)

    ' check for read-only file
    IF (b% AND &H1) = &H1 THEN
       MID$(x$, 1, 1) = "R"
    END IF

    ' check for hidden file
    IF (b% AND &H2) = &H2 THEN
       MID$(x$, 3, 1) = "H"
    END IF

    ' check for system file
    IF (b% AND &H4) = &H4 THEN
       MID$(x$, 5, 1) = "S"
    END IF

    ' check for directory file
    IF (b% AND &H10) = &H10 THEN
       MID$(x$, 7, 1) = "D"
    END IF

    ' check for archive file
    IF (b% AND &H20) = &H20 THEN
       MID$(x$, 9, 1) = "A"
    END IF

    ' display attributes
    COLOR 14
    PRINT x$;

    ' display file date and time
    COLOR 10
    PRINT d$; " "; t$;

    ' display file size
    IF (b% AND &H10) = &H0 THEN
       COLOR 12
       GOSUB Format
       x$ = SPACE$(13) + x$
       x$ = RIGHT$(x$, 13)
       PRINT " "; x$;
       Total.Files& = Total.Files& + 1&
       Total.Bytes# = Total.Bytes# + CDBL(s&)
    ELSE
       COLOR 12
       PRINT " <DIR>";
       Total.Dirs& = Total.Dirs& + 1&
    END IF
    PRINT

    ' continue filefind.
    x$ = DIRx$("", b%, d$, t$, s&)
 LOOP
 IF Total.Files& = 0& THEN
    IF Total.Dirs& = 0& THEN
       COLOR 15
       PRINT "No matching files or dirs found."
    END IF
 END IF
 IF Total.Files& > 0& OR Total.Dirs& > 0& THEN
    GOSUB Count.Files2
    COLOR 15
    PRINT "------------ --------- ---------- -------- -------------"
    s& = Total.Files&
    GOSUB Format
    x$ = x$ + " Files"
    PRINT x$; SPACE$(20 - LEN(x$));
    s& = Total.Dirs&
    GOSUB Format
    x$ = x$ + " Directories"
    PRINT "   "; x$; SPACE$(20 - LEN(x$));
    s# = Total.Bytes#
    GOSUB Format2
    PRINT x$; " Bytes"
 END IF
 COLOR 7
 PRINT
 END

' counts files displayed
Count.Files1:
 Count = Count + 1
 IF Count >= 21 THEN
    Count = 0
    IF Continuous = 0 THEN
       COLOR 13
       PRINT "-more(y/n/c)-";
       Z$ = ""
       DO
	  Z$ = INKEY$
	  IF LEN(Z$) THEN
	     SELECT CASE UCASE$(Z$)
	     CASE "Y"
		EXIT DO
	     CASE "N"
		PRINT
		COLOR 7
		PRINT
		END
	     CASE "C"
		Continuous = -1
		EXIT DO
	     END SELECT
	  END IF
       LOOP
       PRINT
       GOSUB Header
    END IF
 END IF
 RETURN

' counts remaining files displayed
Count.Files2:
 Count = Count + 1
 IF Count >= 21 THEN
    IF Continuous = 0 THEN
       Count = 0
       COLOR 13
       PRINT "-more(y/n/c)-";
       DO
	  Z$ = INKEY$
	  IF LEN(Z$) THEN
	     SELECT CASE UCASE$(Z$)
	     CASE "Y"
		EXIT DO
	     CASE "N"
		PRINT
		COLOR 7
		PRINT
		END
	     CASE "C"
		Continuous = -1
		EXIT DO
	     END SELECT
	  END IF
       LOOP
       PRINT
    END IF
 END IF
 RETURN

' header for filelist
Header:
COLOR 15

REM filesize is right-justified for 13 chars. because maximum
REM filesize=2*1024^3 Equals: 2,147,483,648 for FAT32 which is LONG.

REM although extended FAT32 is twice that, DOS does not return it.

REM therefore, total.bytes should be DOUBLE which has 16 digit precision.

PRINT "Filename.ext Attribute Filedate   Filetime      Filesize"
PRINT "------------ --------- ---------- -------- -------------"
RETURN

' formats a LONG numeric string
Format:
 x$ = ""
 s$ = MID$(STR$(s&), 2)
 FOR l = LEN(s$) TO 3 STEP -3
    x$ = MID$(s$, l - 2, 3) + "," + x$
 NEXT
 IF l > 0 THEN
    x$ = MID$(s$, 1, l) + "," + x$
 END IF
 IF LEN(s$) < 3 THEN
    x$ = s$
 END IF
 IF RIGHT$(x$, 1) = "," THEN
    x$ = LEFT$(x$, LEN(x$) - 1)
 END IF
 RETURN

' formats a DOUBLE numeric string
Format2:
 x$ = ""
 s$ = MID$(STR$(s#), 2)
 FOR l = LEN(s$) TO 3 STEP -3
    x$ = MID$(s$, l - 2, 3) + "," + x$
 NEXT
 IF l > 0 THEN
    x$ = MID$(s$, 1, l) + "," + x$
 END IF
 IF LEN(s$) < 3 THEN
    x$ = s$
 END IF
 IF RIGHT$(x$, 1) = "," THEN
    x$ = LEFT$(x$, LEN(x$) - 1)
 END IF
 RETURN

' simple error routine
ModuleError:
 ' device I/O error
 IF ERR = 57 THEN
    Disk.Ready = 57
    RESUME NEXT
 END IF
 ' disk not ready
 IF ERR = 71 THEN
    Disk.Ready = 71
    RESUME NEXT
 END IF
 ' path not found
 IF ERR = 76 THEN
    Disk.Ready = 76
    RESUME NEXT
 END IF
 COLOR 7
 PRINT
 END

FUNCTION DIRx$ (Filespec$, Filebits%, Filedate$, Filetime$, FileSize&) STATIC
 ' define simple error routine
 ON ERROR GOTO ModuleError

 ' First call to function with a filespec starts filelist match, second
 ' and following calls to function with Null string return remaining
 ' filelist matches until DIR$ returns a Null value. Returns the bit
 ' attribute of the file, the filedate, filetime, and filesize.

 ' Function is Static to preserve variables between calls. DTA structure
 ' is used to store the search parameters. Also checks validity of drive
 ' letter. Also checks if disk not ready.

 DIM InregsX AS RegTypeX
 DIM OutregsX AS RegTypeX
 DIM DTAfile AS DTAtype
 DIM ASCIIZ AS STRING * 64
 DIM ASCIIZ2 AS STRING * 64
 DIM Current.DTA.SEG AS INTEGER
 DIM Current.DTA.OFF AS INTEGER

 IF Filespec$ = "" THEN
    GOSUB FindNext
 ELSE
    GOSUB CheckDrive
    ASCIIZ = UCASE$(Filespec$) + CHR$(0)
    GOSUB FindFirst
 END IF
 DIRx$ = Filename$
 EXIT FUNCTION

' initate findfile.
FindFirst:
 ' store current dta
 InregsX.AX = &H2F00
 CALL InterruptX(&H21, InregsX, OutregsX)
 Current.DTA.SEG = OutregsX.ES
 Current.DTA.OFF = OutregsX.BX

 ' store function dta
 InregsX.AX = &H1A00
 InregsX.DS = VARSEG(DTAfile)
 InregsX.DX = VARPTR(DTAfile)
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' findfirst
 InregsX.AX = &H4E00
 InregsX.CX = &H37
 InregsX.DS = VARSEG(ASCIIZ)
 InregsX.DX = VARPTR(ASCIIZ)
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' check carry flag error
 IF (OutregsX.flags AND &H1) = &H1 THEN
    Filebits% = 0
    Filename$ = ""
    Filedate$ = ""
    Filetime$ = ""
    FileSize& = 0&
 END IF
 IF (OutregsX.flags AND &H1) = &H0 THEN
    GOSUB Store.Fileinfo
 END IF

 ' restore current dta
 InregsX.AX = &H1A00
 InregsX.DS = Current.DTA.SEG
 InregsX.DX = Current.DTA.OFF
 CALL InterruptX(&H21, InregsX, OutregsX)
 RETURN

' continue filespec match.
FindNext:
 ' store current dta
 InregsX.AX = &H2F00
 CALL InterruptX(&H21, InregsX, OutregsX)
 Current.DTA.SEG = OutregsX.ES
 Current.DTA.OFF = OutregsX.BX

 ' store function dta
 InregsX.AX = &H1A00
 InregsX.DS = VARSEG(DTAfile)
 InregsX.DX = VARPTR(DTAfile)
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' find next filename
 InregsX.AX = &H4F00
 CALL InterruptX(&H21, InregsX, OutregsX)

 ' check carry flag error
 IF (OutregsX.flags AND &H1) = &H1 THEN
    Filebits% = 0
    Filename$ = ""
    Filedate$ = ""
    Filetime$ = ""
    FileSize& = 0&
 END IF
 IF (OutregsX.flags AND &H1) = &H0 THEN
    GOSUB Store.Fileinfo
 END IF

 ' restore current dta
 InregsX.AX = &H1A00
 InregsX.DS = Current.DTA.SEG
 InregsX.DX = Current.DTA.OFF
 CALL InterruptX(&H21, InregsX, OutregsX)
 RETURN

' check drive.
CheckDrive:
 Disk.Ready = 0
 IF MID$(Filespec$, 2, 1) = ":" THEN
    GOSUB StoreDrive
    Z$ = LEFT$(Filespec$, 1) + ":\"
    CHDIR Z$
    IF Disk.Ready THEN
       DIRx$ = ""
       EXIT FUNCTION
    END IF
    CHDIR DefaultDir$
 END IF
 RETURN

' store current drive/directory.
StoreDrive:
 InregsX.AX = &H1900
 CALL InterruptX(&H21, InregsX, OutregsX)
 Drive.Number = OutregsX.AX AND &HFF
 InregsX.AX = &H4700
 InregsX.DX = Drive.Number + 1
 InregsX.DS = VARSEG(ASCIIZ2)
 InregsX.SI = VARPTR(ASCIIZ2)
 CALL InterruptX(&H21, InregsX, OutregsX)
 DefaultDir$ = LEFT$(ASCIIZ2, INSTR(ASCIIZ2, CHR$(0)) - 1)
 IF LEFT$(DefaultDir$, 1) <> "\" THEN
    DefaultDir$ = "\" + DefaultDir$
 END IF
 RETURN

' store file information
Store.Fileinfo:
 ' store filename attribute bits
 Filebits% = ASC(DTAfile.Filebits)
 ' store file date
 Work! = ASC(MID$(DTAfile.Filedate, 2, 1))
 Work! = Work! * &H100 + ASC(MID$(DTAfile.Filedate, 1, 1))
 YearTemp! = INT(Work! / 512)
 MonthTemp! = INT((Work! AND &H1E0) / 32)
 DayTemp! = INT(Work! AND &H1F)
 YearTemp! = YearTemp! + 1980
 Filedate$ = RIGHT$(STR$(MonthTemp! + 100), 2) + "-" + RIGHT$(STR$(DayTemp! + 100), 2) + "-" + MID$(STR$(YearTemp!), 2)
 ' store file time
 Work! = ASC(MID$(DTAfile.Filetime, 2, 1))
 Work! = Work! * &H100 + ASC(MID$(DTAfile.Filetime, 1, 1))
 HourTemp! = INT(Work! / 2048)
 MinuteTemp! = INT((Work! AND &H7E0) / 32)
 SecondsTemp! = INT((Work! AND &H1F) / 2)
 Filetime$ = RIGHT$(STR$(HourTemp! + 100), 2) + ":" + RIGHT$(STR$(MinuteTemp! + 100), 2) + ":" + RIGHT$(STR$(SecondsTemp! + 100), 2)
 ' store filesize
 FileSize& = ASC(MID$(DTAfile.FileSize, 4, 1))
 FileSize& = FileSize& * &H100 + ASC(MID$(DTAfile.FileSize, 3, 1))
 FileSize& = FileSize& * &H100 + ASC(MID$(DTAfile.FileSize, 2, 1))
 FileSize& = FileSize& * &H100 + ASC(MID$(DTAfile.FileSize, 1, 1))
 ' strip filename from ASCIIZ
 Filename$ = DTAfile.ASCIIZfilename
 Filename$ = LEFT$(Filename$, INSTR(Filename$, CHR$(0)) - 1)
 RETURN
END FUNCTION

