HomePage | Optical Illusions | War Stories | QBasic | Dads Navy Days | Bristol | Bristol, USA | Bristol, Canada | Terre Haute | Miscellany | Web Stuff | About Ray | Site Map | Site Search | Messages | Credits | Links | Web Rings

QBasic | Errors | 40lb Weight | Bits | Chance | Colours | Dates | Delays | File Dialog | Files | Input | Matching | Menus | Mouse | Numbers | SeqNo | SIRDS | Sorts | Text | Timer | DLoads

File Dialog Box

QBasic is a basic language. What I mean by that is that there are no pre-written libraries or routines that come with the program. If you want something done, you have to do it yourself. Even things like the file dialog boxes that are prewritten in Visual Basic don't exist for QBasic. A search on the internet will find a couple of these written in QBasic, but I wasn't happy with the ones I found. Here is my attempt at writing one.

Screenshot of FileDir.bas

Screenshot of FileDir.bas

Using the TAB key you can navigate around the dialog box.
Pressing ENTER on a highlighted file will open that file
Pressing ENTER on a highlighted directory will change to that directory
Typing a new file name will open that file, or if it doesn't exist, attempt to create it
Typing a new directory name will change to that directory, or if it doesn't exist, attempt to create it

There are several subroutines to this program. In them you can see how to sort an array, how to draw a scrolling menu, how to manipulate strings, error checking, creating files and directories, changing drives and directories, trapping and using the non-printable keyboard characters, and other techniques.

The basis of the program is very simple though. Using SHELL "dir > c:\ZFileDir.tmp" the program sends a DIR listing to the file c:\ZFileDir.tmp, it then reads the file and extracts the drive, directory and file information from it. There is a couple of problems with this method, but without using interrupts I can't see a solution. One problem is this, getting the information from a removable drives is slow. The program was originally written so that the temporary file was written to the current directory, this created a problem when reading the disk information from CDs and DVDs.

Because you can't change the size of an array in QBasic without losing all the information in it, the size of the arrays to hold the file and directory information are fixed at 500 each. This means the program will not display all the files if there are more than 500 in a directory, and it will not show all the sub-directories is there are more than 500 of them. I tried using REDIM but because this has to be done from a subroutine then it doesn't work.

Yet another problem, I'm not sure if the line SHELL "dir > c:\ZFileDir.tmp" actually returns the same file format from different versions of QBasic on different platforms. Here's a partial listing from my QBasic directory. This is from DOS :-

Volume in drive C is BRISRAY
 Volume Serial Number is 123A-4BC5

 Directory of c:\qbasic

10/03/2001  12:21a      <DIR>          .
10/03/2001  12:21a      <DIR>          ..
01/22/2000  11:15a               8,943 40LBS.BAS
10/13/1998  02:37p               3,106 BUSY.BAS
11/13/2000  11:06a               6,569 Calandar.bas
07/31/1999  10:44a               1,534 CHANCE.BAS
11/08/2000  06:05a               2,276 WEEKDAY.BAS
10/19/1998  12:24p               9,178 XFLD.BAS
06/07/2000  12:47p               4,940 XHAIR.BAS
10/03/2001  12:21a      <DIR>          Martin
10/03/2001  12:21a      <DIR>          Harvey
10/03/2001  12:21a      <DIR>          Gene
02/28/2002  02:50p      <DIR>          Chriss
03/04/2002  02:18p                 345 qprimes.bas
10/12/2001  12:01p                 132 QBASIC.INI
10/27/2001  01:13a               2,546 PRINT.BAS
10/10/2001  12:02p      <DIR>          Stevie
03/04/2002  10:57p              43,136 qbprog.zip
01/07/2002  05:10p      <DIR>          Kesler
02/03/2002  02:16p               3,740 MENUCOL.BAS
03/04/2002  10:06p              35,074 FILEDIR.BAS
02/03/2002  03:06p               3,199 MENUALT.BAS
02/06/2002  07:00p                 114 FILEMENU.BAS
02/08/2002  03:31p      <DIR>          wip
02/10/2002  03:43p               1,742 TICKER.BAS
              82 File(s)        804,278 bytes
               9 Dir(s)  34,701,246,464 bytes free

And this is from within QBasic :-

 Volume in drive C is BRISRAY   
 Volume Serial Number is 123A-4BC5
 Directory of C:\QBASIC

.            <DIR>     10/03/01  12:21a
..           <DIR>     10/03/01  12:21a
40LBS    BAS      8943 01/22/00  11:15a
BUSY     BAS      3106 10/13/98   2:37p
CALANDAR BAS      6569 11/13/00  11:06a
CHANCE   BAS      1534 07/31/99  10:44a
WEEKDAY  BAS      2276 11/08/00   6:05a
XFLD     BAS      9178 10/19/98  12:24p
XHAIR    BAS      4940 06/07/00  12:47p
MARTIN       <DIR>     10/03/01  12:21a
HARVEY       <DIR>     10/03/01  12:21a
GENE         <DIR>     10/03/01  12:21a
CHRISS       <DIR>     02/28/02   2:50p
QPRIMES  BAS       345 03/04/02   2:18p
QBASIC   INI       132 10/12/01  12:01p
PRINT    BAS      2546 10/27/01   1:13a
STEVIE       <DIR>     10/10/01  12:02p
KESLER       <DIR>     01/07/02   5:10p
MENUCOL  BAS      3740 02/03/02   2:16p
FILEDIR  BAS     35074 03/05/02  10:35a
QSORT    BAS      3635 03/05/02   6:51a
QBPROG   ZIP     45329 03/05/02   9:28a
TXTMENU  BAS      1370 02/03/02  11:10a
MENUALT  BAS      3199 02/03/02   3:06p
WIP          <DIR>     02/08/02   3:31p
WAIT     BAS       876 02/10/02  10:14p
PARSE    BAS      1449 02/10/02   9:18p
TICKER   BAS      1742 02/10/02   3:43p
       92 file(s)     875928 bytes
                  1023932928 bytes free

If your directory listing is much different from this in layout then you are going to have to edit the GetCurrent subroutine .

Apart from that, the program works quite well, and there is enough error checking so that it shouldn't crash. But no promises on that as I'm sure someone, somewhere will manage to break it.

'FileDir.bas    Ray Thomas      February 2002

'A file / directory dialog / menu

