'===========================================================================
' Subject: DIRECTORY/FILE LIST ROUTINE        Date: 10-02-99 (21:10)       
'  Author: Aaron Severn                       Code: QB, PDS                
'  Origin: rlsevern@idirect.com             Packet: DOS.ABC
'===========================================================================
'****************************************************************************
' DIR.BAS
' Programmed by Aaron Severn (bob_severn@msn.com)
' Nov 7/97
'
' A few little routines to retrieve directory info and let you scroll around
' in it.
'
' This stuff is public domain, use it how you like just so long as I get
' credit for it.  I'm not liable for any damages, but if you use this
' properly, it shouldn't cause any damages.
'
' As for the routines:
'       CheckDrive      - Checks to see if a drive exists.  Pass the single
'                         letter upper case drive name to it.  Example:  if
'                         you want to see if drive E exists type
'                         var = CheckDrive("E"), if var = 1, drive E exists,
'                         if var = 0, it doesn't.
'       GetDir          - Gets all files but no directories and stores them in
'                         the files$() array.  Path$ is the full path with
'                         wild card to the current directory
'                         (eg. "C:\WINDOWS\*.*").  FilePos is where in the
'                         array to start placing the names (if filePos = 3
'                         then storage will start at files$(3)).  Returns 1
'                         if successful, 0 if failed (failure happens when an
'                         invalid path is entered or when there are no files
'                         with the specified wild card in the directory).
'       GetDirectories  - The same as GetDir excepts it fills files$() with
'                         only directories.
'       GetDrive$       - Returns the current drive.
'       GetFullPath$    - Returns the path containing drive and directory
'                         info.  (eg. "C:\DOS")
'       GetNumDrives    - Returns how many drives exist, which can be used to
'                         find out which drives exists.  Example:  if
'                         GetNumDrives returns 4 then A, B, C, and D drives
'                         exist.
'       GetPath$        - Returns the path without drive info.
'                         (eg. "WINDOWS\COMMAND")
'       OpenWindow      - A routine to display in mode 13h a file open window
'                         which lets you choose from a list of files and
'                         change drives and directories.
'       Sort            - A bubble sort routine with alphabetizes a list of
'                         words passed in array$().  Sorting starts at the
'                         element defined by first and ends at element last.
'                         Example:  Sort names$(), 10, 15 sorts the words in
'                         names$() from names$(10) to names$(15).
'****************************************************************************

DEFINT A-Z

DECLARE FUNCTION CheckDrive (drive$)
DECLARE FUNCTION GetDir (files$(), path$, filePos)
DECLARE FUNCTION GetDirectories (files$(), path$, filePos)
DECLARE FUNCTION GetDrive$ ()
DECLARE FUNCTION GetFullPath$ ()
DECLARE FUNCTION GetNumDrives ()
DECLARE FUNCTION GetPath$ ()
DECLARE SUB OpenWindow ()
DECLARE SUB Sort (array$(), first, last)

TYPE FileBuffer
    DOS AS STRING * 19
 Create AS STRING * 1
 Attrib AS INTEGER
 AcTime AS INTEGER
 AcDate AS INTEGER
  FSize AS LONG
  FName AS STRING * 13
END TYPE

TYPE RegType
    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

DIM SHARED Regs AS RegType

ON ERROR GOTO handler

SCREEN 13
CLS

OpenWindow
SYSTEM

handler:

SELECT CASE ERR
       CASE 71
           RESUME NEXT
       CASE ELSE
           SCREEN 0: WIDTH 80
           PRINT "Program terminated.  Error code"; ERR
           SYSTEM
END SELECT

FUNCTION CheckDrive (drive$)

Regs.AX = &H440E
Regs.BX = ASC(drive$) - 64
CALL interrupt(&H21, Regs, Regs)
IF Regs.FLAGS AND 1 THEN CheckDrive = 0 ELSE CheckDrive = 1

END FUNCTION

FUNCTION GetDir (files$(), path$, filePos)

DIM Buffer AS FileBuffer

IF RIGHT$(path$, 1) <> CHR$(0) THEN path$ = path$ + CHR$(0)

Regs.AX = &H1A00
Regs.DS = VARSEG(Buffer)
Regs.DX = VARPTR(Buffer)
CALL interrupt(&H21, Regs, Regs)

Regs.AX = &H4E00
Regs.CX = 16
Regs.DX = SADD(path$)
CALL interruptx(&H21, Regs, Regs)
FM = (Regs.AX AND &HF)
IF Regs.FLAGS AND 1 THEN
  GetDir = 0
  EXIT FUNCTION
