'===========================================================================
' Subject: FILE/DIRECTORY SELECTOR           Date: 06-30-00 (15:25)       
' Author:  Antoni Gual                       Code: QB, QBasic, PDS        
' Origin:  agual@eic.ictnet.es             Packet: DOS.ABC
'===========================================================================
DECLARE FUNCTION DiskReady% (d$)
DECLARE FUNCTION SelectAFile$ (header$, ext$)
'
' Here are two useful routines for QBasic and QB
' without a single line of assembler:
'
' Self-contained drive check routine
' by Antoni Gual agual@eic.ictnet.es
' from a batch by Tom Lavedas
'
' User friendly file select routine
' by Antoni Gual agual@eic.ictnet.es
' Rewritten completely from a layout by William Yu
'
' enjoy it!
'
CONST false = 0, true = NOT false

'------------------------------demo-----------------------------------------
SCREEN 0: COLOR 7, 1: WIDTH , 50: CLS
GOTO sel
LOCATE 1, 1: PRINT CHR$(201); STRING$(78, 205); CHR$(187);
FOR i = 2 TO 23
LOCATE i, 1: PRINT CHR$(186); : LOCATE , 80: PRINT CHR$(186);
NEXT
LOCATE 24, 1: PRINT CHR$(200); STRING$(78, 205); CHR$(188);
COLOR 14
LOCATE 2, 31: PRINT "DiskReady Sub DEMO"
COLOR 7
LOCATE 5, 32: PRINT "Testing drives...";
FOR i = ASC("A") TO ASC("L")
    a$ = CHR$(i)
    b = DiskReady(a$)
    LOCATE i - 58, 2
    SELECT CASE b
    CASE 0: PRINT "Bingo!: Drive "; a$; ": is not yet broken!";
    CASE 1: PRINT "Where am I supposed to read data? Air? Put something in drive "; a$; "!";
    CASE 2: PRINT "It's a joke? You did'nt pay enough for your PC to have a drive named "; a$; ":";
    CASE 3: PRINT "You're supposed to be working hard! What's all that rock'n roll in drive "; a$; ":?";
    END SELECT
NEXT
LOCATE 22, 22: PRINT "Press any key to go to SelectAFile Sub Demo..";
SLEEP
sel:
SCREEN 0: COLOR 7, 1: WIDTH , 50: CLS
LOCATE 6: PRINT "Current dir is ": SHELL "CD"
LOCATE 8: PRINT "And if you press a key you will be prompted to select a file!"
PCOPY 0, 1
a$ = INPUT$(1)
a$ = SelectAFile$("Select any file: I will do absolutely nothing with it!", "txt")
PCOPY 1, 0

IF LEN(a$) THEN
    LOCATE 10: PRINT "You selected: "; a$
    OPEN a$ FOR BINARY AS #1:
    SHELL "echo I opened it and i found It has " + STR$(LOF(1)) + " bytes"
    CLOSE
ELSE
    LOCATE 10: PRINT "You exit SelectAFile without selecting anithing"
END IF
SHELL "echo And Current dir is still": SHELL "CD"
PRINT "press any key": a$ = INPUT$(1)
SCREEN 0: COLOR 7, 1: WIDTH , 25: CLS
a$ = SelectAFile$("Here We Go Again!", "*")
LOCATE 10: PRINT "You selected: "; a$
END

DEFINT A-Z
FUNCTION DiskReady (d$)
'
'Self-contained drive check routine
'by Antoni Gual agual@eic.ictnet.es
'from a batch by Tom Lavedas
'
' Use as you want, only give me credit
'
'returns:   0 if drive exists and it's ready
'           1 if drive is not ready
'           2 if drive does not exist
'           3 if drive exists and disk is an audio CD
'
'supposed to run in any dos from MSDOS 3.1. Tested in Win 95 and DOS 6.2
'detects RAM disks and it's supposed to detect network units
'Does not use interrupt calls!
'uses temporary files in path set in variable TEMP so it's supposed to exist
'---------------------------------------------------------------------------
tempfile$ = ENVIRON$("TEMP") + "\temp.txt"
drive$ = LEFT$(UCASE$(d$), 1) + ":"
IF drive$ = "B:" THEN
    OUT &H70, &H10
    IF (INP(&H71) AND 7) = 0 THEN DiskReady = 2: EXIT FUNCTION
END IF
t$ = "c:\}{.bat"
f = FREEFILE
z$ = CHR$(34)