DECLARE SUB GetCurrent ()       '*** Get the current drive and directory ***
DECLARE SUB FindDrives ()       '*** Find which drives are on the PC ***
DECLARE SUB SortArrays (SortArray$(), Low AS INTEGER, High AS INTEGER)    '*** Put the files and directories in order ***
DECLARE SUB DrawMenu ()         '*** Draw the fixed menu items ***
DECLARE SUB FillMenu ()         '*** Fill the variable menu items ***
DECLARE SUB DoWriteMenu ()      '*** Do File, Drive, Directory menu items ***
DECLARE SUB DoFileMenu ()       '*** Do the scrolling file menu ***
DECLARE SUB DoDirMenu ()        '*** Do the scrolling directory menu ***
DECLARE SUB ChkFile ()          '*** Check that a file exists ***
DECLARE SUB ChkDrv ()           '*** Check that a drive exists ***
DECLARE SUB ChkDir ()           '*** Check that a directory exists ***
DECLARE SUB ChngDir ()          '*** Change a directory ***

OPTION BASE 1

'*** Global variables ***

DIM SHARED FileNo AS INTEGER            'File stream number
DIM SHARED DirName(500) AS STRING       'Directory names
DIM SHARED FileName(500) AS STRING      'File names
DIM SHARED CurrDrive AS STRING          'Current drive
DIM SHARED CurrDir AS STRING            'Current directory
DIM SHARED CurrPath AS STRING           'Current path
DIM SHARED NumDirs AS INTEGER           'Number of directories
DIM SHARED NumFiles AS INTEGER          'Number of files
DIM SHARED TabNum AS INTEGER            'Keep a track of what part of the menu
DIM SHARED YMenuPosn AS INTEGER         'Top right Y position of menu
DIM SHARED XMenuPosn AS INTEGER         'Top right X position of menu
DIM SHARED EndMenu AS INTEGER           'User pressed ESC or file opened properly
DIM SHARED HiLiteFile AS INTEGER        'Currently highlighted file
DIM SHARED HiLiteDir AS INTEGER         'Currently highlighted directory
DIM SHARED Message AS STRING            'Current field being edited
DIM SHARED Drive AS STRING              'Drives available on the computer
DIM SHARED ProgErr AS INTEGER           'Program error code
DIM SHARED OrigDrive AS STRING          'Original drive
DIM SHARED OrigDir AS STRING            'Original directory
DIM SHARED OrigPath AS STRING           'Original path


'*** Local variables ****

DIM Num AS INTEGER              'General integer variable

'*** The DIR command may give different results on different platforms ***

TabNum = 1
YMenuPosn = 3
XMenuPosn = 3

'*** Find the drives on the computer ***

ON ERROR GOTO DriveErr
FOR Count = 65 TO 90
        ProgErr = 0
        Message$ = CHR$(Count) + ":\"
        FILES Message$
        IF ProgErr = 0 THEN Drive$ = Drive$ + CHR$(Count)
NEXT Count
ON ERROR GOTO OopsError

GetCurrent      '*** Get the current drive and directory ***

SortArrays FileName$(), 1, NumFiles
SortArrays DirName$(), 1, NumDirs
           
'*** Get the original info to reset on exit ***

OrigDrive$ = CurrDrive$
OrigDir$ = CurrDir$
OrigPath$ = CurrPath$

DrawMenu        '*** Draw the fixed menu items ***
FillMenu        '*** Fill the variable menu items ***

DO

        '*** Relocate the cursor to the current field (by TabNum) ***
       
        EndMenu = 0

        IF TabNum <= 3 THEN
                DoWriteMenu
        END IF

        IF TabNum = 4 THEN DoFileMenu
        IF TabNum = 5 THEN DoDirMenu

LOOP UNTIL EndMenu > 0  '***  1 = ESC was pressed, 2 = file found, 3 = file created ***

CLS

IF EndMenu = 1 THEN

        PRINT
        PRINT "   Menu exited, ESC pressed"
END IF

IF EndMenu = 2 THEN

        PRINT
        PRINT "   The file "; Message$; " was successfully found"
        PRINT
        PRINT "   You may now open it or whatever"
END IF

IF EndMenu = 3 THEN
        PRINT
        PRINT "   The file "; Message$; " was successfully created"
        PRINT
        PRINT "   and now deleted"
       
        KILL Message$
END IF

'*** reset the drive and directory to the original ***

SHELL OrigDrive$
CHDIR OrigDir$

CLOSE
END

DriveErr:
IF ERR = 68 THEN ProgErr = 1
RESUME NEXT

OopsError:
CLS
PRINT
PRINT "   The program has reported a fatal error and will now end"
PRINT
PRINT "   The Error Code reported was"; ERR
PRINT
PRINT "   Press any key to continue . . ."
DO
LOOP UNTIL INKEY$ <> ""
CLOSE
SHELL OrigDrive$
CHDIR OrigDir$
END

FileErr:
IF ERR > 0 THEN ProgErr = 1
RESUME NEXT

SUB ChkDir

'*** There are two ways into this sub, either from a typed ***
'*** directory or one chosen from the directory menu ***

'*** Check that the chosen or typed directory exists ***
'*** It should already be in the FileName$ array,
'*** but refresh the array in case it was created while the program was running ***

DIM OldDir AS STRING            'A copy of the current directory name
DIM OldDrv AS STRING            'A copy of the current drive letter
DIM DirPosn AS INTEGER          'Place holder for splitting splitting directory string

OldDir$ = CurrDir$      '*** Keep a copy of the directory in case of errors ***
OldDrv$ = CurrDrive$    '*** Keep a copy of the drive in case of errors ***


IF TabNum = 5 THEN

        GetCurrent
        SortArrays FileName$(), 1, NumFiles
        SortArrays DirName$(), 1, NumDirs

        FOR Count = 1 TO UBOUND(DirName$)
      
                IF UCASE$(DirName$(HiLiteDir)) = UCASE$(DirName$(Count)) THEN
       
                        IF DirName$(HiLiteDir) = ".." THEN
                                SHELL "CD .."
                        ELSE
                                IF RIGHT$(CurrDir$, 1) <> "\" THEN CurrDir$ = CurrDir$ + "\"
                                SHELL "CD " + CurrDir$ + DirName$(HiLiteDir)
                        END IF
                        EXIT FOR
                END IF
        NEXT Count
END IF