END IF

DO WHILE FM = 0
  IF LEFT$(Buffer.FName, 1) <> "." THEN
    fileName$ = RTRIM$(Buffer.FName)
    IF Buffer.Attrib <> &H1000 THEN
      files$(filePos) = fileName$
      IF LEN(files$(filePos)) < 18 THEN
        files$(filePos) = files$(filePos) + STRING$(18 - LEN(files$(filePos)), 32)
      END IF
      filePos = filePos + 1
    END IF
    Buffer.Attrib = 0: Buffer.AcTime = 0: Buffer.AcDate = 0
    Buffer.FSize = 0: Buffer.FName = STRING$(13, 32)
  END IF

  Regs.AX = &H4F00
  Regs.DX = SADD(path$)
  CALL interrupt(&H21, Regs, Regs)
  FM = Regs.AX AND &HF
LOOP
                    
GetDir = 1

END FUNCTION

FUNCTION GetDirectories (files$(), path$, filePos)

DIM Buffer AS FileBuffer

IF RIGHT$(path$, 1) <> CHR$(0) THEN path$ = path$ + CHR$(0)

Regs.AX = &H1A00
Regs.DS = VARSEG(Buffer)
Regs.DX = VARPTR(Buffer)
CALL interrupt(&H21, Regs, Regs)

Regs.AX = &H4E00
Regs.CX = 16
Regs.DX = SADD(path$)
CALL interruptx(&H21, Regs, Regs)
FM = (Regs.AX AND &HF)
IF Regs.FLAGS AND 1 THEN
  GetDirectories = 0
  EXIT FUNCTION
END IF

DO WHILE FM = 0
  IF LEFT$(Buffer.FName, 1) <> "." THEN
    fileName$ = RTRIM$(Buffer.FName)
    IF Buffer.Attrib = &H1000 THEN
      files$(filePos) = fileName$
      IF LEN(files$(filePos)) < 13 THEN
        files$(filePos) = files$(filePos) + STRING$(13 - LEN(files$(filePos)), 32)
      END IF
      files$(filePos) = files$(filePos) + "<DIR>"
      filePos = filePos + 1
    END IF
    Buffer.Attrib = 0: Buffer.AcTime = 0: Buffer.AcDate = 0
    Buffer.FSize = 0: Buffer.FName = STRING$(13, 32)
  END IF

  Regs.AX = &H4F00
  Regs.DX = SADD(path$)
  CALL interrupt(&H21, Regs, Regs)
  FM = Regs.AX AND &HF
LOOP
                   
GetDirectories = 1

END FUNCTION

FUNCTION GetDrive$

Regs.AX = &H1900
CALL interrupt(&H21, Regs, Regs)
GetDrive$ = CHR$(65 + Regs.AX MOD 256)

END FUNCTION

FUNCTION GetFullPath$

GetFullPath$ = GetDrive$ + ":\" + GetPath$

END FUNCTION

FUNCTION GetNumDrives

curDrive$ = GetDrive$

Regs.AX = &HE00
Regs.DX = ASC(curDrive$) - 65
CALL interrupt(&H21, Regs, Regs)
tempVal = (Regs.AX MOD 256) - 1

FOR i = 1 TO tempVal
   IF CheckDrive(CHR$(i + 64)) = 0 THEN EXIT FOR
NEXT

GetNumDrives = i - 1

END FUNCTION

FUNCTION GetPath$

path$ = STRING$(64, 32)
curDrive$ = GetDrive$

Regs.AX = &H4700
Regs.DX = ASC(curDrive$) - 64
Regs.DS = VARSEG(path$)
Regs.SI = SADD(path$)
CALL interruptx(&H21, Regs, Regs)
path$ = RTRIM$(path$)
GetPath$ = LEFT$(path$, LEN(path$) - 1)

END FUNCTION

SUB OpenWindow

DIM files$(1000)

DIM highlight(712)

LINE (0, 0)-(156, 8), 15, BF
GET (0, 0)-(156, 8), highlight
PUT (0, 0), highlight, XOR

LINE (80, 50)-(240, 150), 15, B

highlightPos = 0
startPos = 0
filePos = 0
path$ = GetFullPath$

numDrives = GetNumDrives

FOR i = 1 TO numDrives
   files$(filePos) = "[-" + CHR$(i + 64) + "-]" + STRING$(13, 32)
   filePos = filePos + 1
NEXT