OPEN t$ FOR OUTPUT AS #f
PRINT #f, "@echo off"
PRINT #f, "ctty nul"
PRINT #f, "%comspec% /f /c vol %1 |find /c /I " + z$ + "vol" + z$ + "|choice /n/c210 >" + tempfile$
PRINT #f, "if errorlevel 3 goto End"
PRINT #f, "%comspec% /f /c dir  %1\!dummy!.@@@ | find /c " + z$ + "Dir" + z$ + " |choice/n/c10 >>" + tempfile$
PRINT #f, "if errorlevel 2 goto End"
PRINT #f, "dir %1\!dummy!.@@@ | find /c " + z$ + "Audio CD" + z$ + " >>c:\temp.txt"
PRINT #f, ":End"
PRINT #f, "ctty con"
CLOSE f
SHELL t$ + " " + drive$
OPEN tempfile$ FOR INPUT AS #f
a$ = ""
WHILE NOT EOF(f): LINE INPUT #f, b$: a$ = a$ + b$: WEND
CLOSE f
SELECT CASE a$
CASE "0"
    DiskReady = 2
CASE "10"
    DiskReady = 1
CASE "210", "110"
    DiskReady = 0
CASE "211"
    DiskReady = 3
END SELECT
KILL t$: KILL tempfile$
END FUNCTION

FUNCTION SelectAFile$ (header$, ext$)
'
' User friendly file selector routine.Returns full path of a file
' by Antoni Gual agual@eic.ictnet.es
' Fully reprogrammed from a layout by William Yu
'
' Use as you want, only give me credit
'
' FEATURES:
' Does'nt use any interrupt call.(Very slow checking drives)
' Should not display DOS error messages when disk not ready
' Tested in Win 95/98 and  DOS 6.1-Win 3.11.
' Auto detects num of screen lines set by main program.
' Tested with QBasic
' Not self contained, needs DiskReady routine
' No mouse!
' Returns to current dir before exiting
' In W95/98 displays LFN, but returns 8.3 format
'   (QB file functions can't handle LFN)
'
' REMARKS:
' For non Win 9x users: It Runs faster if temp path is set to a RAM drive!
' Creates some auxiliar files: To do it, uses path in temp system variable
' To use it with DOS < 5.0 try changing constant DOS to 3 (Sorry..I.Can't test it)
' To avoid drive checking each time the routine is run, read comment
'    6 lines above EXIT FUNCTION
'-------------------------------------------------------------------------
'PUT DOS TO 3 IF THE PROGRAM HAS TO RUN UNDER DOS BELOW 5.0
DIM z$
CONST dos = 5

'keys
CONST kpgup = -&H49, kpgdn = -&H51
CONST kleft = -&H4B, kright = -&H4D, kup = -&H48, kdown = -&H50
CONST kenter = &HD, kesc = &H1B

q$ = CHR$(34)

'colors
CONST fgiuns = 7, bgiuns = 0, fgauns = 15, bgauns = 0
CONST fgisel = 12, bgisel = 0, fgasel = 15, bgasel = 4

'auxiliar files
pth$ = ENVIRON$("TEMP") + "\"
IF pth$ = "\" THEN
        PRINT "Sorry. The file selection routine requires TEMP variable to be set"
        EXIT FUNCTION
END IF
DIM auxf$(1 TO 3):
auxf$(3) = pth$ + "}{drive.lst": auxf$(2) = pth$ + "}{dir.lst"
auxf$(1) = pth$ + "}{file.lst"
tempfile$ = pth$ + "temp.txt"
'Detect Nr of lines of screen
DEF SEG = &H40
scrl = PEEK(&H84) + 1
DEF SEG

DIM wd(0 TO 4, 1 TO 3)
'vertical window sizes
CONST wintop = 8
winbot = scrl - 7: winheight = winbot - wintop + 1
'indexs
CONST wdxpos = 0, wdwdth = 1, wdtop = 2, wdcur = 3, wdcount = 4


GOSUB detectwindows

'init
wd(wdxpos, 1) = 8: wd(wdxpos, 2) = 38: wd(wdxpos, 3) = 68
IF win THEN
    wd(wdwdth, 1) = 24: wd(wdwdth, 2) = 24: wd(wdwdth, 3) = 6
ELSE
    wd(wdwdth, 1) = 12: wd(wdwdth, 2) = 8: wd(wdwdth, 3) = 6