'*** Getting the directories from the typed in string is a bit more complicated

'*** If the string starts with a letter then a ":" then the drive needs changing too ***
'*** If the string sarts with a "\" then assume the ***
'*** directory list starts from the root of the drive ***
'*** If it doesn't then assume it starts from the current directory ***

ProgErr = 0

IF TabNum = 3 THEN
       
        ON ERROR GOTO FileErr

        IF RIGHT$(Message$, 1) = "\" THEN Message$ = LEFT$(Message$, LEN(Message$) - 1)
             
        IF LEFT$(Message$, 1) = "\" THEN
                CHDIR Message$
        ELSE
                IF MID$(Message$, 2, 2) = ":\" THEN
                        IF INSTR(UCASE$(Drive$), UCASE$(LEFT$(Message$, 1))) > 0 THEN
                                SHELL LEFT$(Message$, 2)
                                Message$ = MID$(Message$, 3)
                                CHDIR Message$
                        END IF
                ELSE
                        Message$ = CurrDir$ + "/" + Message$
                        CHDIR Message$
                END IF
       
        END IF

        '*** If possible make the typed directory ***

        IF ProgErr = 1 THEN

                ProgErr = 0
                MKDIR Message$

                IF ProgErr = 0 THEN
                              
                        PRINT " created. Press any key"'
                        DO
                        LOOP UNTIL INKEY$ <> ""
                END IF
        END IF

        IF ProgErr = 1 THEN
                SHELL OldDrv$ + ":"
                CHDIR OldDir$
        END IF
       
        ON ERROR GOTO OopsError

        '*** Redo the command line ***
       
        GetCurrent
        LOCATE YMenuPosn + 5, XMenuPosn + 15
        PRINT SPACE$(59);
        Message$ = CurrDir$
        LOCATE YMenuPosn + 5, XMenuPosn + 15
        PRINT Message$;

END IF

HiLiteFile = 1
HiLiteDir = 1

GetCurrent
SortArrays FileName$(), 1, NumFiles
SortArrays DirName$(), 1, NumDirs
DrawMenu
FillMenu

END SUB

SUB ChkDrv

IF INSTR(1, Drive$, UCASE$(LEFT$(Message$, 1))) >= 1 THEN

        Message$ = UCASE$(LEFT$(Message$, 1)) + ":"
        SHELL Message$
       
        GetCurrent      '*** Get the current drive and directory ***

        SortArrays FileName$(), 1, NumFiles
        SortArrays DirName$(), 1, NumDirs

        DrawMenu
        FillMenu

END IF

END SUB

SUB ChkFile

DIM Count AS INTEGER

'*** Check that the chosen or typed file exists ***
'*** It should already be in the FileName$ array,
'*** but refresh the array in case it was created while the program was running ***

ProgErr = 0

GetCurrent
SortArrays FileName$(), 1, NumFiles
SortArrays DirName$(), 1, NumDirs

IF Message$ > "" THEN

        FOR Count = 1 TO UBOUND(FileName$)
       
                IF UCASE$(Message$) = UCASE$(FileName$(Count)) THEN
                        EndMenu = 2
                        EXIT FOR
                END IF
        NEXT Count

        IF EndMenu = 0 THEN     '*** Check the file can be created ***
               
                ON ERROR GOTO FileErr
                FileNo = FREEFILE
                OPEN Message$ FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS FileNo
                CLOSE
                IF ProgErr = 0 THEN EndMenu = 3

                '*** If there was a problem creating this file then ProgErr = 1 ***

                ON ERROR GOTO OopsError
        END IF
END IF

END SUB

SUB DoDirMenu

'*** Scrolling directory menu ***

DIM UserIn AS STRING            'User input
DIM ChngTab AS INTEGER          'Tracks if menu movement keys are pressed
STATIC FirstDir AS INTEGER      'The first directory to be displayed
DIM YDirPosn AS INTEGER         '

ChngTab = 0
IF HiLiteDir = 0 THEN HiLiteDir = 1
IF FirstDir = 0 THEN FirstDir = 1
XDirPosn = XMenuPosn + 59

LOCATE (YMenuPosn + 9) + HiLiteDir - FirstDir, XDirPosn
COLOR 0, 7
PRINT DirName$(HiLiteDir);
COLOR 7, 0

