' SPECIAL NOTE: if you are viewing this in your web browser ' program, please click [View] and [Page Source] ' ' +--------------------------------------------------------------------+ ' | | ' | M E S A M E N U P R O G R A M | ' | - - - - - - - - - - - - - - - | ' | Public Domain - FreeWare | ' | - - - - - - - - - - - - - - - - - - - - - | ' | This is a special version of MesaMenu written for QB64. | ' | The code is MM.Bas and the executable is MM.Exe | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +--------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a thirty-year retired teacher | ' | of Math/History/Spanish residing in Orange County, California. I | ' | am also a former six-year Sergeant of Marines. Who-Rah! On certain | ' | forums I am known as MarineDon.My email is: smithdonb@earthlink.net| ' | | ' +--------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +--------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | MesaMenu was created by Don Smith on 08/01/2002. MesaMenu is | ' | declared Public Domain FreeWare. EMail: smithdonb@earthlink.net | ' | - - - - - - - - - - - - - - - - - - - - - - - - - | ' | Other programmers may use the included SUBs, or any other public | ' | domain program I have created, without naming me as the author. | ' | Programmers may even change the name of the program. It is my hope | ' | that any code written by me and used by another programmer will | ' | not be used for fee or profit. I do not insist on this; it is just | ' | something hoped for. | ' +--------------------------------------------------------------------+ ' | Operation of MesaMenu: | ' | To operate MesaMenu, enter on the command line: MM + | ' | space + asterisk(*) + dot(.) + File Extension (and press ENTER). | ' | Example -> MM *.TXT In this case, MesaMenu will place all files | ' | ending with .TXT in a viewing menu. To view all files with all | ' | possible file extensions in a subdirectory, use: MM *.* Once in | ' | the menu, press to view an ASCII text file. To launch an | ' | executable file ending in EXE, COM or BAR press . Unfortunately| ' | you will NOT be able to launch other programs ending in PDF, BMP | ' | and the like. To read helpful information, press . If no file | ' | extension is given, an error screen will pop up. | ' +--------------------------------------------------------------------+ ' | A special prodical is used with files endng with a *.ref | ' | extension. These special files are text files which | ' | previously have been encrypted by MM.Exe. So when a user | ' | presses on a .REF file to view it in Metapad, | ' | the program decrypts the REF file and places it in Metapad, | ' | and when the user exits Metapad, the program reencrypts | ' | the file. In this fashion all the sensitive data can be | ' | kept from prying eyes. The MM.Bas program can be | ' | configured to require a password or it can be configured | ' | so that two keys of the keyboard must be pressed one after | ' | another. Note that both of these routines may be used. | ' +--------------------------------------------------------------------+ ' | On the MM.Exe GUI: | ' | Ä Ä Ä Ä Ä Ä Ä Ä Ä | ' | ...Views file at the block cursor in Metapad. | ' | ......Info screen. | ' | ......Encrypts the single file at block cursor. | ' | ......Encrypts ALL the REF files. Be careful here. | ' | ......Deletes the file at the block cursor. | ' | ......Launch a EXE, COM or BAT program. | ' | ......Change extension to another one. | ' | ......Rename file at block cursor. | ' | ......Copy file at block cursor. | ' | .....Back up ALL files to another directory. | ' | | ' +--------------------------------------------------------------------+ ' | This MM.Bas program works perfectly well with QuickBASIC 4.5 but | ' | in QB64 it needs the following five .DLL files: | ' | | ' | 1. libfreetype-6.dll | ' | 2. sdl.dll | ' | 3. sdl_image.dll | ' | 4. sdl_mixer.dll | ' | 5. sdl_ttf.dll | ' | | ' | It also needs the following five files in a \DATA subdirectory: | ' | Example: C:\Mesamenu\Data | ' | | ' | 1. charset8.raw | ' | 2. chrset16.raw | ' | 3. qb64.pal | ' | 4. qb64ega.pal | ' | 5. QB64ICON.BMP | ' | | ' +--------------------------------------------------------------------+ ' | The MM.ZIP file contains the following files: | ' | | ' | 1. MM.Exe 6. sdl_mixer.dll 11. qb64ega.pal | ' | 2. MM.Bas 7. sdl_ttf.dll 12. QB64ICON.BMP | ' | 3. libfreetype-6.dll 8. charset8.raw 13. Metapad.Exe | ' | 4. sdl.dll 9. chrset16.raw 14. DIRSMALL.EXE | ' | 5. sdl_image.dll 10. qb64.pal | ' +--------------------------------------------------------------------+ ' | The seven SUBs used in this program are all Public Domain, FreeWare| ' | They do not need a special Library or Quick Library, just plain ol'| ' | QuickBASIC. Below is a brief description of each one. To find | ' | out more, visit each SUB and read the information at the top. | ' | | ' | (1) TinyBox - All you need to make boxes or windows | ' | of various sizes and styles. | ' | (2) DisplayMessage - This SUB will make a scroll- | ' | able message on screen. SUB DisplayMessage can also | ' | be employed as a standalone program to view/browse | ' | short text files. For long text files, use SUB TrueView. | ' | (3) MesaMenu - Places on screen a table menu of | ' | designated items - this program. | ' | (4) SaveRestScrn - This SUB will save and or | ' | restore a portion or all the current screen. | ' | (5) EditLoco is a one-line editor which may also be used | ' | in password mode, displaying a series of these: ùùùù | ' | (6) OneLine - will place a line of four styles or types: | ' | | ' | Style% = 1 ÃÄÄÄ´ | ' | | ' | Style% = 2 ÆÍÍ͵ | ' | | ' | Style% = 3 ÌÍÍ͹ | ' | | ' | Style% = 4 ÇÄÄĶ | ' | | ' | (7) XEncrypt - a simple but very effective encryption routine | ' | | ' +--------------------------------------------------------------------+ ' |The text file viewer and companion program is Trueview.Exe. Its | ' |basic code, TrueView.Bas, is also public domain freeware. It | ' |requires no special libraries, just QuickBASIC 4.5 | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Compile with QB4.5: | ' | BC MM /e (e for ON ERROR) | ' | | ' | LINK: MM | ' | LIB: BCom45 | ' +--------------------------------------------------------------------+ DEFINT A-Z '----------------------------------------------------------------------- DECLARE SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) DECLARE SUB DisplayMessage (Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) DECLARE SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) DECLARE SUB MesaMenu (M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) DECLARE SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) DECLARE SUB SaveRestScrn (FileName$, SaveOrRest%) DECLARE SUB XEncrypt (FileName$) DECLARE SUB SETTITLE (x$) Exten$ = COMMAND$ CALL SETTITLE("MesaMenu QB64 Program") PassWord: ' +=====================================================================+ ' | Use a password or press two keys (line label: twopasskeys) to | ' | enter the program, or both. In this case, the password is | ' | commented out, allowing "twopasskeys" to be used. | ' +=====================================================================+ 'COLOR 15, 1 'CLS 'LOCATE 10, 30 'COLOR 15, 0 'PRINT STRING$(20, " "); 'EdW$ = "": Row% = 10: Col = 30: FCol% = 30: LenStr% = 20 'See% = 0: TypeOfText$ = "": Caps% = 1: FGColr% = 15: BGColr% = 0 'FKey$ = "": InS% = 0: PW% = 1: ExitCode% = 0 'CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) 'IF ExitCode% = 27 THEN ' CLS : SYSTEM 'END IF 'IF EdW$ <> UCASE$("raddude") THEN ' GOTO errorhandler ' CLS : SYSTEM 'END IF twopasskeys: ' +=====================================================================+ ' | The program opens asking the user to press two keys to enter | ' | the program or to exit by pressing . The keys which have | ' | been "turned on" are and . By pressing one | ' | key after the other, the users enters the program. The CVI routine | ' | is used to determine the unique numbers of these two keys. | ' | | ' | An example of how to use CVI: | ' | ---------------------------- | ' | DO | ' | DO | ' | k$ = INKEY$ | ' | LOOP UNTIL LEN(k$) > 0 | ' | k% = CVI(k$ + CHR$(0)) | ' | '============================================ | ' | 'at this point, use IF/END IF or SELECT CASE | ' | '============================================ | ' | IF k% = 27 THEN ' | ' | CLS: END | ' | ELSEIF k% = 22222 ' | ' | GOSUB helpinformation | ' | END IF | ' | LOOP | ' +=====================================================================+ COLOR 15, 1: CLS CALL TinyBox(4, 11, 15, 69, 15, 1, 2) CALL OneLine(8, 11, 15, 1, 4, 58) LOCATE 6, 26, 0, 0, 0 COLOR 11, 1 PRINT "M e s a M e n u P r o g r a m"; LOCATE 10, 15, 0, 0, 0 COLOR 15, 1 PRINT "In order to enter the MesaMenu Program you must press"; LOCATE 11, 15, 0, 0, 0 PRINT "two keys on the keyboard, otherwise the program will"; LOCATE 12, 15, 0, 0, 0 PRINT "go into an endless loop. However, you'll be able"; LOCATE 13, 15, 0, 0, 0 PRINT "to exit by pressing ."; COLOR 14, 1 LOCATE 13, 36, 0, 0, 0 PRINT "Esc"; DO DO fpk$ = INKEY$ LOOP UNTIL LEN(fpk$) > 0 fpk% = CVI(fpk$ + CHR$(0)) IF fpk% = 27 THEN CLS : SYSTEM END IF IF fpk% = 18688 THEN 'first pass key is DO spk$ = INKEY$ LOOP UNTIL LEN(spk$) > 0 spk% = CVI(spk$ + CHR$(0)) IF spk% = 27 THEN CLS : SYSTEM END IF IF spk% = 20736 THEN 'second pass key is GOTO begin END IF END IF LOOP begin: LongNames% = 0 Exten$ = RTRIM$(LTRIM$(Exten$)) Exten$ = UCASE$(Exten$) IF LEFT$(Exten$, 2) <> "*." THEN 'incorrect DOS usage error GOTO errorhandler ELSEIF Exten$ = "" THEN 'blank parameter error GOTO errorhandler END IF makeshortmenu: '====================================================================== ' Check for command line parameter. If missing or entered ' incorrect, branch to errorhandler. '====================================================================== 'Next 9 lines checks for the existence of Exten$ SHELL "Dir" + " " + "/b" + " " + Exten$ + " " + ">" + " " + "FakeDir.Txt" OPEN "FakeDir.Txt" FOR APPEND AS #1 IF LOF(1) = 0 THEN 'file extention not on current directory CLOSE #1 KILL "FakeDir.Txt" GOTO errorhandler END IF CLOSE #1 KILL "FakeDir.Txt" '====================================================================== ' Make a file, $$$$FAKE.SM, containing short truncated DOS names. '====================================================================== 'Make a file, $$$$FAKE.SM, with short truncated DOS names: SHELL "dir" + " " + Exten$ + " " + "/b" + ">" + "$$$$FAKE.SM" ' +===================================================================+ ' | The next 13 lines takes a quick peek at $$$$FAKE.SM to check | ' | for the number of files of the requested file extension and sets | ' | MaxNum% to the correct number. At the same time, it determines | ' | if any files are longer than the 12 truncated spaces of DOS. | ' | If so, it sets LongNames% = 1 and hands it over to the next | ' | routine, just below. | ' +===================================================================+ OPEN "$$$$FAKE.SM" FOR INPUT AS #8 MaxNum% = 0 DO IF EOF(8) THEN EXIT DO END IF LINE INPUT #8, TossOut$ IF LEN(TossOut$) > 12 THEN LongNames% = 1 END IF MaxNum% = MaxNum% + 1 LOOP UNTIL EOF(8) CLOSE 8 IF LongNames% = 1 THEN ' +=================================================================+ ' | This IF/END IF routine is run because LongNames% was | ' | set to 1. The previous OPEN routine detected filenames | ' | with a length longer than the 12 truncated spaces of DOS | ' | and so SHELL is used to run a DOS QB45 program called | ' | DIRSMALL.EXE whose 2-line code is given below. QB64 will | ' | NOT truncate file names! Running DIRSMALL.EXE causes a DOS | ' | window to momentarily appear, but it immediately goes away. | ' | - - - - - - - - - - - - - - - - - - - - - | ' | HERE IS DIRSMALL.EXE COMPILED WITH QB45: | ' | - - - - - - - - - - - - - - - - - - - - - | ' | Exten$ = COMMAND$ | ' | SHELL "dir" + " " + Exten$ + " " + "/b" + ">" + "$$$$FAKE.SM" | ' +=================================================================+ SHELL "DIRSMALL.EXE" + " " + Exten$ END IF REDIM M$(MaxNum% + 1) OPEN "$$$$FAKE.SM" FOR INPUT AS #12 DO IF EOF(12) THEN EXIT DO END IF '================================================================== ' Next 4 lines extract the directory names of $$$$FAKE.SM ' into an array M$() '================================================================== FOR xyz% = 1 TO MaxNum% IF EOF(12) THEN EXIT FOR LINE INPUT #12, M$(xyz%) M$(xyz%) = UCASE$(M$(xyz%)) '=============================================================== ' The next 10 lines check for the existence of any name on ' the directory which has no dot (.) since, as such, it is ' probably a subdirectory. Subdirectories are not wanted so ' the line xyz% = xyz% -1 gets rid of it. '=============================================================== FOR Soso% = 1 TO LEN(M$(xyz%)) IF EOF(12) THEN EXIT FOR Dot$ = MID$(M$(xyz%), Soso%, 1) IF Dot$ = "." THEN EXIT FOR END IF IF Soso% = LEN(M$(xyz%)) THEN xyz% = xyz% - 1 END IF NEXT NEXT LOOP UNTIL EOF(12) CLOSE 12 KILL "$$$$FAKE.SM" '====================================================================== ' The next 8 lines check for the existence of $$$$FAKE.SM in ' M$(). If it is there, it gets eliminated. This name, $$$$FAKE.SM, ' was created by the batch file to hold the names on the directory ' and should not appear in Mesamenu. '====================================================================== IF LongNames% = 1 THEN FOR abc% = 1 TO MaxNum% - 1 IF M$(abc%) = "$$$$FAKE.SM" THEN M$(abc%) = "" M$(abc%) = M$(abc% - 1) END IF NEXT END IF IF LongNames% = 1 THEN M$(1) = "" FOR toto% = 1 TO MaxNum% M$(toto% - 1) = M$(toto%) NEXT END IF '====================================================================== ' Make top box with SUB TinyBoy window routine '====================================================================== COLOR 15, 1: CLS ULRow = 2 ULCol = 25 LRRow = 4 LRCol = 55 BoxFGColr = 15 BoxBGColr = 1 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) LOCATE 3, 31: COLOR 15, 1: PRINT "M e s a M e n u"; '====================================================================== ' Make main box with SUB TinyBoy window routine. '====================================================================== ULRow = 5 ULCol = 8 LRRow = 20 LRCol = 72 BoxFGColr = 15 BoxBGColr = 1 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) TopTitle$ = "Press to view one of the " + Exten$ + " files:" LOCATE 6, 18: PRINT TopTitle$; LOCATE 6, 25: COLOR 11, 1: PRINT "Enter"; LOCATE 6, 51: COLOR 14, 1: PRINT Exten$; CALL OneLine(7, 8, 15, 1, 4, 64) ULRow = 22 ULCol = 2 LRRow = 24 LRCol = 78 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 1 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) '====================================================================== ' Make bottom box of Keys with SUB TinyBoy window routine. '====================================================================== COLOR 15, 4 LOCATE 23, 3 PRINT "F1:Info F2:E-One F3:E-All F4:Del F5:Launch F7:Ext F8:Ren F9:Copy F10:BackUp"; COLOR 11, 4 LOCATE 23, 3: PRINT "F1"; LOCATE 23, 11: PRINT "F2"; LOCATE 23, 20: PRINT "F3"; LOCATE 23, 29: PRINT "F4"; LOCATE 23, 36: PRINT "F5"; LOCATE 23, 46: PRINT "F7"; LOCATE 23, 53: PRINT "F8"; LOCATE 23, 60: PRINT "F9"; LOCATE 23, 68: PRINT "F10"; COLOR 15, 4 'F1-F2 LOCATE 22, 10: PRINT CHR$(194) LOCATE 23, 10: PRINT CHR$(179); LOCATE 24, 10: PRINT CHR$(193); 'F2-F3 LOCATE 22, 19: PRINT CHR$(194) LOCATE 23, 19: PRINT CHR$(179); LOCATE 24, 19: PRINT CHR$(193); 'F3-F4 LOCATE 22, 28: PRINT CHR$(194) LOCATE 23, 28: PRINT CHR$(179); LOCATE 24, 28: PRINT CHR$(193); 'F4-F5 LOCATE 22, 35: PRINT CHR$(194) LOCATE 23, 35: PRINT CHR$(179); LOCATE 24, 35: PRINT CHR$(193); 'F5-F7 LOCATE 22, 45: PRINT CHR$(194) LOCATE 23, 45: PRINT CHR$(179); LOCATE 24, 45: PRINT CHR$(193); 'F7-F8 LOCATE 22, 52: PRINT CHR$(194) LOCATE 23, 52: PRINT CHR$(179); LOCATE 24, 52: PRINT CHR$(193); 'F8-F9 LOCATE 22, 59: PRINT CHR$(194) LOCATE 23, 59: PRINT CHR$(179); LOCATE 24, 59: PRINT CHR$(193); 'F9-F10 LOCATE 22, 67: PRINT CHR$(194) LOCATE 23, 67: PRINT CHR$(179); LOCATE 24, 67: PRINT CHR$(193); '====================================================================== ' Bring in requested files with SUB MesaMenu - Refer to SUB MesaMenu '====================================================================== Start% = 1 ' <- <- put Start% above "top" top: ' Count% = MaxNum% ' RegColrFG% = 15 ' RegColrBG% = 1 ' HiLiteFG% = 15 ' HiLiteBG% = 0 ' +--------------------------------------+ MaxScrRows% = 12 ' | For an explanation of the items to | MaxScrCols% = 4 ' | the left, visit the MesaMenu SUB. | ColumnPointer% = 1 ' | | TweenSpace% = 3 ' +--------------------------------------+ TableULRow% = 8 ' TableULCol% = 12 ' CurrentRow% = 0 ' CurrentCol% = 0 ' ItemNum% = Start% ' ItemWidth% = 12 ' FKey$ = "1234567890" ' ExitCode% = 0 begincompletemenu: CALL MesaMenu(M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) IF ExitCode% = 27 THEN ' COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: SYSTEM '================================================================== ' Press - View File At Block Cursor: First it decrypts ' the file, views it, and after closing, reencryts the file. '================================================================== ELSEIF ExitCode% = 13 THEN ' GOSUB savescreen FOR measure% = 1 TO LEN(M$(ItemNum%)) FindDot$ = MID$(M$(ItemNum%), measure%, 1) IF FindDot$ = "." THEN Ex$ = MID$(M$(ItemNum%), measure% + 1, 3) EXIT FOR END IF NEXT IF Ex$ = "REF" THEN CALL XEncrypt(M$(ItemNum%)) SHELL "Metapad.exe" + " " + M$(ItemNum%) IF Ex$ = "REF" THEN CALL XEncrypt(M$(ItemNum%)) GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu '================================================================== ' Press - Show Program info, using SUB DisplayMessage. ' Command GOSUB programinfo branches to the set up. '================================================================== ELSEIF ExitCode% = 1 THEN GOSUB savescreen GOSUB programinfo GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu '================================================================== ' Press - Encrypt file at block cursor '================================================================== ELSEIF ExitCode% = 2 THEN ' GOSUB savescreen ULRow = 12 ULCol = 16 LRRow = 14 LRCol = 63 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) FOR findshort% = 1 TO LEN(M$(ItemNum%)) Dot$ = MID$(M$(ItemNum%), findshort%, 1) IF Dot$ = " " THEN Ren$ = MID$(M$(ItemNum%), 1, findshort% - 1) EXIT FOR END IF NEXT '=============================================================== ' Next routine centers query on screen irregardless ' of the length of the file name. '=============================================================== IF LEN(Ren$) > 0 THEN p% = ((LRCol - ULCol) - LEN("Do You Wish To Encrypt " + Ren$ + " (Y/N)?")) \ 2 + ULCol LOCATE 13, p% + 1: COLOR 15, 4: PRINT "Do You Wish To Encrypt " + Ren$ + " (Y/N)?"; LOCATE 13, p% + 24: COLOR 11, 4: PRINT Ren$; ELSEIF LEN(Ren$) = 0 THEN LOCATE 13, 20: COLOR 15, 4: PRINT "Do You Wish To Encrypt " + M$(ItemNum%) + " (Y/N)?"; LOCATE 13, 43: COLOR 11, 4: PRINT M$(ItemNum%); END IF Ren$ = "" DO DO k$ = INKEY$ LOOP UNTIL LEN(k$) > 0 k% = CVI(k$ + CHR$(0)) SELECT CASE k% CASE 27, 78, 110 ' EXIT DO CASE 89, 121 ' '====================================================== ' Next routine checks if this is a REF extension. ' If it is not, an error message pops up. '====================================================== LenItem% = LEN(M$(ItemNum%)) FOR checkfile% = 1 TO LenItem% Dot$ = MID$(M$(ItemNum%), checkfile%, 1) IF Dot$ = "." THEN ReadExten$ = MID$(M$(ItemNum%), checkfile% + 1, LenItem% - checkfile%) ReadExten$ = RTRIM$(LTRIM$(ReadExten$)) IF ReadExten$ <> UCASE$("REF") THEN ULRow = 10 ULCol = 16 LRRow = 16 LRCol = 64 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(12, 16, 15, 4, 4, 48) LOCATE 11, 38: PRINT "Oops!"; COLOR 15, 4 LOCATE 13, 19: PRINT "This is not a REF file! Cannot be encrypted."; LOCATE 15, 35: PRINT "Press " COLOR 14, 4: LOCATE 13, 33: PRINT "REF"; COLOR 11, 4: LOCATE 15, 42: PRINT "Esc"; DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF END IF NEXT FileName$ = M$(ItemNum%) CALL XEncrypt(FileName$) EXIT DO END SELECT LOOP GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu '================================================================== ' Press - Encrypt ALL files '================================================================== ELSEIF ExitCode% = 3 THEN ' GOSUB savescreen Title$ = "" ULRow = 12 ULCol = 16 LRRow = 14 LRCol = 65 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) LOCATE 13, 19: COLOR 15, 4 PRINT "Do You Wish To Encrypt All " + Exten$ + " Files (Y/N)?"; LOCATE 13, 46: COLOR 11, 4: PRINT Exten$; REDIM abc%(MaxNum%) DO DO k$ = INKEY$ LOOP UNTIL LEN(k$) > 0 k% = CVI(k$ + CHR$(0)) SELECT CASE k% CASE 27, 78, 110 ' EXIT DO CASE 89, 121 ' '====================================================== ' Next routine checks if these are REF extension ' files. If they are not, an error message pops up. '====================================================== LenItem% = LEN(Exten$) FOR checkfile% = 1 TO LenItem% Dot$ = MID$(Exten$, checkfile%, 1) IF Dot$ = "." THEN ReadExten$ = MID$(Exten$, checkfile% + 1, LenItem% - checkfile%) ReadExten$ = RTRIM$(LTRIM$(ReadExten$)) IF ReadExten$ <> UCASE$("REF") THEN ULRow = 10 ULCol = 15 LRRow = 16 LRCol = 65 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(12, 15, 15, 4, 4, 50) COLOR 11, 4: LOCATE 11, 38: PRINT "Oops!"; COLOR 15, 4 LOCATE 13, 19: PRINT "These are not REF files! Cannot be encrypted." LOCATE 15, 35: PRINT "Press " COLOR 14, 4: LOCATE 13, 33: PRINT "REF"; COLOR 11, 4: LOCATE 15, 42: PRINT "Esc"; DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF END IF NEXT youtoo% = 0 COLOR 15, 1: CLS FOR abc% = 1 TO MaxNum% IF abc% = MaxNum% + 1 THEN EXIT DO END IF FileName$ = M$(abc%) '================================================== ' Next 7 lines prints the encrypted files on screen '================================================== youtoo% = youtoo% + 1 LOCATE youtoo%, 1 PRINT "Encrypting: " + M$(abc%); IF youtoo% = 25 THEN youtoo% = 1 COLOR 15, 1: CLS END IF CALL XEncrypt(FileName$) M$(abc%) = FileName$ FileName$ = "" NEXT EXIT DO END SELECT LOOP ERASE abc% GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu '================================================================== ' Press - Delete File At Block Cursor '================================================================== ELSEIF ExitCode% = 4 THEN ' GOSUB savescreen Title$ = "" ULRow = 12 ULCol = 14 LRRow = 14 LRCol = 61 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) FOR findshort% = 1 TO LEN(M$(ItemNum%)) Dot$ = MID$(M$(ItemNum%), findshort%, 1) IF Dot$ = " " THEN Ren$ = MID$(M$(ItemNum%), 1, findshort% - 1) EXIT FOR END IF NEXT IF LEN(Ren$) > 0 THEN p% = ((LRCol - ULCol) - LEN("Do You Wish To Delete " + Ren$ + " (Y/N)?")) \ 2 + ULCol LOCATE 13, p% + 1: COLOR 15, 4: PRINT "Do You Wish To Delete " + Ren$ + " (Y/N)?"; LOCATE 13, p% + 23: COLOR 11, 4: PRINT Ren$; ELSEIF LEN(Ren$) = 0 THEN LOCATE 13, 18: COLOR 15, 4: PRINT "Do You Wish To Delete " + M$(ItemNum%) + " (Y/N)?"; LOCATE 13, 40: COLOR 11, 4: PRINT M$(ItemNum%); END IF Ren$ = "" DO DO k$ = INKEY$ LOOP UNTIL LEN(k$) > 0 k% = CVI(k$ + CHR$(0)) SELECT CASE k% CASE 27, 78, 110 ' GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu CASE 89, 121 ' KILL M$(ItemNum%) EXIT DO END SELECT LOOP GOSUB restorescreen Start% = 1 FKey$ = "1234567890" GOTO begin '================================================================== ' Press - Launch executable '------------------------------------------------------------------ ' If file is not .EXE, .COM or .BAT, back out '================================================================== ELSEIF ExitCode% = 5 THEN ' GOSUB savescreen WhatEnd$ = RIGHT$(RTRIM$(LTRIM$(M$(ItemNum%))), 3) WhatEnd$ = UCASE$(WhatEnd$) IF WhatEnd$ <> "EXE" AND WhatEnd$ <> "COM" AND WhatEnd$ <> "BAT" THEN Title$ = "" ULRow = 12 ULCol = 13 LRRow = 14 LRCol = 68 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) LOCATE 13, 16: COLOR 15, 4 PRINT "Can Only Launch: EXE, COM or BAT files. Press "; LOCATE 13, 63: COLOR 11, 4: PRINT "Esc"; DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu ELSE SHELL M$(ItemNum%) GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF '================================================================== ' Press - Rename file. Employ SUB EditLoco '================================================================== ELSEIF ExitCode% = 6 THEN GOSUB savescreen ULRow = 10 ULCol = 20 LRRow = 16 LRCol = 60 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(12, 20, 15, 4, 4, 40) LOCATE 11, 29: COLOR 15, 4: PRINT "Name of New file is " + CHR$(205) + CHR$(16); Row% = 14 Col% = 33 FCol% = 33 LenStr% = 12 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 15 BGColr% = 0 FKey$ = "" PW% = 0 InS% = 0 LOCATE Row%, Col%: COLOR 15, 0: PRINT SPACE$(12); CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) IF ExitCode% = 27 THEN GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF OPEN EdW$ FOR OUTPUT AS #1 PRINT #1, SPACE$(1) CLOSE #1 SHELL "Metapad.exe" + " " + EdW$ GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begin '================================================================== ' Press - Change extension. Employ SUB EditLoco '================================================================== ELSEIF ExitCode% = 7 THEN GOSUB savescreen ULRow = 10 ULCol = 22 LRRow = 16 LRCol = 57 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(13, 22, 15, 4, 4, 35) LOCATE 11, 33: COLOR 11, 4: PRINT "Change Extension:"; LOCATE 12, 26: COLOR 15, 4: PRINT "Type In 3-Character Extension:"; Row% = 14 Col% = 38 FCol% = 38 LenStr% = 3 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 15 BGColr% = 0 FKey$ = "" PW% = 0 InS% = 0 LOCATE Row%, Col%: COLOR 15, 0: PRINT " "; CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) IF ExitCode% = 27 THEN GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF Exten$ = EdW$ IF LEFT$(Exten$, 2) <> "*." THEN Exten$ = "*." + Exten$ END IF 'Next 9 lines checks for the existence of Exten$ SHELL "Dir" + " " + "/b" + " " + Exten$ + " " + ">" + " " + "FakeDir.Txt" OPEN "FakeDir.Txt" FOR APPEND AS #1 IF LOF(1) = 0 THEN 'file extention not on current directory CLOSE #1 KILL "FakeDir.Txt" GOSUB extensionerror Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF CLOSE #1 KILL "FakeDir.Txt" GOTO begin '================================================================== ' Press - Rename file. Employ SUB EditLoco '================================================================== ELSEIF ExitCode% = 8 THEN GOSUB savescreen ULRow = 10 ULCol = 16 LRRow = 16 LRCol = 64 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(12, 16, 15, 4, 4, 48) FOR findshort% = 1 TO LEN(M$(ItemNum%)) Dot$ = MID$(M$(ItemNum%), findshort%, 1) IF Dot$ = " " THEN Ren$ = MID$(M$(ItemNum%), 1, findshort% - 1) EXIT FOR END IF NEXT '=============================================================== ' Next routine centers query on screen irregardless ' of the length of the file name. '=============================================================== IF LEN(Ren$) > 0 THEN LOCATE 11, 29: COLOR 15, 4: PRINT "Rename " + Ren$ + " to " + CHR$(205) + CHR$(16); LOCATE 11, 36: COLOR 11, 4: PRINT Ren$; ELSEIF LEN(Ren$) = 0 THEN LOCATE 11, 29: COLOR 15, 4: PRINT "Rename " + M$(ItemNum%) + " to " + CHR$(205) + CHR$(16); LOCATE 11, 36: COLOR 11, 4: PRINT M$(ItemNum%); END IF Ren$ = "" Row% = 14 Col% = 21 FCol% = 20 LenStr% = 40 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 15 BGColr% = 0 FKey$ = "" PW% = 0 InS% = 0 LOCATE Row%, Col%: COLOR 15, 0: PRINT SPACE$(40); CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) IF ExitCode% = 27 THEN GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF SHELL "REN" + " " + M$(ItemNum%) + " " + EdW$ GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begin '================================================================== ' Press - Copy one file. Employ SUB EditLoco '================================================================== ELSEIF ExitCode% = 9 THEN GOSUB savescreen HoldItemNum% = ItemNum% ULRow = 8 ULCol = 10 LRRow = 19 LRCol = 70 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(11, 10, 15, 4, 4, 60) LOCATE 9, 30: COLOR 15, 4: PRINT "Copy " + RTRIM$(LTRIM$(M$(ItemNum%))) + " To " + CHR$(205) + CHR$(16); LOCATE 9, 35: COLOR 11, 4: PRINT RTRIM$(LTRIM$(M$(ItemNum%))); LOCATE 10, 15: COLOR 15, 4: PRINT "If another directory, do NOT end with back slash (\)"; COLOR 14, 4 LOCATE 10, 40: PRINT "NOT"; LOCATE 10, 65: PRINT "\"; CALL OneLine(13, 10, 15, 4, 4, 60) LOCATE 12, 15: PRINT "After entering data, press To Begin Copying. " CALL OneLine(17, 10, 15, 4, 4, 60) LOCATE 18, 22: PRINT "Press To Exit Without Copying."; COLOR 11, 4: LOCATE 12, 43: PRINT "Enter" LOCATE 18, 29: PRINT "Esc"; Row% = 15 Col% = 20 FCol% = 20 LenStr% = 40 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 15 BGColr% = 0 FKey$ = "" PW% = 0 InS% = 0 LOCATE Row%, Col%: COLOR 15, 0: PRINT SPACE$(40); CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) IF ExitCode% = 27 THEN GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF SHELL "COPY" + " " + M$(ItemNum%) + " " + EdW$ GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begin '================================================================== ' Press - Backup all files. Employ SUB EditLoco '================================================================== ELSEIF ExitCode% = 10 THEN GOSUB savescreen HoldItemNum% = ItemNum% ULRow = 8 ULCol = 10 LRRow = 19 LRCol = 70 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(11, 10, 15, 4, 4, 60) LOCATE 9, 27: COLOR 15, 4: PRINT "Backup All" + " " + Exten$ + " files to " + CHR$(205) + CHR$(16); LOCATE 9, 38: COLOR 11, 4: PRINT Exten$; LOCATE 10, 15: COLOR 15, 4: PRINT "Use another directory; do NOT end with back slash (\)"; COLOR 14, 4 LOCATE 10, 41: PRINT "NOT"; LOCATE 10, 66: PRINT "\"; CALL OneLine(13, 10, 15, 4, 4, 60) LOCATE 12, 13: PRINT "After entering directory, press To Begin Backup. " CALL OneLine(17, 10, 15, 4, 4, 60) LOCATE 18, 21: PRINT "Press To Exit Without Backing Up."; COLOR 11, 4 LOCATE 12, 46: PRINT "Enter" LOCATE 18, 28: PRINT "Esc"; Row% = 15 Col% = 20 FCol% = 20 LenStr% = 40 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 15 BGColr% = 0 FKey$ = "" PW% = 0 InS% = 0 LOCATE Row%, Col%: COLOR 15, 0: PRINT SPACE$(40); CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) IF ExitCode% = 27 THEN GOSUB restorescreen Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu END IF FOR measure% = 1 TO LEN(M$(1)) FindDot$ = MID$(M$(ItemNum%), measure%, 1) IF FindDot$ = "." THEN Ex$ = MID$(M$(ItemNum%), measure% + 1, 3) EXIT FOR END IF NEXT youtoo% = 0 IF Ex$ = "REF" THEN COLOR 15, 1: CLS FOR backall% = 1 TO MaxNum% CALL XEncrypt(M$(backall%)) SHELL "COPY" + " " + M$(backall%) + " " + EdW$ CALL XEncrypt(M$(backall%)) '====================================================== ' Next 7 lines prints the backed up REF files on screen '====================================================== IF youtoo% = 25 THEN youtoo% = 1 COLOR 15, 1: CLS END IF youtoo% = youtoo% + 1 LOCATE youtoo%, 1 PRINT "Backing up: " + M$(backall%); NEXT ELSE COLOR 15, 1: CLS FOR backall% = 1 TO MaxNum% SHELL "COPY" + " " + M$(backall%) + " " + EdW$ '================================================== ' Next 7 lines prints the backed up files on screen '================================================== IF youtoo% = 25 THEN youtoo% = 1 COLOR 15, 1: CLS END IF youtoo% = youtoo% + 1 LOCATE youtoo%, 1 PRINT "Backing up: " + M$(backall%); NEXT END IF GOSUB restorescreen ItemNum% = HoldItemNum% Start% = ItemNum% FKey$ = "1234567890" GOTO begincompletemenu 'HoldItemNum% = ItemNum% END IF '====================================================================== ' Error message when pressed and a non-existant extension is given. '====================================================================== extensionerror: GOSUB restorescreen GOSUB savescreen ULRow = 8 ULCol = 20 LRRow = 17 LRCol = 60 BoxFGColr = 15 BoxBGColr = 4 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) COLOR 15, 4 CALL OneLine(10, 20, 15, 4, 4, 40) LOCATE 9, 37: COLOR 15, 4: PRINT "Oops!"; LOCATE 12, 26: PRINT "Unable to find " + Exten$ + " extension"; COLOR 11, 4 LOCATE 15, 26: PRINT "- Press any key to continue -"; COLOR 15, 4 LOCATE 15, 26: PRINT "-"; : LOCATE 15, 54: PRINT "-"; DO: LOOP WHILE INKEY$ = "" GOSUB restorescreen RETURN '====================================================================== ' Save 25X80 Screen with SUB SaveRestScrn. '====================================================================== savescreen: BSVName$ = "XXX--XXX.BSV" CALL SaveRestScrn(BSVName$, 1) RETURN '====================================================================== ' Restore 25X80 Screen with SUB SaveRestScrn. '====================================================================== restorescreen: BSVName$ = "XXX--XXX.BSV" CALL SaveRestScrn(BSVName$, 2) KILL "XXX--XXX.BSV" RETURN '====================================================================== ' Error message on command line error or no parameter given. '====================================================================== errorhandler: CALL TinyBox(2, 9, 16, 71, 15, 1, 1) CALL OneLine(4, 9, 15, 1, 1, 62) COLOR 12, 1: LOCATE 3, 38: PRINT "Oops!"; COLOR 15, 1 LOCATE 5, 20, 0, 0, 0: PRINT "Either no parameter was entered on the command" LOCATE 6, 20, 0, 0, 0: PRINT "line, or there were no matching files found. " COLOR 11, 1 LOCATE 8, 30, 0, 0, 0: PRINT "Example: MM *.TXT" COLOR 15, 1 LOCATE 10, 20, 0, 0, 0: PRINT "To view all the files on the current directory," LOCATE 11, 20, 0, 0, 0: PRINT "type Í" COLOR 11, 1 LOCATE 12, 40, 0, 0, 0: PRINT "MM *.* " LOCATE 15, 30: COLOR 14, 1: PRINT "Press Any Key To Exit." DO: LOOP WHILE INKEY$ = "" COLOR 7, 0: CLS : SYSTEM '====================================================================== ' Information screen when pressed. '====================================================================== programinfo: ULRow = 6 ULCol = 10 LRRow = 19 LRCol = 70 BoxFGColr = 15 BoxBGColr = 5 SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) CALL OneLine(17, 10, 15, 5, 4, 60) COLOR 11, 5 LOCATE 18, 45, 0, 0, 0: PRINT "Press To Exit"; COLOR 15, 5 LOCATE 18, 52, 0, 0, 0: PRINT "Esc"; COLOR 11, 5 LOCATE 18, 16, 0, 0, 0: PRINT "Use <" + CHR$(24) + "> <" + CHR$(25) + "> Arrows"; COLOR 15, 5 LOCATE 18, 21, 0, 0, 0: PRINT CHR$(24); LOCATE 18, 25, 0, 0, 0: PRINT CHR$(25); ' LOCATE 17, 39, 0, 0, 0: PRINT CHR$(194); LOCATE 18, 39, 0, 0, 0: PRINT CHR$(179); LOCATE 19, 39, 0, 0, 0: PRINT CHR$(207); '-------------------- ULRow% = 7 ULCol% = 15 LRRow% = 18 'LRRow% - ULRow% - 1 LRCol% = 68 MaxNum% = 163 ColrFG% = 15 ColrBG% = 5 REDIM Message$(MaxNum% + 1) Message$(1) = " ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ " Message$(2) = " ³ M e s a M e n u P r o g r a m ³ " Message$(3) = " ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ " Message$(4) = SPACE$(45) Message$(5) = "MM.Exe is the executable of the MesaMenu Program. The" Message$(6) = "program places into a table menu all files with the " Message$(7) = "same file extension. To use Mesamenu, at the command " Message$(8) = "prompt, type MM.Exe followed by an asterisk and a dot" Message$(9) = "and then a file extension. " Message$(10) = SPACE$(45) Message$(11) = " Example -> MM.Exe *.TXT " Message$(12) = "In this example, the Mesamenu program will list all " Message$(13) = "text files ending in .TXT in its menu. To view all " Message$(14) = "files, please use MM.Exe *.* " Message$(15) = SPACE$(45) Message$(16) = "SPECIAL NOTE: If any of the files happen to have " Message$(17) = "long file names, with a length longer than the 12 " Message$(18) = "truncated characters of DOS, Mesamenu runs a DOS " Message$(19) = "QB45 program called DIRSMALL.EXE. The reason for " Message$(20) = "this is because QB64 will NOT truncate file names! " Message$(21) = "So, running DIRSMALL.EXE causes a black DOS window " Message$(22) = "to momentarily appear, but it immediately goes away. " Message$(23) = SPACE$(45) Message$(24) = "There is a special prodicol with files ending in " Message$(25) = "REF. These files have been previously encrypted " Message$(26) = "by Mesamenu so that when the user pressed " Message$(27) = "to view a file, MesaMenu first decrypts the file " Message$(28) = "and puts it on screen. When the user subsequently " Message$(29) = "exits the viewer, Mesamenu once again encrypts the " Message$(30) = "file. Anyone trying to view an encrypted file with " Message$(31) = "another program like Notepad, outside the program, " Message$(32) = "will be looking at a bunch of " + CHR$(34) + "garbage" + CHR$(34) + " which is the " Message$(33) = "encryption. Now, if a user uses an extension that is " Message$(34) = "not REF, the encryption routine is turned off and " Message$(35) = "the file is viewed normally. If MM.EXE *.* is used " Message$(36) = "to view all files, Mesamenu will still treat the " Message$(37) = "REF with its special prodicol while the others " Message$(38) = "are treated in a regular fashion. " Message$(39) = SPACE$(45) Message$(40) = "There are several keys which are available: " Message$(41) = SPACE$(45) Message$(42) = " Press " + CHR$(34) + "Esc" + CHR$(34) + " to exit the MesaMenu program or " Message$(43) = "from any of the to <10> pop up panels. " Message$(44) = SPACE$(45) Message$(45) = " Info. This information screen. " Message$(46) = SPACE$(45) Message$(47) = " Encrypts the file at the block cursor. This will" Message$(48) = "encrypt a file which heretofor hasn't been encrypted." Message$(49) = "ONLY USE THIS ROUTINE with files which are plain text" Message$(50) = "files. If you encrypt/decrypt an .EXE program, for" Message$(51) = "example, it WiLL BE DESTROYED." Message$(52) = SPACE$(45) Message$(53) = " Encrypts ALL the files of like extension. If a " Message$(54) = "user has a group of sensitive files, he may rename " Message$(55) = "them with a .REF extension. Then, once loaded into " Message$(56) = "Mesamenu, by pressing , ALL of them will be " Message$(57) = "encrypted. ONLY USE ROUTINE with files which are" Message$(58) = "plain text files. If you encrypt/decrypt an .EXE" Message$(59) = "program, for example, it WiLL BE DESTROYED." Message$(60) = SPACE$(45) Message$(61) = " Deletes the file at the block cursor. " Message$(62) = SPACE$(45) Message$(63) = " Will Launch a .EXE, .COM or .BAT program. " Message$(64) = SPACE$(45) Message$(65) = " Creates a new file named by user. This routine " Message$(66) = "is not on the main GUI. " Message$(67) = SPACE$(45) Message$(68) = " Change the file extension to a new one. " Message$(69) = SPACE$(45) Message$(70) = " Rename the file. " Message$(71) = SPACE$(45) Message$(72) = " Copies the file to another name. If the file is " Message$(73) = "to be in another directory, do NOT end with a back " Message$(74) = "slash (\). " Message$(75) = " Example-> C:\MyFiles\Office " Message$(76) = SPACE$(45) Message$(77) = " Backup ALL files. Same information as . " Message$(78) = "Do NOT end with a back slash (\). " Message$(79) = " Example-> C:\Word\Documents " Message$(80) = "If the extension is .REF, the files will be backed " Message$(81) = "up in their plain, non-encrypted format. " Message$(82) = SPACE$(45) Message$(83) = "Part of the ZIP package is a Notepad replacement " Message$(84) = "called Metapad. When a viewer presses to " Message$(85) = "view a file, the file is viewed in Metapad. If a " Message$(86) = "person downloaded just the .BAS files and compiled " Message$(87) = "with QB64.EXE the Metapad.Exe references need to " Message$(88) = "be replaced with Notepad. The Metapad program is " Message$(89) = "much superior to Notepad. One thing I really like " Message$(90) = "about Metapad is that it may be exited by simply " Message$(91) = "pressing . Download Metapad here: " Message$(92) = SPACE$(45) Message$(93) = " http://liquidninja.com/metapad/ " Message$(94) = SPACE$(45) Message$(95) = "WARNING: If you are viewing a .REF file in Metapad " Message$(96) = "and then for some reason exit MM.EXE and leave " Message$(97) = "Metapad on screen, when you next view the same file " Message$(98) = "via MM.EXE it will be in encrypted format. The " Message$(99) = "reason: MM.EXE did not have the opportunity to " Message$(100) = "decrypt the file. The fix: Not a problem, just " Message$(101) = "press and press " + CHR$(34) + "Y" + CHR$(34) + ". The file will be " Message$(102) = "configured once again for MM.EXE. " Message$(103) = SPACE$(45) Message$(104) = " ========================================= " Message$(105) = SPACE$(45) Message$(106) = "DISCLAIMER: As for the executable program MM.EXE " Message$(107) = "and its supporting and ancillary programs and " Message$(108) = "files contained in MM.ZIP, called the MesaMenu " Message$(109) = "program, the author, Don Smith, accepts no liability " Message$(110) = "for damages resulting from their use or misuse. " Message$(111) = "There is NO warrantee nor guarantee given on any " Message$(112) = "part of the Mesamenu program and package. In opening " Message$(113) = "and using Mesamenu the computer programmer and/or " Message$(114) = "user accepts it in as " + CHR$(34) + "as is" + CHR$(34) + " condition and further" Message$(115) = "accepts total responsibility for it and its use or " Message$(116) = "misuse. " Message$(117) = SPACE$(45) Message$(118) = " ========================================= " Message$(119) = SPACE$(45) Message$(120) = "MMQB64.ZIP contains: 8. sdl_mixer.dll " Message$(121) = " 1. MM.EXE 9. sdl_ttf.dll " Message$(122) = " 2. MM.BAS In the \DATA subdirectory: " Message$(123) = " 3. Metapad.Exe 10. charset8.raw " Message$(124) = " 4. DIRSMALL.EXE 11. chrset16.raw " Message$(125) = " 5. libfreetype-6.dll 12. qb64.pal " Message$(126) = " 6. sdl.dll 13. qb64ega.pal " Message$(127) = " 7. sdl_image.dll 14. QB64ICON.BMP " Message$(128) = SPACE$(45) Message$(129) = " ========================================= " Message$(130) = SPACE$(45) Message$(131) = "PUBLIC DOMAIN: Mesamenu is freeware and public " Message$(132) = "domain. It was designed to be used frequently on a " Message$(133) = "daily basis. It may be used for menus, notes, daily " Message$(134) = "reflections, etc. Before regular use however, the " Message$(135) = "user is cautioned. As a public domain program, its " Message$(136) = "utility should be thoroughly tested beforehand. Try " Message$(137) = "it out using practice files and try out all the " Message$(138) = "key routines. " Message$(139) = SPACE$(45) Message$(140) = "As a public domain program, any programmer may " Message$(141) = "freely change the BAS code, MM.BAS, in any fashion " Message$(142) = "and that includes changing its name. My name does " Message$(143) = "NOT have to be listed as the author of MesaMenu. " Message$(144) = SPACE$(45) Message$(145) = " ========================================= " Message$(146) = SPACE$(45) Message$(147) = "ABOUT THE AUTHOR: " Message$(148) = "Hello. My name is Don Smith and I am a thirty-year " Message$(149) = "retired teacher of Math/History/Spanish residing in " Message$(150) = "Orange County, California. I am also a former " Message$(151) = "six-year Sergeant of Marines. Who-Rah! On certain " Message$(152) = "forums I am known as MarineDon. Education: B.A. " Message$(153) = "from the University of California, Irvine and " Message$(154) = "Masters from Pepperdine University, Malibu. Highest " Message$(155) = "Achievement: Sergeant of Marines. " Message$(156) = SPACE$(45) Message$(157) = "My genealogy website is: " Message$(158) = " http://www.smithselfgen.com " Message$(159) = SPACE$(45) Message$(160) = "My Email is: " Message$(161) = " smithdonb@earthlink.net " Message$(162) = SPACE$(45) Message$(163) = SPACE$(45) CALL DisplayMessage(Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) RETURN SUB DisplayMessage (Message$(), ULRow%, ULCol%, LRRow%, LRCol%, MaxNum%, ColrFG%, ColrBG%) '+---------------------------------------------------------------------+ '| DisplayMessage | '+---------------------------------------------------------------------+ '| The SUB DisplayMessage is a Public Domain, FreeWare program by | '| Don Smith. Date: 08/01/2002. EMail: smithdonb@earthlink.net | '+---------------------------------------------------------------------+ '| DisplayMessage will place a scrollable message on screen at the | '| row and column of choice. The message lines should be placed | '| in the main program together with a rediminsioning placed previous | '| to the message lines. Example-> REDIM Message$(MaxNum% +1). | '| With a bit of tweeking, this SUB should be able to be used as an | '| ASCII text viewer. | '+-------------+-------------------------------------------------------+ '| Message$ | Message lines to be placed in the main program. | '| | The number of message lines also must be | '| | rediminsioned in the main program. | '| | Example: REDIM Message$(58) | '+-------------+-------------------------------------------------------+ '| ULRow% | The upper left row to place message. | '+-------------+-------------------------------------------------------+ '| ULCol% | The upper left columnn to place message. | '+-------------+-------------------------------------------------------+ '| LRRow% | The lower right row of message. | '+-------------+-------------------------------------------------------+ '| LRCol% | The lower right column of message. | '+-------------+-------------------------------------------------------+ '| MaxNum% | The maximum number of message lines + 1. | '+-------------+-------------------------------------------------------+ '| ColrFG% | The foreground color of message. | '+-------------+-------------------------------------------------------+ '| ColrBG% | The back ground color of message. | '+-------------+-------------------------------------------------------+ COLOR ColrFG%, ColrBG% FOR place% = 1 TO LRRow% - ULRow% - 1 LOCATE place% + ULRow% - 1, ULCol%, 0, 0, 0 PRINT Message$(place%); NEXT DO DO Press$ = INKEY$ LOOP UNTIL LEN(Press$) > 0 Press% = CVI(Press$ + CHR$(0)) IF Press% = 27 THEN Where% = 0 EXIT SUB ELSEIF Press% = 20480 THEN 'DnArrow Where% = Where% + 1 IF Where% = MaxNum% - (LRRow% - ULRow% - 1) THEN '8 THEN SOUND 200, 2 END IF ELSEIF Press% = 18432 THEN 'UpArrow Where% = Where% - 1 IF Where% = -1 THEN SOUND 200, 2 END IF ELSEIF Press% = 20736 THEN 'PgDn Where% = Where% + (LRRow% - ULRow%) - 1 ELSEIF Press% = 18688 THEN 'PgUp Where% = Where% - (LRRow% - ULRow%) + 1 ELSEIF Press% = 20224 THEN 'End Where% = MaxNum% - 5 COLOR ColrFG%, ColrBG% ELSEIF Press% = 18176 THEN 'Home Where% = 0 END IF GOSUB placedown LOOP placedown: COLOR ColrFG%, ColrBG% FOR PlaceDn% = 1 TO LRRow% - ULRow% - 1 IF PlaceDn% + Where% - 1 = MaxNum% + 1 THEN RETURN ELSE IF Where% > MaxNum% - (LRRow% - ULRow%) THEN Where% = MaxNum% - (LRRow% - ULRow%) ELSEIF Where% <= 0 THEN Where% = 0 END IF LOCATE PlaceDn% + ULRow% - 1, ULCol%, 0, 0, 0 Work$ = LEFT$(Message$(PlaceDn% + Where%), LRCol% - ULCol%) Work$ = Work$ + SPACE$((LRCol% - ULCol%) - LEN(Work$)) PRINT Work$; END IF NEXT RETURN END SUB SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, InS%, PW%, ExitCode%) STATIC ' +--------------------------------------------------------------------+ ' | SUB EditLoco: | ' +--------------------------------------------------------------------+ ' | This is a version of SUB EditString is called SUB EditLoco. The | ' | SUB EditString is compiled with the Pro.Lib from Cresent SoftWare.| ' | This version, called SUB EditLoco is compiled with regular ol' | ' | QuickBASIC v4.5 and needs no special library. | ' +--------------------------------------------------------------------+ ' | EdW$ | The string to be edited. | ' +--------------+-----------------------------------------------------+ ' | Row% | The row to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | Col% | The column to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | FCol% | Use same number as Col% | ' +--------------+-----------------------------------------------------+ ' | LenStr% | Length of the string to edit. | ' +--------------+-----------------------------------------------------+ ' | See% | If See% = 0 then existing text will be displayed. | ' | | If See% = 1 existing text will be wiped. | ' +--------------+-----------------------------------------------------+ ' | TypeOfText$ | For all ASCII characers 32 to 255, TypeOfText = "" | ' | | For numbers only, TypeOfText$ = "1234567890" | ' | | For numbers with commas and decimals points, | ' | | TypeOfText$ = ".,1234567890" | ' | | For Yes or No answers, TypeOfText$ = "YNyn" | ' | | Whatever is included within the parethesis | ' | | is what will be accepted. | ' +--------------+-----------------------------------------------------+ ' | Caps% | Capital letters enabled, Caps% = 1 | ' +--------------+-----------------------------------------------------+ ' | FGColr% | The text foreground color. | ' +--------------+-----------------------------------------------------+ ' | BGColr% | The text back ground color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | Which keys to enable. To enabled | ' | | and , FKey$ = "150" ("0" is F10). | ' +--------------+-----------------------------------------------------+ ' | PW% | PW% = 1 - password mode enabled. | ' | | PW% = 0 - password mode NOT enabled. | ' +--------------+-----------------------------------------------------+ ' | Ins% | Ins% = 0 then INSERT OFF. Ins% = 1 then INSERT ON | ' +--------------+-----------------------------------------------------+ ' | The ExitCode% is derived from the unique CVI Basic command. | ' | The ExitCode% for the keys gets changed to 101 to 110. | ' | To enable programmers to use the CVI code in their own programs, | ' | I have attached a short program, KeyCode.Bas (just below this | ' | section) | ' +------------------------------------+-------------------------------+ ' | ExitCode% = 101 is F1 key | I arbitrarily changed | ' | ExitCode% = 102 is F2 key | through to 101-110. | ' | ExitCode% = 103 is F3 key | Their CVI Codes are: | ' | ExitCode% = 104 is F4 key +-------------------------------+ ' | ExitCode% = 105 is F5 key | CVI: ExitCode: | ' | ExitCode% = 106 is F6 key | ---- --- -------- | ' | ExitCode% = 107 is F7 key | 15104 101 | ' | ExitCode% = 108 is F8 key | 15360 102 | ' | ExitCode% = 109 is F9 key | 15616 103 | ' | ExitCode% = 110 is F10 key | 15872 104 | ' | ExitCode% = 13 is ENTER key | 16128 105 | ' | ExitCode% = 18432 is Up Arrow | 16384 106 | ' | ExitCode% = 20480 is Down Arrow| 16640 107 | ' | ExitCode% = 9 is TAB key | 16896 108 | ' | ExitCode% = 27 is EXIT key | 17152 109 | ' | | 17408 110 | ' +------------------------------------+-------------------------------+ ' | Please include at the top of the routine DEFINT A-Z | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Use KeyCode.Bas below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +--------------------------------------------------------------------+ ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ EdW$ = "": Ky$ = "" IF See% = 1 THEN LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT STRING$(LenStr%, " "); END IF begineditline: DO IF InS% = 1 THEN 'Insert On COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 4, 7 ELSEIF InS% = 0 THEN 'Insert Off COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 6, 7 END IF DO Ky$ = INKEY$ IF PW% = 1 THEN IF BlankIt% = 1 THEN BlankIt% = 0 END IF END IF LOOP UNTIL LEN(Ky$) > 0 SlamKey% = CVI(Ky$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'CHR$(31) to CHR$255) IF TypeOfText$ = "" THEN 'CHR$(32) is IF PW% = 0 THEN GOSUB showchar ELSEIF PW% = 1 THEN GOSUB editpassword END IF ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, Ky$) > 0 THEN IF PW% = 0 THEN GOSUB showchar ELSEIF PW% = 1 THEN GOSUB editpassword END IF END IF END IF ELSEIF SlamKey% = 27 THEN ' Key ExitCode% = 27 GOSUB getstring EXIT SUB ELSEIF SlamKey% = 19712 THEN ' Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN ' Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1 END IF ELSEIF SlamKey% = 13 THEN ' IF PW% = 0 THEN GOSUB getstring END IF ExitCode% = 13 EXIT SUB ' or or - If not used, REM these 3 out. ELSEIF SlamKey% = 9 OR SlamKey% = 18432 OR SlamKey% = 20480 THEN GOSUB getstring ExitCode% = SlamKey% EXIT SUB ELSEIF SlamKey% = 8 THEN ' Col% = Col% - 1 IF Col% = FCol% OR Col% < FCol% THEN Col% = FCol% END IF LOCATE Row%, Col% COLOR FGColr%, BGColr%: PRINT " "; IF PW% = 1 THEN EdW$ = LEFT$(EdW$, LEN(EdW$) - 1) END IF ELSEIF SlamKey% = 20992 THEN ' 'If 1 (on), turn off (0). If 0 (off), turn on (1). IF InS% = 1 THEN InS% = 0 'unREM if need to print "Insert Off/On" 'LOCATE 2, 66: Print "Insert Off "; ELSEIF InS% = 0 THEN 'REM out "Insert Off/On" if not used. InS% = 1 END IF ELSEIF SlamKey% = 21248 THEN ' FOR DelK% = Col% + 1 TO FCol% + LenStr% SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, DelK%)) NEXT SaveScr$ = MID$(SaveScr$, 1, LEN(SaveScr$) - 1) LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT EdW$ + SaveScr$; SaveScr$ = "" ELSEIF SlamKey% = 18176 THEN ' Col% = FCol% ELSEIF SlamKey% = 20224 THEN ' GOSUB getstring Col% = FCol% + LEN(EdW$) LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN ' = clears line of LOCATE Row%, FCol% 'all text. WipeOut$ = SPACE$(LenStr%) COLOR FGColr%, BGColr% PRINT WipeOut$; ELSEIF SlamKey% > 15103 OR SlamKey% < 17409 THEN ' to IdentKey$ = STR$(((SlamKey% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 110 GOSUB getstring EXIT SUB ELSE ExitCode% = VAL(IdentKey$) + 100 GOSUB getstring EXIT SUB END IF END IF END IF LOOP showchar: IF InS% = 1 THEN ' FOR Horizontal% = Col% TO FCol% + LenStr% - 1 EditL$ = EditL$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT IF Caps% > 0 THEN EditL$ = UCASE$(EditL$) Ky$ = UCASE$(Ky$) END IF COLOR FGColr%, BGColr% LOCATE Row%, Col%, 1 PRINT LEFT$(Ky$ + EditL$, FCol% + LenStr% - Col%); IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 EditL$ = "" ELSEIF InS% = 0 THEN ' LOCATE Row%, Col% IF Caps% > 0 THEN COLOR FGColr%, BGColr%: PRINT UCASE$(Ky$); ELSEIF Caps% = 0 THEN COLOR FGColr%, BGColr%: PRINT Ky$; END IF Col% = Col% + 1 IF Col% = FCol% + LenStr% THEN Col% = FCol% RETURN END IF END IF RETURN getstring: EditLine$ = SPACE$(LenStr%) FOR Horizontal% = FCol% TO FCol% + LenStr% EditLine$ = EditLine$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT EditLine$ = LTRIM$(RTRIM$(EditLine$)) EdW$ = EditLine$ RETURN editpassword: EdW$ = UCASE$(EdW$) + UCASE$(Ky$) COLOR FGColr%, BGColr% LOCATE Row%, Col% PRINT "þ"; 'CHR$(254) LOCATE Row%, Col% + 1, 1, 6, 7 IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 RETURN END SUB SUB MesaMenu (M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) ' +--------------------------------------------------------------------+ ' | MesaMenu was created by Don Smith on 08/01/2002. MesaMenu is | ' | declared Public Domain FreeWare. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The MesaMenu SUB seems long, but with all the REM lines removed, | ' | it is just 254 lines in length. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The MesaMenu name is abbreviated as MM to make it easier to | ' | enter at the command prompt. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The object of MesaMenu is to display on screen a table menu | ' | of selected items. These may be files on the current directory, | ' | or other menu choices. Enter as a parameter a group of files | ' | which have a common extension. Example: "MM *.txt"(without quotes)| ' | For this example, MM.EXE will bring up in a viewing window all | ' | files on the current directory having the extension of .TXT. Find | ' | the word "Exten$" 14 lines from the top of the main program | ' | To view ALL the files on the current directory, use "MM *.*" | ' | To change to your QuickBASIC files, use "MM *.bas" To view files | ' | with NO extension, use "MM *." . If the DOS command, "DIR *." | ' | is used at the prompt, it will display all directories and files | ' | having no extensions. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The program user may move the block cursor by pressing: | ' | . In | ' | addition, the user may press a letter, a number, an exclamation | ' | , or an underline <_>. The hi-lite cursor | ' | will jump to the first item beginning with the letter pressed, | ' | and, if there are any more items beginning with that letter, it | ' | will move down at each press of that letter. This SUB is not | ' | set up to use a mouse. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | If you press or the SUB will exit and a screen | ' | will be displayed. To find out how to use all the keys, | ' | refer to FKey$ below. | ' +----------------+---------------------------------------------------+ ' | M$() | Menu Item. In main program rediminsion: | ' | | REDIM M$(MaxNum% + 10) | ' +----------------+---------------------------------------------------+ ' | Start% | Which item to hi-light first. | ' +----------------+---------------------------------------------------+ ' | Count% | Count of total menu items. | ' +----------------+---------------------------------------------------+ ' | RegColrFG% | Regular fore ground color. | ' +----------------+---------------------------------------------------+ ' | RegColrBG% | Regular background color. | ' +----------------+---------------------------------------------------+ ' | HiLiteFG% | Hi-light foreground color. | ' +----------------+---------------------------------------------------+ ' | HiLiteBG% | Hi-light background color. | ' +----------------+---------------------------------------------------+ ' | MaxScrRows% | Number of rows to display on screen. | ' +----------------+---------------------------------------------------+ ' | MaxScrCols% | Number of columns to display on screen. | ' +----------------+---------------------------------------------------+ ' | ColumnPointer% | Points to current column in use. | ' +----------------+---------------------------------------------------+ ' | TweenSpace% | Number of spaces between columns. | ' +----------------+---------------------------------------------------+ ' | TableULRow% | Upper left row to place menu. | ' +----------------+---------------------------------------------------+ ' | TableULCol% | Upper left column to place menu. | ' +----------------+---------------------------------------------------+ ' | CurrentRow% | Current row of hi-light item. | ' +----------------+---------------------------------------------------+ ' | CurrentCol% | Current column of hi-light item. | ' +----------------+---------------------------------------------------+ ' | ItemNum% | Menu item number of the hi-lighted item. | ' | | In main program Start% and ItemNum% should be | ' | | the same. | ' +----------------+---------------------------------------------------+ ' | ItemWidth% | Width of menu items. | ' +----------------+---------------------------------------------------+ ' | FKey$ | To exit when an key is pressed, designate | ' | | the keys by placing them between paranthesis. | ' | | Example: FKey$ = "150". This means the SUB will | ' | | exit on pressing , or . The "0" | ' | | means "10". In the main program, indicate the | ' | | keys with ExitCode%. to is | ' | | ExitCode% = 1 to ExitCode% = 10. | ' | | | ' | | Example: | ' | | ------- | ' | | IF ExitCode% = 1 THEN ' | ' | | GOSUB savescreen | ' | | COLOR 15, 1: CLS | ' | | LOCATE 2, 33 | ' | | PRINT "Help Screen" | ' | | DO: LOOP WHILE INKEY$ = "" | ' | | GOSUB restorescreen | ' | | Start% = ItemNum% | ' | | GOTO begincompletemenu | ' | | END IF | ' +----------------+---------------------------------------------------+ ' | ExitCode% | The exit number as explained below. | ' +--------------------------------------------------------------------+ ' | In the code below this REM (') section, find the area beginning | ' | "daloop" and notice the keys trap below it. In QuickBASIC | ' | it is very easy to trap for any key on the keyboard by using the | ' | CVI command. It is accomplished through the use of a double | ' | DO/LOOP and then a series of IF/THENs (See Example). | ' | | ' | Example: | ' | ------- | ' | COLOR 15, 1: CLS | ' | PRINT "Press or X. To exit, press " | ' | PRINT | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | LOOP UNTIL LEN(Hit$) > 0 | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | IF Hit% = 27 THEN ' | ' | CLS : END | ' | ELSEIF Hit% = 15104 THEN ' | ' | PRINT "F1 - Yeah!" | ' | ELSEIF Hit% = 24 THEN ' or | ' | PRINT "Ctrl-X. Yeah!" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ ' | Use the KEYCODE.BAS program below to find the CVI numbers for | ' | the keys you need to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' | | ' | COLOR 15, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ FOR EqWidth% = 1 TO Count% M$(EqWidth%) = M$(EqWidth%) + SPACE$(ItemWidth% - LEN(M$(EqWidth%))) '====================================================================== ' The next 3 lines eliminate any blank M$() menu entries: '====================================================================== IF M$(EqWidth%) = SPACE$(12) THEN Count% = Count% - 1 END IF NEXT subtop: DivideIt% = Count% \ MaxScrRows% Remainder% = Count% MOD MaxScrRows% IF Remainder% > 0 THEN Remainder% = 1 END IF NumColsPossible% = DivideIt% + Remainder% LeftOver% = Count% MOD MaxScrRows% 'Count of items of last row IF Start% = 1 THEN CurrentRow% = TableULRow% CurrentCol% = TableULCol% ColumnPointer% = 1 ELSE LocateRow% = Start% MOD MaxScrRows% IF LocateRow% = 0 THEN LocateRow% = MaxScrRows% ColumnPointer% = (Start% \ MaxScrRows%) ELSE ColumnPointer% = (Start% \ MaxScrRows%) + 1 END IF CurrentRow% = TableULRow% + LocateRow% - 1 LocateCol% = (Start% \ MaxScrRows%) IF Start% MOD MaxScrRows% > 0 THEN LocateCol% = LocateCol% + 1 END IF IF LocateCol% > MaxScrCols% THEN LocateCol% = LocateCol% - MaxScrCols% FOR Spy% = 1 TO NumColsPossible% IF LocateCol% > MaxScrCols% THEN LocateCol% = LocateCol% - MaxScrCols% END IF IF LocateCol% <= MaxScrCols% THEN EXIT FOR END IF NEXT TheFactor% = ColumnPointer% \ MaxScrCols% IF ColumnPointer% MOD MaxScrCols% = 0 THEN show% = (MaxScrCols% * MaxScrRows%) * (TheFactor% - 1) ELSE show% = (MaxScrCols% * MaxScrRows%) * TheFactor% END IF IF LocateCol% <= 1 THEN CurrentCol% = TableULCol% END IF END IF END IF IF CurrentCol% < TableULCol% THEN CurrentCol% = TableULCol% + ((LocateCol% - 1) * (ItemWidth% + TweenSpace%)) END IF bringindisplay: FOR display% = TableULRow% TO TableULRow% + MaxScrRows% - 1 COLOR RegColrFG%, RegColrBG% LOCATE display%, TableULCol%, 0, 0, 0 show% = show% + 1 IF show% <= Count% THEN PRINT M$(show%) + SPACE$(TweenSpace%); ELSE PRINT SPACE$(ItemWidth% + TweenSpace%); END IF FOR ExecuteNext% = 1 TO MaxScrCols% - 1 IF show% + (ExecuteNext% * MaxScrRows%) <= Count% THEN IF LEN(M$(show% + (ExecuteNext% * MaxScrRows%))) = ItemWidth% THEN PRINT M$(show% + (ExecuteNext% * MaxScrRows%)) + SPACE$(TweenSpace%); ELSEIF LEN(M$(show% + (ExecuteNext% * MaxScrRows%))) = 0 THEN PRINT SPACE$(ItemWidth% + TweenSpace%); END IF ELSE IF Count% > (MaxScrRows% * MaxScrCols%) THEN PRINT SPACE$(ItemWidth% + TweenSpace%); END IF END IF NEXT NEXT COLOR HiLiteFG%, HiLiteBG% LOCATE CurrentRow%, CurrentCol%, 0, 0, 0 PRINT M$(ItemNum%) daloop: DO DO HitKey$ = INKEY$ LOOP UNTIL LEN(HitKey$) > 0 Hit% = CVI(HitKey$ + CHR$(0)) LOCATE CurrentRow%, CurrentCol%, 0, 0, 0 COLOR RegColrFG%, RegColrBG% PRINT M$(ItemNum%); IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% = 13 THEN ' ExitCode% = 13 EXIT SUB ELSEIF Hit% = 20480 THEN ' IF LeftOver% = 0 AND ItemNum% = Count% THEN CurrentRow% = TableULRow% - 1 ItemNum% = Count% - MaxScrRows% END IF IF ItemNum% < Count% THEN CurrentRow% = CurrentRow% + 1 ItemNum% = ItemNum% + 1 IF CurrentRow% = TableULRow% + MaxScrRows% THEN CurrentRow% = TableULRow% ItemNum% = ItemNum% - MaxScrRows% END IF ELSE CurrentRow% = TableULRow% ItemNum% = Count% - LeftOver% + 1 END IF ELSEIF Hit% = 18432 THEN ' CurrentRow% = CurrentRow% - 1 ItemNum% = ItemNum% - 1 IF CurrentRow% = TableULRow% - 1 THEN CurrentRow% = TableULRow% + MaxScrRows% - 1 ItemNum% = ItemNum% + MaxScrRows% IF ItemNum% > Count% THEN ItemNum% = Count% CurrentRow% = TableULRow% + LeftOver% - 1 END IF END IF ELSEIF Hit% = 19712 THEN ' IF ItemNum% <= Count% - LeftOver% THEN CurrentCol% = CurrentCol% + TweenSpace% + ItemWidth% ItemNum% = ItemNum% + MaxScrRows% ColumnPointer% = ColumnPointer% + 1 IF ItemNum% > Count% THEN ItemNum% = Count% IF LeftOver% = 0 THEN CurrentCol% = CurrentCol% - (TweenSpace% + ItemWidth%) CurrentRow% = TableULRow% + MaxScrRows% - 1 ItemNum% = Count% ColumnPointer% = ColumnPointer% - 1 ELSEIF LeftOver% > 0 THEN CurrentRow% = TableULRow% + LeftOver% - 1 END IF END IF END IF IF ColumnPointer% > MaxScrCols% THEN Start% = ItemNum% show% = 0 ColumnPointer% = 0 GOTO subtop END IF ELSEIF Hit% = 19200 THEN ' IF ColumnPointer% <= 0 THEN ColumnPointer% = 1 END IF IF ColumnPointer% > 1 THEN CurrentCol% = CurrentCol% - (TweenSpace% + ItemWidth%) ItemNum% = ItemNum% - MaxScrRows% ColumnPointer% = ColumnPointer% - 1 END IF IF ColumnPointer% >= MaxScrCols% THEN ColumnPointer% = 0 Start% = ItemNum% show% = 0 GOTO subtop END IF ELSEIF Hit% = 18176 THEN ' CurrentRow% = 0 CurrentCol% = 0 show% = 0 ItemNum% = 1 Start% = 1 GOTO subtop ELSEIF Hit% = 20224 THEN ' show% = 0 ItemNum% = Count% Start% = Count% CurrentCol% = 0 GOTO subtop ELSEIF Hit% = 20736 THEN ' ItemNum% = ItemNum% + (MaxScrRows% * MaxScrCols%) IF ItemNum% > Count% THEN ItemNum% = Count% END IF Start% = ItemNum% CurrentCol% = 0 show% = 0 GOTO subtop ELSEIF Hit% = 18688 THEN ' ItemNum% = ItemNum% - (MaxScrRows% * MaxScrCols%) IF ItemNum% <= 0 THEN ItemNum% = 1 END IF Start% = ItemNum% CurrentCol% = 0 show% = 0 GOTO subtop 'PRESS: Letters A - Z (or a - z), Numbers 0 - 9, ' Exclamation , or Underline <_>. ELSEIF Hit% > 64 AND Hit% < 91 OR Hit% > 96 AND Hit% < 123 OR Hit% > 47 AND Hit% < 58 OR Hit% = 33 OR Hit% = 95 THEN IF Hit% > 96 AND Hit% < 123 THEN Hit% = Hit% - 32 END IF FOR xyz% = 1 TO Count% Letr$ = LEFT$(M$(xyz%), 1) IF xyz% = Count% AND ASC(Letr$) <> Hit% THEN show% = 0 GOTO subtop ELSEIF ASC(Letr$) = Hit% THEN EXIT FOR END IF NEXT FOR YYY% = 1 TO Count% CurrentLetr$ = LEFT$(M$(ItemNum%), 1) IF CurrentLetr$ <> FindLetr$ THEN TryLetters% = 0 END IF NEXT TryLetters% = TryLetters% + 1 FOR zzz% = TryLetters% TO Count% FindLetr$ = LEFT$(M$(zzz%), 1) IF ASC(FindLetr$) = Hit% THEN Start% = zzz% TryLetters% = zzz% ItemNum% = Start% ColumnPointer% = 0 show% = 0 CurrentCol% = 0 IF zzz% = Count% THEN ItemNum% = Count% TryLetters% = 0 END IF GOTO subtop END IF IF zzz% = Count% THEN zzz% = 0 END IF NEXT ELSEIF Hit% > 15103 AND Hit% < 17409 THEN 'F1 - F10 IdentKey$ = STR$(((Hit% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF END IF LOCATE CurrentRow%, CurrentCol%, 0, 0, 0 COLOR HiLiteFG%, HiLiteBG% PRINT M$(ItemNum%); LOOP END SUB SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) ' +-------------------------------------------------------------------+ ' | SUB OneLine | ' +-------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB OneLine has 12 lines. | ' +-------------------------------------------------------------------+ ' | SUB OneLine will place one line on screen. There are 4 types | ' | of lines to choose from. See Style% below. | ' +---------------+---------------------------------------------------+ ' | LineRow% | Row to place line. | ' +---------------+---------------------------------------------------+ ' | LineCol% | Column to place line. | ' +---------------+---------------------------------------------------+ ' | LineFG% | Foreground color of line. | ' +---------------+---------------------------------------------------+ ' | LineBG% | Background color of line. | ' +---------------+---------------------------------------------------+ ' | Style% | Style% = 1 ÃÄÄÄ´ | ' | +---------------------------------------------------+ ' | | Style% = 2 ÆÍÍ͵ | ' | +---------------------------------------------------+ ' | | Style% = 3 ÌÍÍ͹ | ' | +---------------------------------------------------+ ' | | Style% = 4 ÇÄÄĶ | ' +---------------+---------------------------------------------------+ ' | LenStr% | Length of string (line). | ' +-------------------------------------------------------------------+ IF Style% = 1 THEN 'ÃÄÄÄ´ SingLine$ = CHR$(195) + STRING$(LenStr%, CHR$(196)) + CHR$(180) ELSEIF Style% = 2 THEN 'ÆÍÍ͵ SingLine$ = CHR$(198) + STRING$(LenStr%, CHR$(205)) + CHR$(181) ELSEIF Style% = 3 THEN 'ÌÍÍ͹ SingLine$ = CHR$(204) + STRING$(LenStr%, CHR$(205)) + CHR$(185) ELSEIF Style% = 4 THEN 'ÇÄÄĶ SingLine$ = CHR$(199) + STRING$(LenStr%, CHR$(196)) + CHR$(182) END IF LOCATE LineRow%, LineCol% COLOR LineFG%, LineBG% PRINT SingLine$; END SUB SUB SaveRestScrn (FileName$, SaveOrRest%) '+------------------+---------------------------------------------------+ '| SaveOrRest% | SaveOrRest% = 1 (1 means save the screen) | '| | SaveOrRest% = 2 (2 means restore the screen) | '+------------------+----------+----------------------------------------+ IF SaveOrRest% = 1 THEN ' +============================================================================+ ' | Saves current text screen to the specified binary file. If file already | ' | exists, it will be overwritten. SCREEN 0 (text mode) only. | ' +============================================================================+ 'display controller port ScreenType& = PEEK(&H63) + PEEK(&H64) * 256 'mono or color? IF ScreenType& = &H3B4 THEN ' mono ScreenType& = &HB000 ELSE ScreenType& = &HB800 ' color END IF 'ave screen to disk DEF SEG = ScreenType& BSAVE FileName$, 0, 4000 DEF SEG ELSEIF SaveOrRest% = 2 THEN ' +============================================================================+ ' | Restores a screen which has been BSAVEd. | ' +============================================================================+ 'display controller port ScreenType& = PEEK(&H63) + PEEK(&H64) * 256 'mono or color? IF ScreenType& = &H3B4 THEN ScreenType& = &HB000 ' mono ELSE ScreenType& = &HB800 ' color END IF 'restore screen from disk DEF SEG = ScreenType& BLOAD FileName$, 0 DEF SEG END IF END SUB SUB SETTITLE (x$) FOOBAR = 1 END SUB SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) ' +----------------------------------------------------------------------+ ' | SUB TinyBox | ' +----------------------------------------------------------------------+ ' | ULRow = Upper Left Row. ULCol = Upper Left Column. | ' | LRRow = Lower Right Row. LRCol = Lower Right Column. | ' | BoxFGColr = The Foreground Color The Box. | ' | BoxBGColr = The Back Ground Color Of The Box. | ' | SingOrDoub = 1 (Single Line Box). SingOrDoub = 2 (Double Line Box). | ' +----------------------------------------------------------------------+ COLOR BoxFGColr, BoxBGColr IF SingOrDoub = 1 THEN LOCATE ULRow, ULCol PRINT CHR$(218) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(191); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(179) + STRING$(LRCol - ULCol, " ") + CHR$(179); NEXT LOCATE LRRow, ULCol PRINT CHR$(192) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(217); ELSEIF SingOrDoub = 2 THEN LOCATE ULRow, ULCol PRINT CHR$(201) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(187); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(186) + STRING$(LRCol - ULCol, " ") + CHR$(186); NEXT LOCATE LRRow, ULCol PRINT CHR$(200) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(188); END IF END SUB SUB XEncrypt (FileName$) PassWord$ = "big7863bobo" LenOfKey% = LEN(PassWord$) InCharByte$ = SPACE$(1) Keylocation& = 1 TempFile$ = "FileDump.Txt" OPEN FileName$ FOR INPUT AS #9 LINE INPUT #9, Soso$ Soso$ = RTRIM$(LTRIM$(Soso$)) IF LEFT$(Soso$, 9) = "Encrypted" THEN Encry% = 1 END IF CLOSE #9 OPEN FileName$ FOR INPUT AS #1 OPEN TempFile$ FOR OUTPUT AS #2 IF Encry% = 0 THEN PRINT #2, "Encrypted File. Any attempts to unlock will destroy the file." ELSEIF Encry% = 1 THEN LINE INPUT #1, ThrowAway$ END IF DO IF EOF(1) THEN EXIT DO LINE INPUT #1, InputLine$ FOR CheckLine% = 1 TO LEN(InputLine$) InCharByte$ = MID$(InputLine$, CheckLine%, 1) IF InCharByte$ = "" THEN InCharByte$ = "%" IF Encry% = 1 THEN AltAsc% = ASC(InCharByte$) - ASC(MID$(PassWord$, Keylocation&, 1)) ELSEIF Encry% = 0 THEN AltAsc% = ASC(InCharByte$) + ASC(MID$(PassWord$, Keylocation&, 1)) END IF Keylocation& = Keylocation& + 1 IF Encry% = 1 THEN IF AltAsc% < 1 THEN AltAsc% = 223 + AltAsc% '254 ELSEIF Encry% = 0 THEN IF AltAsc% > 254 THEN AltAsc% = AltAsc% - 223 '254 END IF IF Keylocation& > LenOfKey% THEN Keylocation& = 1 PlaceMe$ = PlaceMe$ + CHR$(AltAsc%) NEXT PRINT #2, PlaceMe$ PlaceMe$ = "" LOOP UNTIL EOF(1) CLOSE #1: CLOSE #2 KILL FileName$ OPEN TempFile$ FOR INPUT AS #12 OPEN FileName$ FOR OUTPUT AS #8 WHILE NOT EOF(12) IF EOF(12) THEN CLOSE 8: CLOSE 12 EXIT SUB END IF LINE INPUT #12, LineBabe$ PRINT #8, LineBabe$ WEND 'Clean up CLOSE 8: CLOSE 12 KILL TempFile$ ThrowAway$ = "" PassWord$ = "" LenOfKey% = 0 InCharByte$ = "" Keylocation& = 0 Soso$ = "" Encry% = 0 AltAsc% = 0 PlaceMe$ = "" LineBabe$ = "" END SUB