END IF
wd(wdtop, 1) = 1: wd(wdtop, 2) = 1: wd(wdtop, 3) = 1


'strings with windows width
DIM t$(1 TO 3): FOR i = 1 TO 3: t$(i) = SPACE$(wd(wdwdth, i)): NEXT
h$ = SPACE$(64)


'prepare command strings
IF dos = 5 THEN
    IF win THEN x$ = " /Z"
        dosdirs$ = "DIR  /AD /ON /B >" + auxf$(2)
       dosfiles$ = "DIR *." + ext$ + " /A-D /ON /B >" + auxf$(1)
ELSE
    dosdirs$ = "DIR *.* |FIND " + q$ + "<DIR>" + q$ + " >" + auxf$(2)
    dosfiles$ = "DIR *." + ext$ + " | FIND " + q$ + ":" + q$ + "|FIND /V " + q$ + "<DIR>" + q$ + "|FIND /V " + q$ + ":\" + q$ + " >" + auxf$(1)
END IF

temp = INSTR(ext$, "."): IF temp THEN ext$ = MID$(ext$, temp + 1)

'check all possible drives and build a drive list
file$ = auxf$(3): GOSUB filexist
IF exist = false THEN
    f = FREEFILE: OPEN auxf$(3) FOR OUTPUT AS #f
    COLOR 7, 0: CLS : PRINT "Checking existing drives: please wait!"
    FOR i = ASC("A") TO ASC("Z")
        IF DiskReady(CHR$(i)) <> 2 THEN
            LSET t$(3) = "-[" + CHR$(i) + ":]-"
            PRINT #f, t$(3)
        END IF
    NEXT
    CLOSE #f
END IF
f = FREEFILE: OPEN auxf$(3) FOR INPUT AS #f
w1 = 3: GOSUB ITEMCOUNT
CLOSE f

'init screen
SCREEN 0: COLOR 7, 1: CLS
COLOR 14: LOCATE 1, 40 - LEN(header$) \ 2: PRINT header$;
'top rectangle
LOCATE 3, 4: COLOR 9, 0: PRINT CHR$(218); STRING$(72, 196); CHR$(191)
LOCATE 4, 4: PRINT CHR$(179); STRING$(72, 0); CHR$(179)
LOCATE 5, 4: PRINT CHR$(192); STRING$(72, 196); CHR$(217)

'other rectangles
FOR x1 = 1 TO 3: GOSUB rect: NEXT
COLOR 14, 1: LOCATE scrl - 2, 2
PRINT "Up/Dn Pgup/PgDn Move cursor, Left/Right Change Panel, Enter Select, Esc Quit";

'clear keyboard buffer
WHILE LEN(INKEY$): WEND

'cursor will start in files' window
actwin = 1
GOSUB CURDIR
startdir$ = MID$(CURDIR$, 1, LEN(CURDIR$) - 1)

updatedrive:
f = FREEFILE: OPEN auxf$(3) FOR INPUT AS #f
    w1 = 3: GOSUB updatewin
CLOSE f

'update dir list
updatedir:

GOSUB CURDIR
SHELL dosdirs$
f = FREEFILE
IF dos = 5 THEN
    OPEN auxf$(2) FOR APPEND AS #f: PRINT #f, ".":
    IF LEN(CURDIR$) > 3 THEN PRINT #f, ".."
    CLOSE f
END IF
OPEN auxf$(2) FOR INPUT AS #f
    w1 = 2: GOSUB ITEMCOUNT: GOSUB updatewin
CLOSE f

'update file list
SHELL dosfiles$
f = FREEFILE: OPEN auxf$(1) FOR INPUT AS #f
    w1 = 1: GOSUB ITEMCOUNT: GOSUB updatewin
    IF wd(wdcount, 1) = 0 THEN actwin = 2: w1 = 2: GOSUB updatewin
CLOSE f