DO

        '*** Print the up / down arrows ***
      
        LOCATE YMenuPosn + 9, XMenuPosn + 71
        PRINT "  ";
        LOCATE YMenuPosn + 18, XMenuPosn + 71
        PRINT "  ";
      
        IF FirstDir > 10 THEN
                LOCATE YMenuPosn + 9, XMenuPosn + 71
                PRINT CHR$(24); CHR$(24)
        END IF
      
        IF FirstDir < NumDirs - 9 THEN
                LOCATE YMenuPosn + 18, XMenuPosn + 71
                PRINT CHR$(25); CHR$(25)
        END IF
       
        LOCATE (YMenuPosn + 9) + HiLiteDir - FirstDir, XDirPosn + LEN(DirName$(HiLiteDir))
       
        DO
                UserIn$ = INKEY$
        LOOP UNTIL UserIn$ <> ""

        '*** Process the key pressed ***

        SELECT CASE UserIn$
                       
                CASE CHR$(27)   '*** Esc pressed ***

                        EndMenu = 1

                CASE CHR$(13)   '*** Enter pressed ***

                        '*** Check the directory exists, if it does change it ***
                        '*** This should'nt be necessary but it may have ***
                        '*** been deleted while this program was running ***
      
                        ChkDir

                CASE CHR$(9)    '*** Tab pressed ***
                      
                        TabNum = 1
                        ChngTab = 1

                CASE CHR$(0) + CHR$(15) '*** Shift Tab pressed ***

                        TabNum = TabNum - 1
                        ChngTab = 1
              
                CASE CHR$(0) + CHR$(80) '*** Down arrow pressed ***

                        IF DirName$(HiLiteDir + 1) <> "" THEN HiLiteDir = HiLiteDir + 1

                CASE CHR$(0) + CHR$(72) '*** Up arrow pressed ***

                        IF HiLiteDir - 1 <> 0 THEN HiLiteDir = HiLiteDir - 1


                CASE CHR$(0) + CHR$(71) '*** Home pressed ***

                                HiLiteDir = 1
              
                CASE CHR$(0) + CHR$(79) '*** End pressed ***

                        HiLiteDir = NumDirs

                CASE CHR$(0) + CHR$(73) '*** Page Up pressed ***

                        IF HiLiteDir > 10 THEN
                                HiLiteDir = HiLiteDir - 10
                        ELSE
                                HiLiteDir = 1
                        END IF
              
                CASE CHR$(0) + CHR$(81) '*** Page Down pressed ***
      
                        IF HiLiteDir < NumDirs - 9 THEN
                                HiLiteDir = HiLiteDir + 10
                        ELSE
                                HiLiteDir = NumDirs
                        END IF
              
                CASE ELSE
                              
                        '*** For any other key press find the first directory ***
                        '*** starting with that key ***

                        FOR Count = 1 TO NumDirs
                                IF UCASE$(LEFT$(DirName$(Count), 1)) = UCASE$(UserIn$) THEN
                                        HiLiteDir = Count
                                        EXIT FOR
                                END IF
                        NEXT Count

        END SELECT

        '*** Clear the directory list area and reprint the new list ***
      
        XDirPosn = XMenuPosn + 59
        LOCATE YMenuPosn + 9, XDirPosn
        FOR Count = FirstDir TO FirstDir + 9
                PRINT SPACE$(LEN(DirName$(Count)));
                LOCATE CSRLIN + 1, XDirPosn
        NEXT Count
              
        IF HiLiteDir > FirstDir + 9 THEN
                DO
                        FirstDir = FirstDir + 10
                LOOP UNTIL HiLiteDir < FirstDir + 10
        END IF

        IF HiLiteDir < FirstDir THEN
                DO
                        FirstDir = FirstDir - 10
                LOOP UNTIL HiLiteDir >= FirstDir
        END IF
              
        XDirPosn = XMenuPosn + 59
        LOCATE YMenuPosn + 9, XDirPosn
        FOR Count = FirstDir TO FirstDir + 9
                PRINT DirName$(Count);
                LOCATE CSRLIN + 1, XDirPosn
        NEXT Count
       
        XDirPosn = XMenuPosn + 59
        LOCATE (YMenuPosn + 9) + HiLiteDir - FirstDir, XDirPosn
        COLOR 0, 7
        PRINT DirName$(HiLiteDir);
        COLOR 7, 0

LOOP UNTIL EndMenu > 0 OR ChngTab = 1

END SUB

SUB DoFileMenu

'*** Scrolling Dir menu ***

DIM UserIn AS STRING            'User input
DIM ChngTab AS INTEGER          'Tracks if menu movement keys are pressed
DIM NumCols AS INTEGER          'Total number of Dir columns
STATIC FirstFile AS INTEGER     'The first file to be displayed
DIM XFilePosn AS INTEGER        '

NumCols = FIX((NumFiles + 9) / 10)      '*** calculates the number of columns ***
ChngTab = 0
IF HiLiteFile = 0 THEN HiLiteFile = 1
IF HiLiteFile = 1 THEN FirstFile = 1
IF FirstFile = 0 THEN FirstFile = 1
XFilePosn = XMenuPosn + 2

LOCATE (YMenuPosn + 9) + ((HiLiteFile - FirstFile) MOD 10), XFilePosn + (FIX((HiLiteFile - FirstFile) / 10) * 14)
COLOR 0, 7
PRINT FileName$(HiLiteFile);
COLOR 7, 0

