'===========================================================================
' Subject: BROWSE FILES USING SHELL           Date: 11-20-00 (23:11)       
'  Author: Joel Nothman                       Code: QB, QBasic, PDS        
'  Origin: jnothman@crosswinds.net          Packet: DOS.ABC
'===========================================================================
'Joel Nothman's hex-free file browser!

'This browser works, without a single & in the file!
'(except for the above comment)
'No extra libraries required!
'No ASM!

'i'm sorry about the number of functions, i just like splitting things up...

DECLARE SUB FindHDisks ()
DECLARE FUNCTION AddBackSlash$ (t$)
DECLARE FUNCTION BackDir$ (t$)
DECLARE SUB CharBox (x1!, y1!, x2!, y2!)
DECLARE SUB ClearBlock (x!, y!, w!, h!)
DECLARE FUNCTION FileBrowse$ (x!, y!, Cols!, Rows!, StartDir$, Form!, Exts!, Filter$, ADrive!, ColWidth!)
DECLARE SUB FileBrowseLoadArray (FileName$, FileArr$(), Type$, Num!)
DECLARE FUNCTION FileBrowser$ (x!, y!, Cols!, Rows!, StartDir$, Form!, Exts!, Filter$)
DECLARE FUNCTION FileBrowseShow$ (FileNames$(), Num!, x!, y!, Cols!, Rows!, Form!, Exts!, ColWidth!)
DECLARE FUNCTION GenerateTempFile$ ()
DECLARE FUNCTION Trim$ (t$)
DECLARE FUNCTION TryDir! (DirName$)
DECLARE FUNCTION TryFile! (FileName$)
DECLARE FUNCTION RemExt$ (t$, Exts!)
DECLARE FUNCTION NotIt! (Num!)
CONST FILESANDDIRS = 0
CONST FILESONLY = 1
CONST DIRSONLY = 2

CONST SHOWEXT = 0
CONST NOEXT = 1


DIM SHARED KUP$, KDOWN$, KLEFT$, KRIGHT$, KENTER$
KUP$ = CHR$(0) + "H"
KDOWN$ = CHR$(0) + "P"
KLEFT$ = CHR$(0) + "K"
KRIGHT$ = CHR$(0) + "M"
KENTER$ = CHR$(13)
CONST KESCAPE$ = ""

DIM SHARED ErrorFlag AS INTEGER
DIM SHARED ErrorNum AS INTEGER
DIM SHARED CancelFlag AS INTEGER

DIM SHARED HDisks(26) AS INTEGER

CONST SCREENSINGLECHARHEIGHT = 16  ' for screen 12 default
CONST SCREENSINGLECHARWIDTH = 8 'for scren 12 default

FindHDisks