'keys loop
'program will stay in this loop unless window change or press enter or esc
movecursor:
w1 = actwin
OPEN auxf$(actwin) FOR INPUT AS #f
DO
    GOSUB updatewin
    DO: V$ = INKEY$: LOOP UNTIL LEN(V$)
    V = ASC(RIGHT$(V$, 1)): IF ASC(V$) = 0 THEN V = -V
    SELECT CASE V
    CASE kup:
         wd(wdcur, w1) = wd(wdcur, w1) - 1
         IF wd(wdcur, w1) < 1 THEN wd(wdcur, w1) = 1
    CASE kdown:
         wd(wdcur, w1) = wd(wdcur, w1) + 1
         IF wd(wdcur, w1) > wd(wdcount, w1) THEN wd(wdcur, w1) = wd(wdcount, w1)
    CASE kpgup:
         wd(wdcur, w1) = wd(wdcur, w1) - winheight
         IF wd(wdcur, w1) < 1 THEN wd(wdcur, w1) = 1
    CASE kpgdn:
         wd(wdcur, w1) = wd(wdcur, w1) + winheight
         IF wd(wdcur, w1) > wd(wdcount, w1) THEN wd(wdcur, w1) = wd(wdcount, w1)
    'change active window
    CASE kleft:
        IF actwin > 1 THEN
           IF actwin <> 2 OR wd(wdcount, 1) > 0 THEN
            actwin = actwin - 1: GOSUB updatewin: CLOSE #f: GOTO movecursor
           END IF
        END IF
    'change active window
    CASE kright:
        IF actwin < 3 THEN
            actwin = actwin + 1: GOSUB updatewin: CLOSE #f: GOTO movecursor
        END IF
    'select file in file window, change dir or drive in other windows
    CASE kenter:
        WHILE DiskReady(newdrive$) = 1
            err$ = "Disk " + newdrive$ + " not ready   [R]etry/[C]ancel?": GOSUB errmsg
            IF a$ <> "R" THEN CLOSE f: SHELL "C:": GOTO updatedrive
        WEND
        SELECT CASE actwin
        'select file and exit
        CASE 1:
            IF LEN(newfile$) THEN
                CLOSE f: TMP$ = CURDIR$ + newfile$
                IF win THEN
                    'truename fails with filenames so i use it only with dir name
                    doscmd$ = "TRUENAME |find " + q$ + ":\" + q$ + ">" + tempfile$
                    SHELL doscmd$
                    OPEN tempfile$ FOR INPUT AS f: LINE INPUT #f, TP$: CLOSE f
                    TMP$ = TP$: IF LEN(TMP$) > 3 THEN TMP$ = TMP$ + "\"
                    KILL tempfile$
                    doscmd$ = "DIR /A-D " + q$ + newfile$ + q$ + "|FIND " + q$ + ":" + q$ + "|FIND /V " + q$ + ":\" + q$ + ">" + "tempfile$"
                    SHELL doscmd$
                    OPEN tempfile$ FOR INPUT AS f: LINE INPUT #f, TP$: CLOSE f
                    t$ = SPACE$(12): LSET t$ = TP$: MID$(t$, 9) = "."
                    TMP$ = TMP$ + RTRIM$(t$)
                END IF
                SelectAFile$ = TMP$: EXIT DO
            ELSE
                actwin = actwin + 1: GOSUB updatewin
            END IF
        'change dir
        CASE 2:
            IF newdir$ <> "." THEN
                IF (LEN(CURDIR$) > 3) OR (newdir$ <> "..") THEN
                    CLOSE f: SHELL "CD " + newdir$: GOTO updatedir
                END IF
            END IF
        'change drive
        CASE 3:
             CLOSE f: SHELL newdrive$: GOTO updatedrive
        END SELECT
    CASE kesc:
        CLOSE #f: SelectAFile$ = "": EXIT DO
    END SELECT
LOOP
KILL auxf$(1)
KILL auxf$(2)
'KILL auxf$(3) 'this file (}{drive.lst) keeps the list of valid drives
'              to avoid drive testing each time the routine is run
'              put a REM in  this line and erase the file at program's end.
'              (Or don't erase it, if your drives are all fixed)
IF win THEN z$ = q$ ELSE z$ = ""
SHELL z$ + startdir$ + "\"
SHELL "cd " + z$ + startdir$
CLS
EXIT FUNCTION