DO
       
        '*** Print the << and / or the >> ***
       
        LOCATE YMenuPosn + 7, XMenuPosn + 2
        PRINT "  "
        LOCATE YMenuPosn + 7, XMenuPosn + 54
        PRINT "  "
       
        IF FirstFile > 10 THEN
                LOCATE YMenuPosn + 7, XMenuPosn + 2
                PRINT "<<"
        END IF
       
        IF FirstFile < NumFiles - 40 THEN
                LOCATE YMenuPosn + 7, XMenuPosn + 54
                PRINT ">>"
        END IF
        
        IF HiLiteFile > 1 THEN LOCATE (YMenuPosn + 9) + ((HiLiteFile - FirstFile) MOD 10), XFilePosn + (FIX((HiLiteFile - FirstFile) / 10) * 14) + LEN(FileName$(HiLiteFile))
        IF HiLiteFile = 1 THEN LOCATE (YMenuPosn + 9), XFilePosn + LEN(FileName$(HiLiteFile))
       
        DO
                UserIn$ = INKEY$
        LOOP UNTIL UserIn$ <> ""

        '*** Clear the user entry file box ***

        LOCATE CSRLIN, POS(0) - LEN(FileName$(HiLiteFile))
        COLOR 7, 0
        PRINT FileName$(HiLiteFile);
        LOCATE YMenuPosn + 1, XFilePosn + 13
        PRINT SPACE$(58)

        '*** Process the key pressed ***

        SELECT CASE UserIn$

                CASE CHR$(27)   '*** Esc pressed ***

                        EndMenu = 1

                CASE CHR$(13)   '*** Enter pressed ***

                        '*** ChkFile shouldn't be necessary but the chosen file ***
                        '*** may have been deleted while this program was running ***

                        ChkFile
                        
                CASE CHR$(9)    '*** Tab pressed ***
                       
                        TabNum = TabNum + 1
                        ChngTab = 1

                CASE CHR$(0) + CHR$(15) '*** Shift Tab pressed ***

                        TabNum = TabNum - 1
                        ChngTab = 1
               
                CASE CHR$(0) + CHR$(80) '*** Down arrow pressed ***

                        IF FileName$(HiLiteFile + 1) <> "" THEN HiLiteFile = HiLiteFile + 1

                CASE CHR$(0) + CHR$(72) '*** Up arrow pressed ***

                        IF HiLiteFile - 1 <> 0 THEN HiLiteFile = HiLiteFile - 1

                CASE CHR$(0) + CHR$(75) '*** Left arrow pressed ***

                        IF HiLiteFile > 10 THEN HiLiteFile = HiLiteFile - 10

                CASE CHR$(0) + CHR$(77) '*** Right arrow pressed ***

                        IF HiLiteFile < (NumCols - 1) * 10 + 1 THEN HiLiteFile = HiLiteFile + 10
                        IF HiLiteFile > NumFiles THEN HiLiteFile = NumFiles

                CASE CHR$(0) + CHR$(71) '*** Home pressed ***

                                HiLiteFile = 1
               
                CASE CHR$(0) + CHR$(79) '*** End pressed ***

                        HiLiteFile = NumFiles

                CASE CHR$(0) + CHR$(73) '*** Page Up pressed ***

                        IF HiLiteFile > 40 THEN
                                HiLiteFile = HiLiteFile - 40
                        ELSE
                                HiLiteFile = 1
                        END IF
               
                CASE CHR$(0) + CHR$(81) '*** Page Down pressed ***
       
                        IF HiLiteFile < NumFiles - 40 THEN
                                HiLiteFile = HiLiteFile + 40
                        ELSE
                                HiLiteFile = NumFiles
                        END IF
               
                CASE ELSE
                               
                        '*** For any other key press find the first file ***
                        '*** starting with that key ***

                        FOR Count = 1 TO NumFiles
                                IF UCASE$(LEFT$(FileName$(Count), 1)) = UCASE$(UserIn$) THEN
                                        HiLiteFile = Count
                                        EXIT FOR
                                END IF
                        NEXT Count

        END SELECT

        '*** Reprint the user entry file box ***
       
        Message$ = FileName$(HiLiteFile)
        LOCATE YMenuPosn + 1, XFilePosn + 13
        PRINT Message$
       
        '*** Clear the file list area and reprint the new columns ***
       
        XFilePosn = XMenuPosn + 2
        LOCATE YMenuPosn + 9, XFilePosn
        FOR Count = FirstFile TO FirstFile + 39
                PRINT SPACE$(12);
                LOCATE CSRLIN + 1, XFilePosn
                IF Count MOD 10 = 0 THEN
                        XFilePosn = XFilePosn + 14
                        LOCATE YMenuPosn + 9, XFilePosn
                END IF
        NEXT Count
               
        IF HiLiteFile > FirstFile + 39 THEN
                DO
                        FirstFile = FirstFile + 10
                LOOP UNTIL HiLiteFile < FirstFile + 40
        END IF

        IF HiLiteFile < FirstFile THEN
                DO
                        FirstFile = FirstFile - 10
                LOOP UNTIL HiLiteFile >= FirstFile
        END IF
               
        XFilePosn = XMenuPosn + 2
        LOCATE YMenuPosn + 9, XFilePosn
        FOR Count = FirstFile TO FirstFile + 39
                PRINT FileName$(Count);
                LOCATE CSRLIN + 1, XFilePosn
                IF Count MOD 10 = 0 THEN
                        XFilePosn = XFilePosn + 14
                        LOCATE YMenuPosn + 9, XFilePosn
                END IF
        NEXT Count
        XFilePosn = XMenuPosn + 2
      
        IF HiLiteFile > 1 THEN LOCATE (YMenuPosn + 9) + ((HiLiteFile - FirstFile) MOD 10), XFilePosn + (FIX((HiLiteFile - FirstFile) / 10) * 14)
        IF HiLiteFile = 1 THEN LOCATE (YMenuPosn + 9), XFilePosn
        COLOR 0, 7
        PRINT FileName$(HiLiteFile);
        COLOR 7, 0
      
LOOP UNTIL EndMenu > 0 OR ChngTab = 1

END SUB

SUB DoWriteMenu

'*** Do the user input for the file, drive and directory ***

DIM UserIn AS STRING            'User input
DIM CsrPosn AS INTEGER          'Cursor position
DIM InsFlag AS INTEGER          'The state of the Insert key
DIM ChngTab AS INTEGER          'Tracks if menu movement keys are pressed
DIM OldMessage AS STRING        'A copy of the original message

ChngTab = 0

IF TabNum = 1 THEN
        IF HiLiteFile = 0 THEN
                Message$ = FileName$(1)
        ELSE
                Message$ = FileName$(HiLiteFile)
        END IF
END IF

IF TabNum = 2 THEN Message$ = CurrDrive$

IF TabNum = 3 THEN Message$ = CurrDir$

CsrPosn = LEN(Message$) + 1


DO
        LOCATE YMenuPosn + (TabNum * 2) - 1, XMenuPosn + 15
        PRINT Message$;
        CsrPosn = LEN(Message$) + 1
        IF InsFlag >= 0 THEN
                LOCATE , XMenuPosn + 14 + CsrPosn, 1, 1
        ELSE
                LOCATE , XMenuPosn + 14 + CsrPosn, 1, 1, 30

        END IF
       
       
        UserIn$ = ""
       
        DO
                UserIn$ = INKEY$
        LOOP UNTIL UserIn$ <> ""

        SELECT CASE UserIn$

                CASE CHR$(27)   '*** Esc pressed ***

                        EndMenu = 1

                CASE CHR$(8)    '*** Backspace pressed ***
                       
                        LOCATE , XMenuPosn + 15
                        PRINT SPACE$(LEN(Message$))
                        IF CsrPosn > 1 THEN
                                Message$ = LEFT$(Message$, CsrPosn - 2) + MID$(Message$, CsrPosn)
                                CsrPosn = CsrPosn - 1
                        END IF
               
                CASE CHR$(0) + CHR$(83) '*** Delete key pressed ***
                       
                        LOCATE , XMenuPosn + 15
                        PRINT SPACE$(LEN(Message$))
                        Message$ = LEFT$(Message$, CsrPosn - 1) + MID$(Message$, CsrPosn + 1)

                CASE CHR$(0) + CHR$(82) '*** Ins key pressed ***

                        InsFlag = NOT InsFlag   '*** Boolean toggle ***

                CASE CHR$(0) + CHR$(75) '*** Left arrow pressed ***
                       
                        IF CsrPosn > 1 THEN CsrPosn = CsrPosn - 1
               
                CASE CHR$(0) + CHR$(77) '*** Right arrow pressed ***
                       
                        IF CsrPosn <= LEN(Message$) THEN CsrPosn = CsrPosn + 1
               
                CASE CHR$(0) + CHR$(71) '*** Home pressed ***
                       
                        CsrPosn = 1
               
                CASE CHR$(0) + CHR$(79) '*** End pressed ***
                       
                        CsrPosn = LEN(Message$) + 1
               
                CASE CHR$(0) + CHR$(15), CHR$(0) + CHR$(72)     '*** Up arrow or SHIFT Tab pressed ***
               
                        LOCATE , XMenuPosn + 15
                        PRINT SPACE$(59);
                        LOCATE , XMenuPosn + 15
                        IF HiLiteFile = 0 THEN HiLiteFile = 1
                        IF TabNum = 1 THEN Message$ = FileName$(HiLiteFile)
                        IF TabNum = 2 THEN Message$ = CurrDrive$
                        IF TabNum = 3 THEN Message$ = CurrDir$
                        PRINT Message$
                        TabNum = TabNum - 1
                        IF TabNum = 0 THEN TabNum = 5
                        ChngTab = 1

                CASE CHR$(9), CHR$(0) + CHR$(80)     '*** Down arrow or Tab pressed ***
              
                        LOCATE , XMenuPosn + 15
                        PRINT SPACE$(59);
                        LOCATE , XMenuPosn + 15
                        IF HiLiteFile = 0 THEN HiLiteFile = 1
                        IF TabNum = 1 THEN Message$ = FileName$(HiLiteFile)
                        IF TabNum = 2 THEN Message$ = CurrDrive$
                        IF TabNum = 3 THEN Message$ = CurrDir$
                        PRINT Message$
                        TabNum = TabNum + 1
                        ChngTab = 1

                CASE ELSE       '*** Add / insert the character to messages ***
                       
                        IF LEN(Message$) < 59 THEN
                                IF LEN(UserIn$) = 1 AND UserIn$ > CHR$(34) THEN
                                        IF InsFlag = 0 THEN
                                                Message$ = LEFT$(Message$, CsrPosn - 1) + UserIn$ + MID$(Message$, CsrPosn)
                                        ELSE
                                                Message$ = LEFT$(Message$, CsrPosn - 1) + UserIn$ + MID$(Message$, CsrPosn + 1)
                                        END IF
                                        CsrPosn = CsrPosn + 1
                                END IF
                        END IF
        END SELECT

        IF UserIn$ = CHR$(13) THEN
               
                SELECT CASE TabNum

                        CASE 1  '*** Check the file exists, if it does then exit menu ***

                                ChkFile

                        CASE 2  '*** Check the drive exists, if it does then change the drive ***

                                ChkDrv

                        CASE 3
                                '*** Check the directory exists, if it does then change it

                                ChkDir

                END SELECT

        END IF