SCREEN 12
PRINT "Select a .bas file from your computer:"
a$ = FileBrowser(5, 5, 3, 5, "c:\", FILESANDDIRS, NOEXT, "*.bas")
CLS
COLOR 15
IF CancelFlag = 0 THEN PRINT a$ ELSE PRINT "Cancelled!!"

END

NoFile:
     ErrorFlag = 1
     ErrorNum = ERR
RESUME NEXT

FUNCTION AddBackSlash$ (t$)
     p$ = LTRIM$(RTRIM$(t$))
     IF p$ <> "" THEN
          IF RIGHT$(p$, 1) <> "\" THEN
               AddBackSlash$ = p$ + "\"
          ELSE
               AddBackSlash$ = p$
          END IF
     END IF
END FUNCTION

FUNCTION BackDir$ (t$)
     FOR j = LEN(t$) - 1 TO 1 STEP -1
          IF MID$(t$, j, 1) = "\" THEN
               BackDir$ = LEFT$(t$, j)
               j = -1
          END IF
     NEXT
END FUNCTION

SUB CharBox (x1, y1, x2, y2)
     LINE ((x1 - 1) * SCREENSINGLECHARWIDTH - 1, (y1 - 1) * SCREENSINGLECHARHEIGHT - 1)-(x2 * SCREENSINGLECHARWIDTH, y2 * SCREENSINGLECHARHEIGHT), , B
     FOR j = y1 TO y2
          LOCATE y1, x1
          PRINT STRING$(x2 - x1 + 1, " ");
     NEXT
END SUB

SUB ClearBlock (x, y, w, h)
     FOR j = 0 TO h - 1
          LOCATE y + j, x
          PRINT STRING$(w, " ")
     NEXT
END SUB

FUNCTION FileBrowse$ (x, y, Cols, Rows, StartDir$, Form, Exts, Filter$, ADrive, ColWidth)
     'the following commands are the most important in this file browser:
     '    the first generates a temporary filename
     '    the second performs the dos DIR command, sort order: Dirs first
     '         and by name. It pipes output to the temp file so the program can parse
     TempFile$ = GenerateTempFile$
     IF RIGHT$(StartDir$, 1) = "\" THEN StartDir$ = LEFT$(StartDir$, LEN(StartDir$) - 1)
     SHELL "DIR /l/ogn " + StartDir$ + " > " + TempFile$
     FileNum% = FREEFILE
     OPEN TempFile$ FOR INPUT AS #FileNum%
     DO
          LINE INPUT #FileNum%, Ln$
     LOOP UNTIL LEFT$(Trim$(Ln$), 12) = "Directory of"

     COLOR 11
     LOCATE y, x
     TDir$ = Trim$(MID$(Ln$, 14))
     PRINT TDir$

     CharBox x, y + 1, x + Cols * ColWidth, y + Rows
     
     Num = 0
     DO
          Num = Num + 1
          LINE INPUT #FileNum%, Ln$
     LOOP UNTIL EOF(1)
     CLOSE #FileNum%
     DIM FileNames(Num + 26) AS STRING

     Num = 0

     IF Form <> FILESONLY THEN
          IF ADrive = 1 THEN
               Num = Num + 1
               FileNames(Num) = "a:"
          END IF
          FOR j = 3 TO 26
               IF HDisks(j) = 1 THEN
                    Num = Num + 1
                    FileNames(Num) = CHR$(j + 96) + ":"
               END IF
          NEXT
          FileBrowseLoadArray TempFile$, FileNames(), "<", Num
     END IF

     KILL TempFile$

     FOR j = 1 TO Num
          FileNames(j) = Trim$(FileNames(j)) + "\"
     NEXT

     IF Form <> DIRSONLY THEN
          LOCATE y + Rows + 2, x
          SHELL "DIR /l/ogn " + AddBackSlash$(StartDir$) + Filter$ + " > " + TempFile$
          COLOR 0
          LOCATE y + Rows + 2, x
          PRINT "File Not Found"

          FileBrowseLoadArray TempFile$, FileNames(), "", Num
          KILL TempFile$
     END IF
    
     COLOR 15
     Res$ = FileBrowseShow$(FileNames(), Num, x, y, Cols, Rows, Form, Exts, ColWidth)
     IF MID$(Res$, 2, 1) = ":" AND LEN(Res$) = 3 THEN
          FileBrowse$ = Res$
     ELSE
          IF RIGHT$(Res$, 3) = "..\" THEN
               FileBrowse$ = BackDir$(StartDir$)
          ELSE
               FileBrowse$ = AddBackSlash$(StartDir$) + Res$
          END IF
     END IF

     COLOR 0
     LOCATE y, x
     PRINT TDir$;
END FUNCTION

SUB FileBrowseLoadArray (FileName$, FileArr$(), Type$, Num)
     FileNum% = FREEFILE
     OPEN FileName$ FOR INPUT AS #FileNum%
     DO
          LINE INPUT #FileNum%, Ln$
          IF LEN(Ln$) > 16 THEN
               IF (Trim$(MID$(Ln$, 16, 1)) = Type$ OR Trim$(MID$(Ln$, 14, 1)) = Type$) THEN
                    IF Trim$(LEFT$(Ln$, 2)) <> "." AND LEFT$(Trim$(Ln$), 9) <> "Directory" THEN
                         IF Trim$(LEFT$(Ln$, 2)) <> "" THEN
                              Num = Num + 1
                              FileArr$(Num) = LEFT$(Ln$, 8)
                              IF Trim$(MID$(Ln$, 10, 1)) <> "" THEN
                                   FileArr$(Num) = Trim$(FileArr$(Num)) + "." + Trim$(MID$(Ln$, 10, 3))
                              END IF
                         END IF
                    END IF
               END IF
          END IF
     LOOP UNTIL EOF(FileNum%)
     CLOSE #FileNum%
END SUB

FUNCTION FileBrowser$ (x, y, Cols, Rows, StartDir$, Form, Exts, Filter$)
     ADrive = TryDir("a:")
     q$ = StartDir$

     COLOR 15
     IF Form = DIRSONLY THEN
          LOCATE y + Rows + 1, x
          PRINT "Press Ctrl+Enter to select.";
     END IF

     ColWidth = 15
     'IF Form <> FILESONLY THEN ColWidth = ColWidth + 1
     'IF Exts = SHOWEXT THEN ColWidth = ColWidth + 3
    
     DO
          newq$ = FileBrowse$(x, y, Cols, Rows, q$, Form, Exts, Filter$, ADrive, ColWidth)
        
          IF RIGHT$(newq$, 1) = "/" THEN
               q = TryDir(LEFT$(newq$, LEN(newq$) - 1))
          ELSE
               IF RIGHT$(newq$, 1) <> "\" THEN
                    q = TryFile(newq$)
               ELSE
                    q = TryDir(newq$)
               END IF
          END IF

          IF q THEN q$ = newq$
     LOOP UNTIL RIGHT$(q$, 1) <> "\" OR CancelFlag = 1 OR RIGHT$(q$, 1) = "/"
    
     IF RIGHT$(q$, 1) = "/" THEN
          q$ = LEFT$(q$, LEN(q$) - 1) + "\"
     END IF

     ClearBlock x, y, Cols * ColWidth + 1, Rows + 1
     COLOR 0
     IF Form = DIRSONLY THEN
          LOCATE y + Rows + 1, x
          PRINT "Press Ctrl+Enter to select.";
     END IF
     CharBox x, y + 1, x + Cols * ColWidth, y + Rows
    
     COLOR 15
     FileBrowser$ = q$
END FUNCTION

FUNCTION FileBrowseShow$ (FileNames$(), Num, x, y, Cols, Rows, Form, Exts, ColWidth)
     Sel = 1
     Scroll = 0

     Quit = 0
     Scrolled = 1
     DO
          IF Scrolled = 1 THEN ClearBlock x, y + 1, Cols * ColWidth, Rows
          Scrolled = 0

          'Update view
          Flag = 0
          C = Scroll * Rows
          FOR j = 1 TO Cols
               FOR k = 1 TO Rows
                    C = C + 1
                    IF C = Sel THEN
                         COLOR 15
                    ELSE
                         COLOR 8
                    END IF

                    LOCATE y + k, x + (j - 1) * ColWidth + 1
                    PRINT RemExt$(FileNames$(C), Exts);
                   
                    IF C >= Num THEN
                         k = Rows + 1
                         j = Cols + 1
                    END IF
               NEXT
          NEXT

          DO
               a$ = INKEY$

               SELECT CASE a$
                    CASE KESCAPE$, KENTER$, " "
                         Quit = 1
                         Flag = 1

                    CASE CHR$(10) 'Ctrl+enter or control+j
                         IF Form = DIRSONLY THEN
                              Quit = 1
                              Flag = 1
                         END IF

                    CASE KDOWN$
                         IF Sel < Num THEN
                              Sel = Sel + 1
                              Flag = 1
                         END IF
                        
                    CASE KUP$
                         IF Sel > 1 THEN
                              Sel = Sel - 1
                              Flag = 1
                         END IF

                    CASE KLEFT$
                         IF Sel > Rows THEN
                              Sel = Sel - Rows
                              Flag = 1
                         END IF

                    CASE KRIGHT$
                         IF Num - Sel >= Rows THEN
                              Sel = Sel + Rows
                              Flag = 1
                         END IF

                    CASE ""

                    CASE ELSE
                         IF LEN(a$) = 1 THEN
                              FOR j = Sel + 1 TO Num
                                   IF LEFT$(UCASE$(FileNames$(j)), 1) = UCASE$(a$) THEN
                                        Sel = j
                                        j = Num + 1000
                                        Flag = 1
                                   END IF
                              NEXT

                              IF Flag = 0 THEN
                                   FOR j = 1 TO Sel
                                        IF LEFT$(UCASE$(FileNames$(j)), 1) = UCASE$(a$) THEN
                                             Flag = 1
                                             Sel = j
                                             j = Num + 1000
                                        END IF
                                   NEXT
                              END IF
                         END IF

               END SELECT
          LOOP UNTIL Flag = 1

          IF (Sel - 1) / Rows < Scroll THEN
               Scroll = INT((Sel - 1) / Rows)
               Scrolled = 1
          END IF
          IF (Sel - 1) / Rows >= Cols + Scroll THEN
               Scroll = INT((Sel - 1) / Rows - Cols + 1)
               Scrolled = 1
          END IF
     LOOP UNTIL Quit = 1

     IF a$ = KESCAPE$ THEN
          CancelFlag = 1
     ELSE
          CancelFlag = 0
     END IF

     IF a$ = CHR$(10) THEN 'exit DirsOnly form
          q$ = Trim$(FileNames$(Sel))
          FileBrowseShow$ = LEFT$(q$, LEN(q$) - 1) + "/"
     ELSE
          FileBrowseShow$ = Trim$(FileNames$(Sel))
     END IF
END FUNCTION

SUB FindHDisks
     FOR j = 3 TO 26
          HDisks(j) = TryDir(CHR$(64 + j) + ":\")
     NEXT
END SUB

FUNCTION GenerateTempFile$
     DO
          t$ = ""
          FOR j = 1 TO 8
               t$ = t$ + CHR$(INT(RND(1) * 26) + 97)
          NEXT
     LOOP UNTIL TryFile("c:\" + t$) = 0
     GenerateTempFile$ = "c:\" + t$
END FUNCTION

FUNCTION NotIt (Num)
     IF Num > 0 THEN
          NotIt = 0
     ELSE
          NotIt = 1
     END IF
END FUNCTION

FUNCTION RemExt$ (t$, Exts)
     IF Exts = SHOWEXT OR RIGHT$(t$, 1) = "\" THEN
          RemExt$ = t$
     ELSE
          FOR j = LEN(t$) TO 1 STEP -1
               IF MID$(t$, j, 1) = "." THEN
                    RemExt$ = LEFT$(t$, j - 1)
                    j = -500
               END IF
          NEXT

          IF j > 0 THEN
               RemExt$ = t$
          END IF
     END IF
END FUNCTION

FUNCTION Trim$ (t$)
     txt$ = LTRIM$(RTRIM$(t$))
     FOR j = 1 TO LEN(txt$)
          IF ASC(MID$(txt$, j)) > 0 THEN
               txt$ = MID$(txt$, j)
               j = LEN(txt$) + 1000
          END IF
     NEXT
     Trim$ = txt$
END FUNCTION

FUNCTION TryDir (DirName$)
     ErrorFlag = 0
     ON ERROR GOTO NoFile
   
     CHDIR DirName$
     IF ErrorFlag = 1 THEN
          ErrorFlag = 0
          CHDIR LEFT$(DirName$, LEN(DirName$) - 1)
     END IF
    
     TryDir = NotIt((ErrorFlag))
     ON ERROR GOTO 0
END FUNCTION

FUNCTION TryFile (FileName$)
     ErrorFlag = 0
     DIM FileNum AS INTEGER
     FileNum% = FREEFILE
     ON ERROR GOTO NoFile
    
     OPEN FileName$ FOR INPUT AS FileNum%
     CLOSE #FileNum%

     TryFile = NotIt((ErrorFlag))
     ON ERROR GOTO 0
END FUNCTION