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