LOOP UNTIL EndMenu > 0 OR ChngTab = 1

END SUB

SUB DrawMenu

'*** Draw the fixed menu items ***

DIM FileCols AS INTEGER         'Number of columns in the file section
DIM Count AS INTEGER            'Loop counter

FileCols = NumFiles / 10
XFilePosn = 7
YFilePosn = 9
XDirPosn = 65
YDirPosn = 9

CLS

LOCATE YMenuPosn, XMenuPosn
PRINT CHR$(201);
PRINT STRING$(12, CHR$(205));
PRINT CHR$(209);
PRINT STRING$(60, CHR$(205));
PRINT CHR$(187)
LOCATE , XMenuPosn
PRINT CHR$(186);
LOCATE , XMenuPosn + 2
PRINT "File";
LOCATE , XMenuPosn + 13
PRINT CHR$(179);
LOCATE , XMenuPosn + 74
PRINT CHR$(186)
LOCATE , XMenuPosn
PRINT CHR$(199);
PRINT STRING$(12, CHR$(196));
PRINT CHR$(197);
PRINT STRING$(60, CHR$(196));
PRINT CHR$(182)
LOCATE , XMenuPosn
PRINT CHR$(186);
LOCATE , XMenuPosn + 2
PRINT "Drive";
LOCATE , XMenuPosn + 13
PRINT CHR$(179);
LOCATE , XMenuPosn + 74
PRINT CHR$(186)
LOCATE , XMenuPosn
PRINT CHR$(199);
PRINT STRING$(12, CHR$(196));
PRINT CHR$(197);
PRINT STRING$(60, CHR$(196));
PRINT CHR$(182)
LOCATE , XMenuPosn
PRINT CHR$(186);
LOCATE , XMenuPosn + 2
PRINT "Directory";
LOCATE , XMenuPosn + 13
PRINT CHR$(179);
LOCATE , XMenuPosn + 74
PRINT CHR$(186)
LOCATE , XMenuPosn
PRINT CHR$(199);
PRINT STRING$(12, CHR$(196));
PRINT CHR$(193);
PRINT STRING$(43, CHR$(196));
PRINT CHR$(194);
PRINT STRING$(16, CHR$(196));
PRINT CHR$(182)
LOCATE , XMenuPosn
PRINT CHR$(186);
LOCATE , XMenuPosn + 7
PRINT NumFiles; "files in "; CurrPath$;
LOCATE , XMenuPosn + 57
PRINT CHR$(179);
LOCATE , XMenuPosn + 58
PRINT NumDirs; "Directories";
LOCATE , XMenuPosn + 74
PRINT CHR$(186)
LOCATE , XMenuPosn
PRINT CHR$(199);
PRINT STRING$(56, CHR$(196));
PRINT CHR$(197);
PRINT STRING$(16, CHR$(196));
PRINT CHR$(182)

FOR Count = 1 TO 10
        LOCATE , XMenuPosn
        PRINT CHR$(186);
        LOCATE , XMenuPosn + 57
        PRINT CHR$(179);
        LOCATE , XMenuPosn + 74
        PRINT CHR$(186)
NEXT Count

LOCATE , XMenuPosn
PRINT CHR$(200);
PRINT STRING$(56, CHR$(205));
PRINT CHR$(207);
PRINT STRING$(16, CHR$(205));
PRINT CHR$(188)

LOCATE YMenuPosn + 21, XMenuPosn
PRINT "Use the TAB key to move between fields"
PRINT

END SUB

SUB FillMenu

'*** Fill in the variable menu items ***

DIM XFilePosn AS INTEGER        ' X Positon of file columns

XFilePosn = XMenuPosn + 2

'*** The user writable part of the menu ***

LOCATE YMenuPosn + 3, XMenuPosn + 15
PRINT CurrDrive$
LOCATE YMenuPosn + 5, XMenuPosn + 15
PRINT CurrDir$

'*** the scrolling file menu ***

LOCATE YMenuPosn + 9, XFilePosn
FOR Count = 1 TO 40
        PRINT FileName$(Count)
        LOCATE CSRLIN, XFilePosn
        IF Count MOD 10 = 0 THEN
                XFilePosn = XFilePosn + 14
                LOCATE YMenuPosn + 9, XFilePosn
        END IF