'---------------------------gosubs------------------------------------------
'update window W1 from the contents of already opened file f
updatewin:
    SEEK #f, 1
    IF actwin = w1 THEN isactive = true ELSE isactive = false
    IF wd(wdcur, w1) < wd(wdtop, w1) THEN wd(wdtop, w1) = wd(wdcur, w1)
    IF wd(wdcur, w1) > (wd(wdtop, w1) + winheight - 1) THEN wd(wdtop, w1) = wd(wdcur, w1) - winheight + 1
    i = 1: j = wintop: k = wd(wdleft, w1)
    WHILE NOT EOF(f) AND j <= winbot
        LINE INPUT #f, a$
        IF i >= wd(wdtop, w1) THEN
            LSET t$(w1) = a$
            IF i = wd(wdcur, w1) THEN
                IF isactive THEN COLOR fgasel, bgasel ELSE COLOR fgisel, bgisel
                SELECT CASE w1
                 CASE 1: newfile$ = RTRIM$(a$)
                    'IF LEN(NEWFILE$) > 9 THEN MID$(NEWFILE$, 9) = "."
                 CASE 2: newdir$ = RTRIM$(a$): IF win THEN newdir$ = q$ + newdir$
                 CASE 3: newdrive$ = MID$(t$(w1), 3, 2)
                END SELECT
            ELSE
                IF isactive THEN COLOR fgauns, bgauns ELSE COLOR fgiuns, bgiuns
            END IF
            LOCATE j, k: PRINT t$(w1); : j = j + 1
        END IF
        i = i + 1
    WEND
    LSET t$(w1) = "": COLOR fgiuns, bgiuns
    FOR j1 = j TO winbot
       LOCATE j1, k: PRINT t$(w1)
    NEXT
RETURN

'GUI: draw a shadowed rectangle, dimensions in wd(?,x1)
rect:
    COLOR 9, 7: LOCATE wintop - 1, wd(wdxpos, x1) - 1
    PRINT CHR$(218); STRING$(wd(wdwdth, x1), 196); CHR$(191)
    FOR j = wintop TO winbot
      LOCATE j, wd(wdxpos, x1) - 1
      PRINT CHR$(179); STRING$(wd(wdwdth, x1), 32); CHR$(179)
    NEXT j
    LOCATE winbot + 1, wd(wdxpos, x1) - 1
    PRINT CHR$(192); STRING$(wd(wdwdth, x1), 196); CHR$(217)
    FOR j = wintop TO winbot + 1
        LOCATE j, wd(wdxpos, x1) + wd(wdwdth, x1) + 1: COLOR 0
        PRINT STRING$(2, 219)
    NEXT j
    LOCATE winbot + 2, wd(wdxpos, x1) + 2: PRINT STRING$(wd(wdwdth, x1) + 1, 219)
RETURN

'save current dir and drive to recover it after routine's end
CURDIR:
    SHELL "CD > c:\curr.dir"
    f = FREEFILE: OPEN "c:\curr.dir" FOR INPUT AS #f
    LINE INPUT #f, CURDIR$
    IF LEN(CURDIR$) <> 3 THEN CURDIR$ = CURDIR$ + "\"
    curdrive$ = LEFT$(CURDIR$, 1)
    CLOSE f: KILL "c:\curr.dir"
    OPEN auxf$(3) FOR INPUT AS #f
        i = 0
        DO: i = i + 1: LINE INPUT #f, a$: LOOP UNTIL INSTR(a$, curdrive$)
    CLOSE f
    wd(wdcur, 3) = i
    LSET h$ = CURDIR$ + "*." + ext$
    LOCATE 4, 6: COLOR 10: PRINT h$;
RETURN

'detect Windows 95: if detected, use LFN
detectwindows:
    doscmd$ = "ver >" + tempfile$
    SHELL doscmd$
    f1 = FREEFILE: OPEN tempfile$ FOR INPUT AS #f1:
    win = false
    WHILE NOT EOF(f1) AND win = false
        LINE INPUT #f1, a$
        IF INSTR(a$, "Windows") THEN win = true
    WEND
    CLOSE f1
RETURN

'check if a file exists
filexist:
    f = FREEFILE: OPEN file$ FOR BINARY AS #f
    IF LOF(f) = 0 THEN exist = false: CLOSE #f: KILL file$ ELSE exist = true: CLOSE #f
RETURN

'count items in list file
ITEMCOUNT:
    j = 0: WHILE NOT EOF(f): LINE INPUT #f, a$: j = j + 1: WEND
    wd(wdcount, w1) = j: wd(wdcur, w1) = 1
RETURN

'displays an eror message and waits for a key
errmsg:
    LSET h$ = err$
    LOCATE 4, 6: COLOR 12: PRINT h$;
    a$ = UCASE$(INPUT$(1)): LSET h$ = "": LOCATE 4, 6: PRINT h$
RETURN

END FUNCTION