DO
  highlightPos = 0
  startPos = 0
 
  IF GetPath$ <> "" THEN
    files$(filePos) = "..           <DIR>"
    filePos = filePos + 1
  END IF

  tempPath$ = ""
  IF LEN(path$) > 3 THEN tempPath$ = path$ + "\" ELSE tempPath$ = path$
  tempPath$ = tempPath$ + "*.*"
  isGood = GetDirectories(files$(), tempPath$, filePos)
  IF isGood THEN Sort files$(), numDrives, filePos - 1
 
  startFilePos = filePos
  tempPath$ = ""
  IF LEN(path$) > 3 THEN tempPath$ = path$ + "\" ELSE tempPath$ = path$
  tempPath$ = tempPath$ + "*.*"
  isGood = GetDir(files$(), tempPath$, filePos)
  IF isGood = 0 THEN
    files$(filePos) = "--No files found--"
    filePos = filePos + 1
  ELSE
    Sort files$(), startFilePos, filePos - 1
  END IF

  selection$ = ""

  DO
    FOR i = startPos TO startPos + 10
       LOCATE i - startPos + 8, 12
       PRINT files$(i)
       IF (i - startPos) = highlightPos THEN PUT (82, (i - startPos) * 8 + 55), highlight
    NEXT

    DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
    DO: LOOP UNTIL INKEY$ = ""

    oldHPos = highlightPos

    SELECT CASE a$
           CASE CHR$(0) + CHR$(72)
               IF highlightPos > 0 THEN
                 highlightPos = highlightPos - 1
               ELSE
                 IF startPos > 0 THEN startPos = startPos - 1
               END IF
           CASE CHR$(0) + CHR$(80)
               IF highlightPos < 10 AND highlightPos < filePos THEN
                 highlightPos = highlightPos + 1
               ELSE
                 IF startPos < filePos - 11 THEN startPos = startPos + 1
               END IF
           CASE CHR$(13)
               selection$ = files$(startPos + highlightPos)
    END SELECT

    WAIT &H3DA, 8

    PUT (82, oldHPos * 8 + 55), highlight, XOR
  LOOP UNTIL a$ = CHR$(27) OR a$ = CHR$(13)

  IF a$ = CHR$(13) THEN
    IF LEFT$(selection$, 1) = "[" THEN
      drive$ = MID$(selection$, 3, 1)
      drive$ = drive$ + ":\"
      CHDIR drive$
      newFilePos = numDrives
      FOR i = newFilePos TO filePos: files$(i) = "": NEXT
      filePos = newFilePos
      path$ = GetFullPath$
      LINE (81, 51)-(239, 149), 0, BF
    ELSEIF selection$ = "--No files found--" THEN
      BEEP
      newFilePos = numDrives
      FOR i = newFilePos TO filePos: files$(i) = "": NEXT
      filePos = newFilePos
      path$ = GetFullPath$
      LINE (81, 51)-(239, 149), 0, BF
    ELSEIF LEFT$(selection$, 2) = ".." THEN
      DO
        path$ = LEFT$(path$, LEN(path$) - 1)
      LOOP UNTIL RIGHT$(path$, 1) = "\"
      path$ = LEFT$(path$, LEN(path$) - 1)
      IF LEN(path$) = 2 THEN path$ = path$ + "\"
      CHDIR path$
      newFilePos = numDrives
      FOR i = newFilePos TO filePos: files$(i) = "": NEXT
      filePos = newFilePos
      path$ = GetFullPath$
      LINE (81, 51)-(239, 149), 0, BF
    ELSEIF RIGHT$(selection$, 5) = "<DIR>" THEN
      selection$ = RTRIM$(LEFT$(selection$, 13))
      IF LEN(path$) > 3 THEN path$ = path$ + "\"
      path$ = path$ + selection$
      CHDIR path$
      newFilePos = numDrives
      FOR i = newFilePos TO filePos: files$(i) = "": NEXT
      filePos = newFilePos
      path$ = GetFullPath$
      LINE (81, 51)-(239, 149), 0, BF
    ELSE
      selection$ = RTRIM$(selection$)
      a$ = CHR$(27)
    END IF
  END IF
LOOP UNTIL a$ = CHR$(27)

IF selection$ <> "" THEN LOCATE 1, 1: PRINT "File selected: "; selection$

END SUB

SUB Sort (array$(), first, last)

FOR i = first TO last - 1
   FOR j = i + 1 TO last
      IF array$(j) < array$(i) THEN SWAP array$(j), array$(i)
   NEXT
NEXT

END SUB