NEXT Count

'*** The scrolling directory menu ***

LOCATE YMenuPosn + 9, XMenuPosn + 59
FOR Count = 1 TO 10
        PRINT DirName$(Count)
        LOCATE CSRLIN, XMenuPosn + 59
NEXT Count

END SUB

SUB FindDrives

'*** Find what drives are present in the PC ***

ON ERROR GOTO DriveErr
FOR Count = 65 TO 90
        DrvErr = 0
        Drive$ = CHR$(Count) + ":\"
        FILES Drive$
        IF DrvErr = 0 THEN Drive$ = Drive$ + CHR$(Count)
NEXT Count

END SUB

SUB GetCurrent

'*** Get the files from the current drive and directory ***

DIM Num AS INTEGER      'General number variable
DIM FileInfo AS STRING  'Line from ZFileDir.tmp

'*** Clear the current contents of the file and directory arrays ***

ERASE FileName$, DirName$

'*** Open a temporary file to hold the DIR information ***
'*** Unfortunately, I can't find a way of getting ***
'*** the location of the temporary file folder ***

FileNo = FREEFILE

SHELL "dir > c:\ZFileDir.tmp"

OPEN "C:\ZFileDir.tmp" FOR INPUT ACCESS READ LOCK READ WRITE AS FileNo

DO
        LINE INPUT #FileNo, FileInfo$
        IF EOF(FileNo) THEN EXIT DO

LOOP UNTIL INSTR(FileInfo$, "Directory of ") > 1

Num = INSTR(FileInfo$, ":")
Num = Num - 1
CurrDrive$ = MID$(FileInfo$, Num, 2)
CurrPath$ = MID$(FileInfo$, Num)
Num = Num + 2
CurrDir$ = MID$(FileInfo$, Num)
NumDirs = 0
NumFiles = 0

DO
        LINE INPUT #FileNo, FileInfo$
        IF EOF(FileNo) THEN EXIT DO
        IF INSTR(FileInfo$, "file(s)") > 0 THEN EXIT DO
        IF INSTR(FileInfo$, "<DIR>") > 1 THEN
                NumDirs = NumDirs + 1
                Num = INSTR(FileInfo$, " ")
                Num = Num - 1
                DirName$(NumDirs) = LEFT$(FileInfo$, Num)
                IF DirName$(NumDirs) = "." THEN
                        DirName$(NumDirs) = ""
                        NumDirs = NumDirs - 1
                END IF
        ELSE
                IF LEN(FileInfo$) > 0 THEN
                        NumFiles = NumFiles + 1
                        Num = INSTR(FileInfo$, " ")
                        Num = Num - 1
                        FileName$(NumFiles) = LEFT$(FileInfo$, Num) + "."
                        FileName$(NumFiles) = FileName$(NumFiles) + MID$(FileInfo$, 10, 3)
                        IF UCASE$(FileName$(NumFiles)) = "ZFILEDIR.TMP" THEN
                                FileName$(NumFiles) = ""
                                NumFiles = NumFiles - 1
                        END IF
                END IF
        END IF


LOOP UNTIL INSTR(FileInfo$, "file(s)") > 1
CLOSE
KILL "C:\ZFileDir.tmp"

END SUB

SUB SortArrays (SortArray$(), Low AS INTEGER, High AS INTEGER)

'*** This is a QuickSort routine ***

DIM Lower AS INTEGER
DIM Higher AS INTEGER
DIM RandIndex AS INTEGER

'QuickSort works by picking a random "pivot" element in SortArray, then
'moving every element that is bigger to one side of the pivot, and every
'element that is smaller to the other side.  QuickSort is then called
'recursively with the two subdivisions created by the pivot.  Once the
'number of elements in a subdivision reaches two, the recursive calls end
'and the array is sorted.

IF Low < High THEN

' *** Only two elements in this subdivision ***
' *** Swap them if they are out of order, then end recursive calls: ***

        IF High - Low = 1 THEN
                IF SortArray$(Low) > SortArray$(High) THEN
                SWAP SortArray$(Low), SortArray$(High)
        END IF

        ELSE

                '*** Pick a pivot element at random, then move it to the end ***
       
                RandIndex = INT(RND * (High - Low + 1)) + Low
                SWAP SortArray$(High), SortArray$(RandIndex)
                Partition$ = SortArray$(High)
                DO
               
                        '*** Move in from both sides towards the pivot element ***
               
                        Lower = Low
                        Higher = High
                        DO WHILE (Lower < Higher) AND (SortArray$(Lower) <= Partition$)
                                Lower = Lower + 1
                        LOOP
               
                        DO WHILE (Higher > Lower) AND (SortArray$(Higher) >= Partition$)
                                Higher = Higher - 1
                        LOOP
               
                        '*** If pivot element not reached, it means that ***
                        '*** two elements on either side are out of order, ***
                        '*** so swap them ***
               
                        IF Lower < Higher THEN
                                SWAP SortArray$(Lower), SortArray$(Higher)
                        END IF
       
                LOOP WHILE Lower < Higher

                '***  Move the pivot element back to its proper place in the array ***
       
                SWAP SortArray$(Lower), SortArray$(High)
        
                '*** Recursively call the SortArray sub ***
                '*** Pass the smaller subdivision first to use less stack space ***
       
                IF (Lower - Low) < (High - Lower) THEN
                        SortArrays SortArray$(), Low, Lower - 1
                        SortArrays SortArray$(), Lower + 1, High
                ELSE
                        SortArrays SortArray$(), Lower + 1, High
                        SortArrays SortArray$(), Low, Lower - 1
                END IF
        END IF
END IF

END SUB

Until I wrote this program I assumed that QBasic 1.1, which is the version I use, would run the same no matter what version of Windows is being used. This is erroneous. I use Windows 2000, but people using different versions of Windows have reported that the program fails when reading from the B drive. As a quick fix for this, rewrite the lines near the top of the program :-

ON ERROR GOTO DriveErr
FOR Count = 65 TO 90
     ProgErr = 0
     Message$ = CHR$(Count) + ":\"
     FILES Message$
     IF ProgErr = 0 THEN Drive$ = Drive$ + CHR$(Count)

NEXT Count

So that they become :-

Drive$ = "A"
ON ERROR GOTO DriveErr
For Count = 67 TO 90
     ProgErr = 0
     Message$ = CHR$(Count) + ":\"

etc. etc.

This isn't the best solution, as the drive list is now preset with an A drive, then misses B altogether before carrying from C, but it's the best I can do off the top of my head.

Another concern is the DIR listing. If the 8.3 file names aren't at the far left position as shown i the DIR listing from within QBasic then you are going to have to edit the subroutine GetCurrent. Find the lines :-

Num = INSTR(FileInfo$, " ")
Num = Num - 1
FileName$(NumFiles) = LEFT$(FileInfo$, Num) + "."
FileName$(NumFiles) = FileName$(NumFiles) + MID$(FileInfo$, 10, 3)

and replace them with :-

Num = INSTR(fns, FileInfo$, " ")
Num = Num - 1
FileName$(NumFiles) = MID$(FileInfo$, fns, Num) + "."
FileName$(NumFiles) = FileName$(NumFiles) + MID$(FileInfo$, fes, 3)

where "fns" is the start of the file name position and "fes" is the start of the file extension position inside temp.tmp

Do not use the long file names as the program is designed to use the short file names and I don't quite know what will happen, but I can guess they'll give some weird displays.

Here's what is happening, and why these differences are appearing.

As I understand it, part of the reason why Windows crashes is because of it's memory management. Programs ask for certain areas of memory to be reserved for it, Windows goes "OK, you can have such and such addresses and I'll reserve them for you". Unfortunately, Windows tells fibs, and the next program which wants to reserve memory gets all or part of the first programs reserved memory. Hence you get the blue screen of death, which blames the program for using an illegal function. The fact is, it happened because Windows didn't do what it was supposed to.

To help stop this happening, in protected mode, newer versions of Windows (and NT) protects memory so well it HAS to start a new version of command.com or cmd.exe depending on whether the program is 16 or 32 bit. For the most part this works very well, I haven't had a GPF since I got Windows 2000, the downside is that it limits what SHELL can do.

In April 2002, Robert Goddard sent me a copy of a filer30.bas that he has written. This gives a graphical interface to the file dialog. Bob writes about the program . . .

It can be easily tacked on to the front of any other program.
When running you use the arrow keys to move around.
Ctrl * to set a drive-e.g to go to A drive press CTRL a.
Return enables you to go into a folder or select a file.
Escape exits you
Pressing a letter by itself takes you to the next file or folder beginning with that letter.
To search for a folder use set("",0)
To search for a "***" file type use set ("***",-1) where *** is a file extension e.g. exe txt doc etc
To search for any file use set("",-1)

When the subroutine exits the file or folder is printed on the screen, of course at this stage you can now write your own code to edit/delete the file or whatever.

In July 2002, Robert sent me Filer46, a completely updated version of Filer30. Bob says this about the program ...

The program should work with any version of DOS as it uses the Basic FILES command which I have found unlike the DOS dir command always give output in the same format regardless of the type of DOS being used.

One slight problem I found was that the program stops (unsurprisingly) if you try to delete a file with read only attributes. I did write an earlier version which used the DOS attrib command to remove the "R" attribute from the file first. For some reason this made hash of the screen when I was running it on my work Windows NT PC. So that the program runs ok on any version of DOS I have left the shell "attrib" command rem'd out on the final version but you can reinstate it if you wish.

Files and folders are displayed with simplified “icons”. The current folder is displayed on the top line of the screen. The files and folders contained in the folder are displayed on the screen below. The current file or folder is highlighted in inverse print. Key presses available are :-

Escape - The clipboard is cleared, and if the highlighted item is a *.exc folder then the project highlighted is loaded.

Shift Followed By A Letter - The drive is selected. E.g. to select the floppy disk drive press Shift a

A Lower Case Letter Or A Number From 0 To 9 - This takes the highlighter to the next file or folder beginning with the letter pressed.

Arrow keys (not those on the number pad) - Used to move the highlighter around the screen.

Page Up - This takes the screen up a level in the filing system towards the root of the drive.

Enter - Opens a folder or actions a *.shc file (if any are on the computer). A *.shc file is effectively a DOS shortcut. For example if a *.shc file containing the plain text C:\Projects\Site1 only is actioned then the computer would move to that part of the filing system. If desired *.shc DOS shortcuts can be created by the use of DOS Edit, Notepad or any other Word Processor.

Delete - Following confirmation in a dialogue box at the bottom right of the screen the currently highlighted file or folder is permanently deleted.

Ctrl-Pause - Pressing these together at any time ceases execution of any QBasic program and returns the user to QBasic.

Ctrl A - This copies all the files (not folders) to the clipboard.

Ctrl C - This copies the currently selected file or folder to the clipboard.

Ctrl D - Following confirmation in a dialogue box at the bottom right of the screen all files (not folders) are permanently deleted.

Ctrl E - This enables the renaming of a *.exc folder in a dialogue box at the bottom right of the screen.

Ctrl N - This enables the creation of a new folder in a dialogue box at the bottom right of the screen.

Ctrl V - This pastes the contents of the clipboard and empties the clipboard at the same time.

Ctrl R - This enables the renaming of a file in a dialogue box at the bottom right of the screen.

Ctrl S - When a folder is highlighted this creates a *.shc shortcut file for subsequent actioning if wished by selection with the enter key.

Ctrl F - This enables the currently highlighted file to be split into small segments for easy transfer to another computer via floppy disk.

Ctrl J - This enables the currently highlighted file to be rejoined following transfer to the computer via floppy disk. See last.

Ctrl Q - This enables the password-based encryption of a file. De-encryption is exactly the same process and must be done with exactly the same password.

Ctrl T - The currently highlighted file’s contents are printed on the screen.

Ctrl Z - This key press either compresses all the files into a *.cpd file or uncompresses a *.cpd file.

The programs on this page, like all the programs written for this site, can be downloaded from the DLoads page.

QBasic | Errors | 40lb Weight | Bits | Chance | Colours | Dates | Delays | File Dialog | Files | Input | Matching | Menus | Mouse | Numbers | SeqNo | SIRDS | Sorts | Text | Timer | DLoads

HomePage | Optical Illusions | War Stories | QBasic | Dads Navy Days | Bristol | Bristol, USA | Bristol, Canada | Terre Haute | Miscellany | Web Stuff | About Ray | Site Map | Site Search | Messages | Credits | Links | Web Rings


GoStats stats counter