' +-------------------------------------------------------------------- + ' | | ' | B e e V i e w (Version 5.0) | ' | | ' | Public Domain - FreeWare | ' +---------------------------------------------------------------------+ ' | BeeView is a ASCII text browser/viewer system. Version 5.0 is a | ' | special version, written especially to encrypt/decrypt files on | ' | the fly. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a retired thiry-year teacher | ' | of Math/History/Spanish residing in Orange County, California. I am | ' | also a former 6-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. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | Acknowledgements - (1) Full Moon Software | ' | (2) TheSoft | ' | _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ | ' | | ' | FULL MOON SOFTWARE: | ' | ------------------ | ' | BeeView.Bas was written with QuickBASIC 4.5. A great assist in | ' | writing BeeView and compiling it were three toolboxes originally | ' | from Crescent Software. They are: QuickPak, PDQ and QuickScreen. | ' | Crescent Software was sold to Progress Software. The original owner | ' | and programmer of Crescent Software, Ethen Winer, took back the | ' | MS-DOS toolboxes so that they still would be available to MS-DOS | ' | programmers. He now operates Full Moon Software. These three | ' | toolboxes have hundreds of routines. Using their included libraries | ' | instead of BRUN45.Lib or BCOM45.Lib and utilizing their assembly | ' | written routines, makes for an extremely tight, executable program | ' | very close to the tiny size and speed of an assembly language | ' | program. | ' | | ' | Ethan Winer's internet site: | ' | ---------------------------- | ' | http://www.ehtanwiner.com | ' | | ' | Ethan Winer's Mailing Address: | ' | ------------------------------ | ' | FULL MOON SOFTWARE | ' | 34 Cedar Vale Drive | ' | New Milford, CT 06776 | ' | | ' | (Voice) 860-350-8188 | ' | (Fax) 860-350-6130 | ' | (Email) ethan@ethanwiner.com | ' | | ' | | ' | THEDRAW: | ' | ------- | ' | Most of the screens, including opening screens, were designed with | ' | TheDraw program from TheSoft Programming Services. Shareware. | ' | Excellent! Type in "thesoft" in your internet browser search | ' | engine. There will be many places to download. Look for | ' | "TDraw463.Zip". | ' +---------------------------------------------------------------------+ ' | Compile Info: | ' | ------------ | ' | BC : bv | ' | +---------------------------------+| ' | LINK : @bvlink.txt |bvlink.txt: || ' | |---------- || ' | |bv+ || ' | |c:\dos\program\obj\bhelp14+ || ' | |c:\dos\program\obj\bhelp15+ || ' | |c:\dos\program\obj\bhalt5+ || ' | |c:\dos\program\obj\b10view+ || ' | |c:\dos\program\obj\b13view /noe || ' | +---------------------------------+| ' | | ' | LIB : /seg:500 pro pdq | ' | | ' +---------------------------------------------------------------------+ ' | AUTHOR: | ' | ------ | ' | My name is Don Smith and and I am a retired Math/History/Spanish | ' | teacher residing in Orange County, California, I may be reached | ' | through EarthLink if there are questions or input. | ' | | ' | +---------------------------------------------+ | ' | | Author : Donald Bernard Smith | | ' | +---------------------------------------------+ | ' | | EMail Address : smithdonb@earthlink.net | | ' | +---------------------------------------------+ | ' | +------------------------+ | ' | | - Happy Computing - | | ' | +------------------------+ | ' +---------------------------------------------------------------------+ first.step: DEFINT A-Z '------------------------------------------ DECLARE FUNCTION DOSError% () DECLARE FUNCTION Exist% (FileName$) DECLARE FUNCTION ExpandTab$ (X$, NumSpaces%) DECLARE FUNCTION FCount% (FSpec$) DECLARE FUNCTION FileSize& (FileName$) DECLARE FUNCTION GetDir$ (Drive$) DECLARE FUNCTION InCount% (LookIn$, Char$) DECLARE FUNCTION KeyCode% () DECLARE FUNCTION LineCount% (FileName$, Buffer$) DECLARE FUNCTION LoadExec% (File$, CmdLine$) DECLARE FUNCTION QPLeft$ (Work$, NumChar%) DECLARE FUNCTION QPLen% (Work$) DECLARE FUNCTION QPMid$ (Work$, StartChar%, NumChar%) DECLARE FUNCTION QPRight$ (Work$, NumChar%) DECLARE FUNCTION QPTrim$ (Work$) DECLARE FUNCTION QPValI% (SomeStrings$) DECLARE FUNCTION Rand% (Hi%, Lo%) '----------------------------------------------------------------------- DECLARE SUB AMenu (BYVAL address, Start, Count, ScanCode%, FileColr, HiLiteColr, Rows, Columns, Spacing, Row, column) DECLARE SUB Chime (Number%) DECLARE SUB CMenu (M$(), Row%, TopRow%, col%, RegColr%, HiLiteColr%, MaxItems%, Choice%) DECLARE SUB EditString (EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) DECLARE SUB encrypt (FileName$, PassWord$) DECLARE SUB FClose (Handle) DECLARE SUB FGet (Handle, Destination$) DECLARE SUB FileCrypt (FileName$, PassWord$, Oops%) DECLARE SUB FOpen (FileName$, Handle) DECLARE SUB FPut (Handle, Source$) DECLARE SUB FSeek (Handle, Offset&) DECLARE SUB LowASCII (text$) DECLARE SUB ReadFile (BYVAL address) DECLARE SUB RemCtrl (text$, Replace$) DECLARE SUB SortStr2 (BYVAL address, Size, Direction) DECLARE SUB StuffBuffer (Cmd$) '----------------------------------------------------------------------- DECLARE SUB BHalt5 (MonoCode%) DECLARE SUB BHelp14 (MonoCode%) DECLARE SUB BHelp15 (MonoCode%) DECLARE SUB B10View (MonoCode%) DECLARE SUB B13view (MonoCode%) '----------------------------------------------------------------------- ' 'c:\basic\pdq\pdqdecl.bas' ' 'c:\basic\quickpak\defCnf.bi' ' 'c:\basic\quickpak\SetCnf.bi' '----------------------------------------------------------------------- Mon = Monitor% CommandName$ = COMMAND$ ComLineFiles$ = CommandName$ IF ComLineFiles$ = "" THEN GOTO stop.the.show END IF SetColor = 1 command.line.parameters: LenExt = QPLen%(ComLineFiles$) LOPS% = 0 FOR FindIt = 1 TO LenExt Sign$ = QPMid$(ComLineFiles$, FindIt, 1) IF Sign$ = "+" THEN 'set Lock Keys GOSUB lock.on ELSEIF Sign$ = "%" THEN 'set password GOSUB pass.word ELSEIF Sign$ = "$" THEN 'set encrypted mode SetEncryption = 1 'set Menu Style mode ELSEIF Sign$ = "#" THEN ChooseColor$ = QPMid$(ComLineFiles$, FindIt + 1, QPLen%(ComLineFiles$) - FindIt + 1) ChooseColor$ = QPTrim$(ChooseColor$) Bsv.Color% = QPValI%(ChooseColor$) IF ChooseColor$ = "m" or ChooseColor$ = UCASE$("m") THEN SetColor = 2 ELSEIF ChooseColor$ <> UCASE$("m") THEN COLOR 7, 0: CLS LOCATE 3, 17, 0 CALL MQPrint("The letter after the # sign should be an " + CHR$(34) + "M" + CHR$(34) + ".", 7) LOCATE 4, 17, 0 CALL MQPrint("Press Any Key To Continue.", 7) DO: LOOP WHILE INKEY$ = "" LOCATE 1, 1, 1, 6, 7: COLOR 7, 0: CLS : END END IF ELSEIF Sign$ = "/" THEN FoundSlash = 1 LenToSlash = QPLen%(ComLineFiles$) - FindIt Slash$ = QPRight$(ComLineFiles$, LenToSlash) Slash$ = QPTrim$(Slash$) Slash$ = QPLeft$(Slash$, 3) FOR CutItOut = 1 TO QPLen%(Slash$) ColonMark$ = QPMid$(Slash$, CutItOut, 1) IF ColonMark$ = "#" THEN Slash$ = QPLeft$(Slash$, ((FindIt + CutItOut) - (FindIt + 1))) IF QPValI%(Slash$) = 10 OR QPValI%(Slash$) = 11 THEN SetColor = 2 SetScreen = 2 END IF EXIT FOR END IF NEXT END IF NEXT IF FoundSlash% = 0 THEN IF FoundZm = 1 THEN FOR MandM = 1 TO QPLen%(CommandName$) TheColon$ = QPMid$(CommandName$, MandM, 1) IF TheColon$ = "#" THEN CommandName$ = QPLeft$(CommandName$, QPLen%(CommandName$) - (QPLen%(CommandName$) - MandM + 1)) END IF NEXT END IF FileName$ = CommandName$ ThereName = Exist%(FileName$) IF ThereName = 0 THEN CALL MQPrint(" Unable To Find : " + CHR$(34) + FileName$ + CHR$(34) + " ", 14) PRINT : LOCATE , , 1, 6, 7: END ELSEIF ThereName = -1 THEN LOCATE 1, 1, 0, 0, 0 GOSUB fullview CLS : LOCATE , , 1, 6, 7: END END IF END IF TheExt$ = Slash$ IF TheExt$ = UCASE$("set") THEN COLOR 15, 1: CLS CALL Box0(4, 10, 10, 68, 1, 31) LOCATE 5, 12, 0: CALL MQPrint("š Program Halted š The BeeView program will not accept", 31) LOCATE 5, 12, 0: CALL MQPrint("š Program Halted š", 28) LOCATE 6, 12, 0: CALL MQPrint("the /SET extension as this extension happens to be used", 31) LOCATE 7, 12, 0: CALL MQPrint("by the program to configure certain run time routines.", 31) LOCATE 9, 26, 0: CALL MQPrint("Press any key to continue.", 27) DO: LOOP WHILE INKEY$ = "" COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END END END IF ComLineFiles$ = "*." + TheExt$ ComLineFiles$ = UCASE$(ComLineFiles$) IF ComLineFiles$ = "*.HLP" THEN COLOR 7, 0: LOCATE 1, 1, 1, 6, 7: CLS PRINT PRINT " <<< Error >>>" PRINT " " + STRING$(46, "Ä") PRINT " Files ending in .HLP are help files and as" PRINT " such, not usable for the BeeView Program." PRINT " š PRESS ANY KEY TO CONTINUE š" PRINT CALL Chime(6) DO: LOOP WHILE INKEY$ = "" END END IF There = Exist(ComLineFiles$) IF There = 0 THEN PRINT PRINT "Unable To Find Files With Extension Of : " + ComLineFiles$ PRINT END ELSEIF There = -1 THEN GOTO begin END IF '----------------------------------------------------------------------- QPCName.list: DATA January,February,March,April,May,June DATA July, August, September, October, November, December begin: NoFileExt% = 0 NumOnly = 0 'allow both letters and numbers CapsOn = 0 'don't automatically capitalize letters 'EditColor = 112 'use color 112 (black on white) while editing 'NormColor = 7 'restore the field to color 7 when done Count = FCount%(ComLineFiles$) 'first count the number of matching files DaCount = Count IF Count = 0 THEN GOTO stop.the.show N = Count 'save the count in N for later REDIM Array$(Count + 10) 'dim a string array to hold the file names ' Array$(0) = ComLineFiles$ 'put the file spec into element zero ' ' FOR X = 1 TO Count 'make room for the names Array$(X) = SPACE$(12) NEXT ' ' 'DIM Registers AS RegType ScrnSize = 4200 '25 lines * 80 = 2000 ' ' ReadFile VARPTR(Array$(0)) 'get the file names CALL SortStr(BYVAL VARPTR(Array$(1)), Count, 0) 'sort the file names ' ' CLS MonoCode% = 0 IF SetColor = 1 THEN 'BLOAD "c:\dos\program\bsv\b13view.bsv" CALL B13view(MonoCode%) File.Color% = 31: Hi.Light.Color% = 15 ELSEIF SetColor = 2 THEN 'BLOAD "c:\dos\program\bsv\b10view.bsv" CALL B10View(MonoCode%) File.Color% = 15: Hi.Light.Color% = 112 SetColor = 2 END IF Set.Color: IF SetColor = 1 THEN C112 = 112: C119 = 112: C121 = 121: C116 = 124: C113 = 112: C27 = 112 ELSEIF SetColor = 2 THEN C112 = 112: C119 = 112: C121 = 112: C116 = 112: C113 = 112 END IF LOCATE , , 0, 0, 0 begin% = 1: Initialize% = 0: OldScanCode% = 0 IF SetEncryption = 1 THEN GOSUB set.mode.colors LOCATE 2, 64, 0: CALL MQPrint("Encryption Mode:", trr) LOCATE 3, 68, 0: CALL MQPrint(" -ON- ", trr) END IF BottomColr% = SCREEN(25, 8, 1) IF Bsv.Color% = 7 OR Bsv.Color% = 10 OR Bsv.Color% = 11 THEN BottomColr% = 15 ELSEIF Bsv.Color% = 9 THEN BottomColr% = 95 ELSEIF Bsv.Color% = 2 THEN BottomColr% = 63 END IF BottLine$ = "F1>Help F2>Ed F3>Mode F4>New F5>Encrypt F6>Del F7>Ext F8>File F9>Sort F10>Print " CALL ClearScr0(25, 1, 25, 80, BottomColr%) LOCATE 25, 1, 0: CALL MQPrint(BottLine$, BottomColr%) IF SetEncryption = 1 THEN GOSUB encrypt SortItMan% = 0 END IF CALL CursorOff display.menu: DO LOCATE 1, 1, 0, 0, 0 '12 AMenu VARPTR(Array$(1)), begin%, Count, ScanCode%, File.Color%, Hi.Light.Color%, 12, 4, 4, 10, 11 ' ^ ^ ^ ^ ^ ^ ^ ' ³ ³ ³ ³ ³ ³ ³ ' File color ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ........ÄÄŁ ³ ³ ³ ³ ³ ³ ' Hilight color ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ................ÄÄŁ ³ ³ ³ ³ ³ ' Number of rows in table ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ..........................ÄÄÄÄŁ ³ ³ ³ ³ ' Number of columns in table ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ...........................ÄÄÄŁ ³ ³ ³ ' Number of spaces between columns ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ..........................ÄÄÄÄŁ ³ ³ ' Upper left row of display ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ..........................ÄÄÄÄÄÄŁ ³ ' Upper left column of display ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ...........................ÄÄÄÄÄÄÄÄŁ ' +-------------------------------------------------+ ' | If LockOn% = 1 then the useer must know: | ' | (1) the password and (2) 2 Lock Keys. | ' | If a hacker gets past the password but | ' | doesn't know Lock Keys, the program will | ' | absolutely lock up. | ' +-------------------------------------------------+ ' IF LockOnTrue% = 0 THEN IF LockOn% = 1 THEN IF ScanCode% = FirstLock% THEN LockOn% = 2 GOTO begin ELSE LockOn% = 1 GOTO begin END IF ELSEIF LockOn% = 2 THEN IF ScanCode% = SecondLock% THEN LockOn% = 0 LockOnTrue% = 1 GOTO begin ELSE LockOn% = 2 GOTO begin END IF END IF END IF 'Enter is pressed IF ScanCode% = 13 THEN IF SetEncryption = 1 THEN GOSUB encrypt END IF FileName$ = Array$(Count) GOSUB fullview IF SetEncryption = 1 THEN GOSUB encrypt END IF ScanCode% = 3 'Letters: A - Z or a - z ELSEIF ScanCode% >= 47 AND ScanCode% < 58 OR ScanCode% > 64 AND ScanCode% < 91 OR ScanCode% > 96 AND ScanCode% < 123 THEN IF ScanCode% > 96 AND ScanCode% < 123 THEN ScanCode% = ScanCode% - 32 END IF FOR zzz% = 0 TO DaCount FindLetr$ = QPLeft$(Array$(zzz%), 1) IF ASC(FindLetr$) = ScanCode% THEN IF FindLetr$ = QPLeft$(Array$(Count), 1) THEN Count = Count + 1 END IF IF FindLetr$ <> QPLeft$(Array$(Count), 1) THEN Initialize% = 0 END IF begin% = zzz% + Initialize% Initialize% = Initialize% + 1 Count = DaCount FindLetr$ = "" GOTO display.menu END IF NEXT ELSEIF ScanCode% = -71 THEN 'Home begin = 1 Count = DaCount GOTO display.menu ELSEIF ScanCode% = -79 THEN 'End begin = DaCount Count = DaCount GOTO display.menu ELSEIF ScanCode% = -59 THEN 'F1 MonoCode% = 0 DIM Scrn(4050) GOSUB save.screen IF SetColor = 2 THEN CALL BHelp15(MonoCode%) 'BLOAD "c:\dos\program\bsv\bhelp15.bsv" ELSE CALL BHelp14(MonoCode%) 'BLOAD "c:\dos\program\bsv\BHelp14.bsv" END IF DO: LOOP WHILE INKEY$ = "" GOSUB restore.screen ScanCode% = 3 ELSEIF ScanCode% = -60 THEN 'F2 LOCATE , , 1, 6, 7 FileName$ = "TextEdit.Set" There = Exist%(FileName$) IF There = 0 THEN GOSUB save.screen M = 1 GOSUB no.ed GOSUB restore.screen LOCATE , , 0, 0, 0 ScanCode% = 3 ELSEIF There = -1 THEN GOSUB save.screen OPEN "TextEdit.Set" FOR INPUT AS #10 LINE INPUT #10, WhatEditor$ CLOSE #10 SoEdit = Exist%(WhatEditor$) IF SoEdit = 0 THEN M = 2 GOSUB no.ed GOSUB restore.screen LOCATE , , 0 ScanCode% = 3 ELSEIF SoEdit = -1 THEN IF SetEncryption = 1 THEN GOSUB encrypt END IF BringEditor% = LoadExec%(WhatEditor$, Array$(Count)) IF SetEncryption = 1 THEN GOSUB encrypt END IF GOSUB restore.screen LOCATE , , 0 ScanCode% = 3 END IF END IF ScanCode% = 3 ELSEIF ScanCode% = -61 THEN 'F3 GOSUB set.mode.colors GOSUB encrypt.mode ScanCode% = 3 ELSEIF ScanCode% = -62 THEN 'F4 GOSUB new.file ScanCode% = 3 ELSEIF ScanCode% = -63 THEN 'F5 GOSUB add.an.encrypt ScanCode% = 3 ELSEIF ScanCode% = -64 THEN 'F6 GOSUB delete.file IF FCount%(ComLineFiles$) = 0 THEN GOSUB no.more.files END IF ScanCode% = 3 ELSEIF ScanCode% = -65 THEN 'F7 GOSUB save.screen GOSUB new.extension IF FCount%(ComLineFiles$) = 0 THEN GOSUB no.more.files ScanCode% = 3 END IF ScanCode% = 3 ELSEIF ScanCode% = -66 THEN 'F8 GOSUB copy.files IF FCount%(ComLineFiles$) = 0 THEN GOSUB no.more.files END IF ScanCode% = 3 ELSEIF ScanCode% = -67 THEN 'F9 IF SetEncryption = 1 THEN GOSUB encrypt END IF GOSUB sort.file ScanCode% = 3 ELSEIF ScanCode% = -68 THEN 'F10 GOSUB print.doc ScanCode% = 3 ELSEIF ScanCode% = 1 THEN 'Ctrl A GOSUB save.screen GOSUB address.book GOSUB restore.screen ScanCode% = 3 ELSEIF ScanCode% = 2 THEN 'Ctrl B GOSUB blank.it ScanCode% = 3 ELSEIF ScanCode% = 3 THEN GOSUB save.screen GOSUB calendar GOSUB restore.screen ScanCode% = 3 ELSEIF ScanCode% = 4 THEN 'Ctrl D GOSUB save.screen IF SetEncryption = 1 THEN GOSUB encrypt END IF DiaRun% = LoadExec("Diabetes.Exe", "Diabetes.Ref") IF SetEncryption = 1 THEN GOSUB encrypt END IF GOSUB restore.screen ScanCode% = 3 GOTO begin ELSEIF ScanCode% = 5 THEN 'Ctrl E EnCount = Count GOSUB save.screen CALL PaintBox0(13, 11, 15, 73, 8) CALL ClearScr0(12, 9, 14, 71, C112) CALL Box0(12, 10, 14, 70, 1, C112) LOCATE 13, 11: CALL MQPrint(" Do you want to Program Encrypt all the " + "*." + UCASE$(TheExt$) + " files", C112) LOCATE 13, 51: CALL MQPrint("*." + UCASE$(TheExt$), C121) LOCATE 13, 63: CALL MQPrint("(Y/N)?", C112) LOCATE 13, 64: CALL MQPrint("Y", C121) LOCATE 13, 66: CALL MQPrint("N", C121) EncAll% = FCount("*." + TheExt$) GOSUB key.code BackAll% = 1 IF K% = 89 OR K% = 121 THEN 'Y/y FOR X = 1 TO EncAll% + 1 GOSUB encrypt NEXT X = 0: BackAll% = 0 GOSUB restore.screen ScanCode% = 3 Count = EnCount GOTO display.menu 'N, n, Esc, Enter ELSEIF K% = 78 OR K% = 110 OR K% = 27 OR K% = 13 THEN GOSUB restore.screen Count = EnCount ScanCode% = 3 ELSE GOSUB restore.screen Count = EnCount ScanCode% = 3 END IF ScanCode% = 3 ELSEIF ScanCode% = 6 THEN 'Ctrl F GOSUB save.screen EnFile$ = RTRIM$(LTRIM$(Array$(Count))) CALL PaintBox0(13, 13, 15, 70, 8) CALL ClearScr0(12, 11, 14, 68, C112) CALL Box0(12, 12, 14, 67, 1, C112) LOCATE 13, 13: CALL MQPrint(" Do you want to Program Encrypt " + EnFile$, C112) LOCATE 13, 45: CALL MQPrint(EnFile$, C121) LOCATE 13, 60: CALL MQPrint("(Y/N)?", C112) LOCATE 13, 61: CALL MQPrint("Y", C121) LOCATE 13, 63: CALL MQPrint("N", C121) GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y/y GOSUB encrypt GOSUB restore.screen ScanCode% = 3 'N, n, Esc, Enter ELSEIF K% = 78 OR K% = 110 OR K% = 27 OR K% = 13 THEN GOSUB restore.screen ScanCode% = 3 ELSE GOSUB restore.screen ScanCode% = 3 END IF ScanCode% = 3 'view Beeview.Hlp: 'Ctrl H ELSEIF ScanCode% = 8 THEN FileName$ = "BeeView.Hlp" There = Exist%(FileName$) IF There = 0 THEN File = 1 GOSUB no.help.doc LOCATE , , 0, 0, 0 ScanCode% = 3 ELSEIF There = -1 THEN GOSUB fullview ScanCode% = 3 END IF ScanCode% = 3 ELSEIF ScanCode% = 12 THEN 'Ctrl L GOSUB save.screen WhatEnd$ = RIGHT$(RTRIM$(LTRIM$(Array$(Count))), 3) WhatEnd$ = UCASE$(WhatEnd$) IF WhatEnd$ <> "EXE" AND WhatEnd$ <> "COM" THEN CALL PaintBox0(13, 13, 15, 70, 8) CALL ClearScr0(12, 11, 14, 68, C112) CALL Box0(12, 12, 14, 67, 1, C112) LOCATE 13, 16 CALL MQPrint("Can only launch EXE or COM files. Press ", C112) DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restore.screen ScanCode% = 3 GOTO display.menu END IF IF WhatEnd$ = "EXE" OR WhatEnd$ = "COM" THEN TharTis% = LoadExec%(Array$(Count), " ") END IF GOSUB restore.screen ScanCode% = 3 'view programmer/author info P 'Ctrl P ELSEIF ScanCode% = 16 THEN GOSUB name.printer ScanCode% = 3 ELSEIF ScanCode% = 19 THEN 'Ctrl S GOSUB save.screen CLS : LOCATE 1, 1 CALL MQPrint("To Reenter BeeView, Type EXIT and press .", 14) LOCATE 2, 1, 1, 6, 7 SHELL GOSUB restore.screen ScanCode% = 3 ELSEIF ScanCode% = 20 THEN 'Ctrl T GOSUB text.editor ScanCode% = 3 ELSEIF ScanCode% = 22 THEN 'Ctrl V GOSUB text.viewer ScanCode% = 3 ELSEIF ScanCode% = -115 THEN ' IF LockOnTrue% = 1 OR PassWord% = 1 THEN 'Or <4 On Keypad> GOSUB access.password.box END IF ScanCode% = 3 ELSEIF ScanCode% = -30 THEN 'Alt A GOSUB smith.id ScanCode% = 3 ELSEIF ScanCode% = 27 THEN 'Esc COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END ELSE ScanCode% = 3 GOTO begin END IF ScanCode% = 3 LOOP lock.on: LockOn% = 1 ThereLock% = Exist%("Lock.Set") IF ThereLock% = -1 THEN CALL FileCrypt("Lock.Set", "Nardy", Oops%) OPEN "Lock.Set" FOR INPUT AS #1 LINE INPUT #1, PassW$ LINE INPUT #1, FirstLock$ LINE INPUT #1, SecondLock$ CLOSE #1 CALL FileCrypt("Lock.Set", "Nardy", Oops%) FirstLock% = QPValI%(QPTrim$(FirstLock$)) SecondLock% = QPValI%(QPTrim$(SecondLock$)) END IF IF PassW$ = "" OR ThereLock% = 0 THEN PassW$ = "BIGDOG" FirstLock% = -59 SecondLock% = -60 END IF RETURN pass.word: PassWord% = 1 ThereLock% = Exist%("Lock.Set") IF ThereLock% = -1 THEN CALL FileCrypt("Lock.Set", "Nardy", Oops%) OPEN "Lock.Set" FOR INPUT AS #1 LINE INPUT #1, PassW$ LINE INPUT #1, FirstLock$ LINE INPUT #1, SecondLock$ CLOSE #1 CALL FileCrypt("Lock.Set", "Nardy", Oops%) FirstLock% = QPValI%(QPTrim$(FirstLock$)) SecondLock% = QPValI%(QPTrim$(SecondLock$)) END IF IF PassW$ = "" OR ThereLock% = 0 THEN PassW$ = "BIGDOG" FirstLock% = -59 SecondLock% = -60 END IF COLOR 15, 1: CLS CALL PaintBox0(13, 16, 18, 69, 8) CALL ClearScr0(12, 14, 17, 67, 112) CALL Box0(12, 15, 17, 66, 2, 112) LOCATE 13, 19: CALL MQPrint("Enter Password Below -", 112) LOCATE 14, 19: CALL MQPrint("To exit now, press .", 112) EdW$ = "" CALL EditString(EdW$, 16, 26, 26, 30, 1, "", 1, 15, "", ExitCode%) IF ExitCode% = 27 THEN COLOR 7, 0: LOCATE 1, 1, 1, 6, 7: CLS : END ELSEIF ExitCode% = 13 THEN IF EdW$ = PassW$ THEN RETURN ELSEIF EdW$ <> PassW$ THEN CALL ClearScr0(13, 16, 16, 65, 112) LOCATE 13, 19, 0: CALL MQPrint("The password you entered is not correct!", 112) LOCATE 14, 19, 0: CALL MQPrint("To try again, press . To exit now,", 112) LOCATE 15, 19, 0: CALL MQPrint("press .", 112) CALL Chime(6) DO IF INKEY$ = CHR$(27) THEN COLOR 7, 0: LOCATE 1, 1, 1, 6, 7: CLS : END ELSEIF INKEY$ = CHR$(13) THEN GOTO pass.word END IF LOOP END IF ELSE GOTO pass.word END IF set.mode.colors: trr = SCREEN(2, 62, 1) IF trr = 121 THEN trr = 31 ELSEIF Bsv.Color% = 6 THEN trr = 63 ELSEIF Bsv.Color% = 12 THEN trr = 47 ELSEIF trr = 48 THEN trr = 63 ELSEIF trr = 7 THEN trr = 15 ELSEIF trr = 10 THEN trr = 79 ELSEIF trr = 113 THEN trr = 31 ELSEIF trr = 11 THEN trr = 15 ELSEIF Bsv.Color% = 0 OR Bsv.Color% = 1 THEN trr = 31 END IF RETURN encrypt.mode: GOSUB save.screen CALL PaintBox0(13, 12, 19, 72, 8) CALL ClearScr0(12, 10, 18, 70, C112) CALL Box0(12, 11, 18, 69, 1, C112) IF SetEncryption = 1 THEN LOCATE 13, 23: CALL MQPrint("Your current encryption mode is ON", C112) ELSEIF SetEncryption = 0 THEN LOCATE 13, 23: CALL MQPrint("Your current encryption is OFF", C112) END IF LOCATE 14, 11: CALL MQPrint("Ć" + STRING$(57, 196) + "“", C112) MessageS$ = " Make Selection - " LOCATE 15, 17: CALL MQPrint(MessageS$, C112) REDIM Message$(3) Message$(1) = "1. Turn Encryption Mode ON" Message$(2) = "2. Turn Encryption Mode OFF" Message$(3) = "3. Exit" CALL CMenu(Message$(), 15, 15, 37, C112, 15, 3, Choice%) CALL QPSound(100, 2) DO IF Choice% = 1 THEN '1 SetEncryption = 1 GOSUB restore.screen LOCATE 2, 64: CALL MQPrint("Encryption Mode:", trr) LOCATE 3, 68: CALL MQPrint(" -ON- ", trr) RETURN ELSEIF Choice% = 2 THEN '2 SetEncryption = 0 GOSUB restore.screen LOCATE 2, 64: CALL MQPrint("Encryption Mode:", trr) LOCATE 3, 69: CALL MQPrint("-OFF-", trr) RETURN ELSEIF Choice% = 3 THEN '3 GOSUB restore.screen RETURN END IF LOOP GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN encrypt: CurName$ = "" IF BackAll% = 1 THEN CurName$ = Array$(X) ELSEIF SortItMan% = 1 THEN IF TempCount > 0 THEN CurName$ = Array$(TempCount) TempCount = 0 ELSE CurName$ = SortName$ END IF ELSE CurName$ = Array$(Count) END IF IF NewFile$ <> "" THEN CurName$ = NewFile$ END IF REDIM FSpec$(10) FSpec$ = "ø†Ž~ĮĢŻÅ±½" CALL FileCrypt(CurName$, FSpec$, Oops%) IF Oops% = 1 THEN GOSUB save.screen COLOR 15, 1: CLS LOCATE 11, 15: CALL MQPrint("File Exceeds 20000 Lines - Too Big To Encrypt", 15) LOCATE 13, 15: CALL MQPrint("Press To Return", 15) DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN ELSEIF Oops% = 0 THEN 'LOCATE 14, 13: CALL MQPrint(STRING$(56, 255), 0) 'LOCATE 14, 20: CALL MQPrint("- - - Routine Successfully Completed - - -", 12) RETURN END IF print.doc: IF SetEncryption = 1 THEN GOSUB encrypt END IF FileName$ = Array$(Count) SearchTE = Exist%("Printer.set") IF SearchTE = 0 THEN OPEN "Printer.Set" FOR OUTPUT AS #7 PRINT #7, "PrintIt.Exe" CLOSE #7 END IF OPEN "Printer.Set" FOR INPUT AS #11 LINE INPUT #11, LookPrinter$ CLOSE #11 LookPrinter$ = RTRIM$(LTRIM$(LookPrinter$)) IF LookPrinter$ = "" THEN LookPrinter$ = "PrintIt.Exe" END IF There = Exist%(LookPrinter$) IF There = 0 THEN GOSUB save.screen CALL PaintBox0(13, 13, 18, 71, 1) CALL ClearScr0(12, 11, 17, 69, C112) CALL Box0(12, 12, 17, 68, 1, C112) LOCATE 13, 33: CALL MQPrint("<<< Error >>>", C121) LOCATE 14, 20: CALL MQPrint("Unable to find the " + CHR$(34) + LookPrinter$ + CHR$(34) + " program.", C112) LOCATE 15, 12: CALL MQPrint("Ć" + STRING$(55, 196) + "“", C112) LOCATE 16, 28: CALL MQPrint("Press To Continue.", C112) LOCATE 16, 35: CALL MQPrint("Esc", C121) CALL Chime(6) GOSUB press.esc GOSUB restore.screen RETURN ELSEIF There = -1 THEN GOSUB save.screen LoadPrnProg% = LoadExec%(LookPrinter$, FileName$) IF SetEncryption = 1 THEN GOSUB encrypt END IF GOSUB restore.screen RETURN END IF address.book: There = Exist%("addbook.Exe") IF There = 0 THEN CALL PaintBox0(13, 13, 18, 71, 8) CALL ClearScr0(12, 11, 17, 69, C112) CALL Box0(12, 12, 17, 68, 1, C112) LOCATE 13, 33: CALL MQPrint("<<< Error >>>", C121) LOCATE 14, 20: CALL MQPrint("Unable to find the " + CHR$(34) + "AddBook.Exe" + CHR$(34) + " program.", C112) LOCATE 15, 12: CALL MQPrint("Ć" + STRING$(55, 196) + "“", C112) LOCATE 16, 28: CALL MQPrint("Press To Continue.", C112) LOCATE 16, 35: CALL MQPrint("Esc", C121) CALL Chime(6) GOSUB press.esc RETURN ELSEIF There = -1 THEN LoadAddProg% = LoadExec%("addbook.exe", " ") RETURN END IF calendar: There = Exist%("calendar.Exe") IF There = 0 THEN CALL PaintBox0(13, 13, 18, 71, 8) CALL ClearScr0(12, 11, 17, 69, C112) CALL Box0(12, 12, 17, 68, 1, C112) LOCATE 13, 33: CALL MQPrint("<<< Error >>>", C121) LOCATE 14, 20: CALL MQPrint("Unable to find the " + CHR$(34) + "Calendar.Exe" + CHR$(34) + " program.", C112) LOCATE 15, 12: CALL MQPrint("Ć" + STRING$(55, 196) + "“", C112) LOCATE 16, 28: CALL MQPrint("Press To Continue.", C112) LOCATE 16, 35: CALL MQPrint("Esc", C121) CALL Chime(6) GOSUB press.esc RETURN ELSEIF There = -1 THEN LoadAddProg% = LoadExec%("calendar.exe", " ") RETURN END IF smith.id: GOSUB save.screen COLOR 15, 0: CLS SCREEN 0 WIDTH 80 COLOR 15, 0: CLS CALL Box0(7, 10, 16, 70, 1, 15) LOCATE 8, 13 CALL MQPrint("IDENTIFICATION OF AUTHOR. Hello! My name is Donald", 15) LOCATE 8, 13 CALL MQPrint("IDENTIFICATION OF AUTHOR", 14) LOCATE 9, 13 CALL MQPrint("Bernard Smith, and I am the author of the BeeView (v5.0)", 15) LOCATE 10, 13 CALL MQPrint("Program. I will not give my social security number,", 15) LOCATE 11, 13 CALL MQPrint("but for purposes of identification, my USMC military", 15) LOCATE 12, 13 CALL MQPrint("serial number is 1672175. Today's date is 02/10/2004.", 15) LOCATE 13, 13 CALL MQPrint("The BeeView Program is Public Domain FreeWare.", 15) LOCATE 15, 21 CALL MQPrint("Press To Return To The Main Menu.", 11) LOCATE 15, 28: CALL MQPrint("Esc", 15) LOCATE 1, 1, 0, 0, 0 CALL CursorOff DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restore.screen RETURN no.printer.set: CALL PaintBox0(13, 17, 19, 68, 8) CALL ClearScr0(12, 15, 18, 66, C112) CALL Box0(12, 15, 18, 66, 1, C112) Message1$ = "<<< ERROR >>>" Message2$ = "Unable To Find Printer Ķ " + WhatPrinter$ LOCATE 15, 23: CALL MQPrint(Message2$, C112) Message3$ = "Press " LOCATE 13, 34: CALL MQPrint(Message1$, C121) LOCATE 17, 35, 0, 0, 0: CALL MQPrint(Message3$, C121) CALL Chime(6) GOSUB press.esc RETURN name.printer: GOSUB save.screen SearchTE = Exist%("Printer.set") IF SearchTE = 0 THEN OPEN "Printer.Set" FOR OUTPUT AS #7 PRINT #7, "PrintIt.Exe" CLOSE #7 END IF OPEN "Printer.Set" FOR INPUT AS #7 LINE INPUT #7, SeePrinter$ CLOSE #7 CALL PaintBox0(13, 17, 19, 68, 8) CALL ClearScr0(12, 15, 18, 66, C112) CALL Box0(12, 15, 18, 66, 1, C112) Message1$ = "What Is The Name Of The Printer Program?" Message2$ = "(Include the extension. Example -> Prn.Exe)" LOCATE 13, 20: CALL MQPrint(Message1$, C112) LOCATE 14, 20: CALL MQPrint(Message2$, C112) CALL QPSound(150, 2) Row% = 16: col% = 34: FCol% = 34: LenStr% = 12: See% = 0 TypeOfText$ = "": Caps% = 1: Colr% = 15: FKey$ = "" EdW$ = SeePrinter$ LOCATE Row%, col%: CALL MQPrint(STRING$(LenStr%, " "), Colr%) LOCATE Row%, col%: CALL MQPrint(SeeEditor$, Colr%) CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) IF ExitCode% = 27 THEN GOSUB restore.screen RETURN END IF WhatPrinter$ = RTRIM$(LTRIM$(EdW$)) IF WhatPrinter$ = "" THEN WhatPrinter$ = "PrintIt.Exe" END IF NewPrinter% = Exist%(WhatPrinter$) IF NewPrinter% = 0 THEN GOSUB no.printer.set GOSUB restore.screen RETURN END IF OPEN "Printer.Set" FOR OUTPUT AS #5 PRINT #5, WhatPrinter$ CLOSE #5 GOSUB restore.screen RETURN text.editor: GOSUB save.screen SearchTE = Exist%("textedit.set") IF SearchTE = 0 THEN M = 1 GOSUB no.ed M = 0 GOSUB restore.screen RETURN END IF OPEN "TextEdit.Set" FOR INPUT AS #7 LINE INPUT #7, SeeEditor$ CLOSE #7 CALL PaintBox0(13, 16, 18, 69, 8) CALL ClearScr0(12, 14, 17, 67, C112) CALL Box0(12, 15, 17, 66, 1, C112) Message1$ = "What Is The Name Of The Text Editor?" Message2$ = "(Include the extension. Example -> Edit.Com)" LOCATE 13, 20: CALL MQPrint(Message1$, C112) LOCATE 14, 20: CALL MQPrint(Message2$, C112) CALL QPSound(150, 2) Row% = 16: col% = 34: FCol% = 34: LenStr% = 12: See% = 0 TypeOfText$ = "": Caps% = 1: Colr% = 15: FKey$ = "" EdW$ = SeeEditor$ LOCATE Row%, col%: CALL MQPrint(STRING$(LenStr%, " "), Colr%) LOCATE Row%, col%: CALL MQPrint(SeeEditor$, Colr%) CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) IF ExitCode% = 27 THEN GOSUB restore.screen RETURN END IF WhatEditor$ = RTRIM$(LTRIM$(EdW$)) NewTextEd = Exist%(WhatEditor$) IF NewTextEd = 0 THEN M = 2 GOSUB no.ed Ml = 0 GOSUB restore.screen RETURN END IF OPEN "TextEdit.Set" FOR OUTPUT AS #5 PRINT #5, WhatEditor$ CLOSE #5 GOSUB restore.screen RETURN no.ed: CALL PaintBox0(13, 17, 18, 68, 8) CALL ClearScr0(12, 15, 17, 66, C112) CALL Box0(12, 16, 17, 65, 1, C112) Message1$ = "<<< ERROR >>>" IF M = 2 THEN Message2$ = "Unable To Find Text Editor Ķ " + WhatEditor$ LOCATE 14, 20: CALL MQPrint(Message2$, C112) M = 0 ELSEIF M = 1 THEN Message2$ = "Unable To Find Companion File Ķ TextEdit.Set" LOCATE 14, 18: CALL MQPrint(Message2$, C112) M = 0 END IF Message3$ = "Press " LOCATE 13, 34: CALL MQPrint(Message1$, C121) 'LOCATE 14, 21: CALL MQPrint(Message2$, C112) LOCATE 16, 35, 0, 0, 0: CALL MQPrint(Message3$, C121) CALL Chime(6) GOSUB press.esc RETURN text.viewer: GOSUB save.screen SearchTE = Exist%("textview.set") IF SearchTE = 0 THEN M = 1 GOSUB no.viewer M = 0 GOSUB restore.screen RETURN END IF OPEN "TextView.Set" FOR INPUT AS #7 LINE INPUT #7, SeeViewer$ CLOSE #7 CALL PaintBox0(13, 16, 18, 69, 8) CALL ClearScr0(12, 14, 17, 67, C112) CALL Box0(12, 15, 17, 66, 1, C112) Message1$ = "What Is The Name Of The Text Viewer?" Message2$ = "(Include the extension. Example -> SeeBee.Exe)" LOCATE 13, 20: CALL MQPrint(Message1$, C112) LOCATE 14, 20: CALL MQPrint(Message2$, C112) CALL QPSound(150, 2) Row% = 16: col% = 34: FCol% = 34: LenStr% = 12: See% = 0 'show text TypeOfText$ = "": Caps% = 1: Colr% = 15: FKey$ = "" EdW$ = SeeViewer$ LOCATE Row%, col%: CALL MQPrint(STRING$(LenStr%, " "), Colr%) LOCATE Row%, col%: CALL MQPrint(SeeViewer$, Colr%) CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) IF ExitCode% = 27 THEN GOSUB restore.screen RETURN END IF WhatViewer$ = RTRIM$(LTRIM$(EdW$)) NewViewer% = Exist%(WhatViewer$) IF NewViewer% = 0 THEN M = 2 GOSUB no.viewer M = 0 GOSUB restore.screen RETURN END IF OPEN "TextView.Set" FOR OUTPUT AS #5 PRINT #5, WhatViewer$ CLOSE #5 GOSUB restore.screen RETURN no.viewer: CALL ClearScr0(13, 16, 16, 65, C112) Message1$ = "<<< ERROR >>>" IF M = 2 THEN Message2$ = "Unable To Find Text Viewer Ķ " + WhatViewer$ LOCATE 14, 20: CALL MQPrint(Message2$, C112) M = 0 ELSEIF M = 1 THEN Message2$ = "Unable To Find Companion File Ķ TextView.Set" LOCATE 14, 18: CALL MQPrint(Message2$, C112) M = 0 END IF Message3$ = "Press " LOCATE 13, 34: CALL MQPrint(Message1$, C121) 'LOCATE 14, 21: CALL MQPrint(Message2$, C112) LOCATE 16, 35, 0, 0, 0: CALL MQPrint(Message3$, C121) CALL Chime(6) GOSUB press.esc RETURN save.screen.2: REDIM ScrnArray%(2500) CALL ScrnSave(1, 1, 25, 80, SEG ScrnArray%(1), -1) RETURN restore.screen.2: CALL ScrnRest(1, 1, 25, 80, SEG ScrnArray%(1), -1) ERASE ScrnArray% RETURN key.code: DO key$ = INKEY$ LOOP UNTIL LEN(key$) > 0 K% = CVI(key$ + CHR$(0)) RETURN delete.file: GOSUB save.screen CurName$ = LEFT$(Array$(Count), 12) CurName$ = RTRIM$(LTRIM$(CurName$)) DesCount% = LineCount%(CurName$, SPACE$(5000)) CALL PaintBox0(13, 16, 18, 69, 8) CALL ClearScr0(12, 14, 17, 67, C112) CALL Box0(12, 15, 17, 66, 1, C112) DelMessage$ = "Delete : ? (Y/N)" LOCATE 14, 23: CALL MQPrint(DelMessage$, C112) LOCATE 14, 32: CALL MQPrint(CurName$, C121) CALL QPSound(100, 2) DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y LOCATE 16, 23: CALL MQPrint("Deleting " + CurName$ + CHR$(39) + "s " + STR$(DesCount%) + " lines.", C112) LOCATE 16, 32: CALL MQPrint(CurName$, C121) GOSUB destroy.file GOSUB restore.screen IF FCount%(ComLineFiles$) = 0 THEN GOSUB no.more.files RETURN ELSE GOTO begin END IF ELSEIF K% = 78 OR K% = 110 THEN 'N,n GOSUB restore.screen RETURN ELSEIF K% = 27 OR K% = 13 THEN 'esc/enter GOSUB restore.screen RETURN END IF LOOP destroy.file: REDIM ThrowAway$(DesCount%) OPEN CurName$ FOR INPUT AS #1 DO CountDaLines& = CountDaLines& + 1 LINE INPUT #1, ThrowAway$ LOOP UNTIL EOF(1) CLOSE #1 GOSUB encrypt.and.kill OPEN CurName$ FOR OUTPUT AS #1 FOR DestroyOne& = 1 TO DesCount% PRINT #1, STRING$(160, "X") NEXT CLOSE #1 CALL KillFile(CurName$) IF DOSError THEN PRINT "Fatal ERROR - A DOS Error Just Occurred. Press ." DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN END IF RETURN encrypt.and.kill: 'begin encryption and deleting here: pick.random.number: FOR xyz% = 1 TO 5 RANDOMIZE TIMER FOR R% = 1 TO 80 AAA$ = CHR$(INT(254 - 15 + 1) * RND + 15) A$ = A$ + AAA$ NEXT again: FOR xxx% = 1 TO LEN(A$) StripSpace$ = MID$(A$, xxx%, 1) 'Empty space/255 is empty/234 is ź/32 is spacebar/13 is carriage return IF StripSpace$ = " " OR StripSpace$ = CHR$(255) OR StripSpace$ = CHR$(234) OR StripSpace$ = CHR$(32) OR StripSpace$ = CHR$(13) THEN A$ = MID$(A$, 1, xxx% - 1) + "X" + MID$(A$, xxx + 1, LEN(A$) - xxx%) GOTO again END IF NEXT A$ = RTRIM$(LTRIM$(A$)) A$ = LEFT$(A$, 80) IF A$ = "" THEN A$ = STRING$(80, "X") END IF PassWord$ = A$ CALL FileCrypt(CurName$, PassWord$, Oops%) IF Oops% = 1 THEN RETURN END IF NEXT RETURN no.more.files: IF SetScreen = 1 THEN LOCATE 10, 11: CALL MQPrint(STRING$(12, " "), 17) ELSEIF SetScreen = 2 THEN LOCATE 10, 11: CALL MQPrint(STRING$(12, " "), 51) END IF CALL PaintBox0(12, 12, 19, 73, 8) CALL ClearScr0(11, 10, 18, 71, C112) CALL Box0(11, 11, 18, 70, 1, C112) CALL Box0(15, 14, 17, 34, 1, C112) Halt1$ = "***Program Halted***" Halt2$ = "No More Files Exist With Extension Of" Halt3$ = CHR$(195) + STRING$(58, 196) + CHR$(180) LOCATE 12, 32: CALL MQPrint(Halt1$, C121) LOCATE 13, 20: CALL MQPrint(Halt2$, C112) LOCATE 13, 58: CALL MQPrint("*." + Slash$, C121) LOCATE 14, 11: CALL MQPrint(Halt3$, C112) LOCATE 16, 17: CALL MQPrint("Please Select -", C112) LOCATE 15, 39: CALL MQPrint("< > Choose New Extension", C112) LOCATE 15, 40: CALL MQPrint("1", C121) LOCATE 16, 39: CALL MQPrint("< > Write New File", C112) LOCATE 16, 40: CALL MQPrint("2", C121) LOCATE 17, 39: CALL MQPrint("< > Exit ", C112) LOCATE 17, 40, 0, 0, 0: CALL MQPrint("3", C121) CALL Chime(6) DO GOSUB key.code IF K% = 27 OR K% = 51 THEN 'Esc or 3 GOTO begin ELSEIF K% = 49 THEN '1 NoFileExt% = 1 GOTO new.extension ELSEIF K% = 50 THEN '2 GOTO new.file END IF LOOP RETURN new.file: GOSUB save.screen CALL PaintBox0(13, 16, 18, 69, 8) CALL ClearScr0(12, 14, 17, 67, C112) CALL Box0(12, 15, 17, 66, 1, C112) LOCATE 13, 24: CALL MQPrint("Name Of New File -", C112) CALL QPSound(100, 2) Row% = 15: col% = 35: FCol% = 35: LenStr% = 12: TypeOfText$ = "" Caps% = 1: Colr% = 15: See% = 1 CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) DO IF ExitCode% = 27 THEN ReadTenEleven$ = SPACE$(1) CALL ReadScrn0(10, 11, ReadTenEleven$) IF ReadTenEleven$ = " " THEN GOSUB no.more.files END IF GOSUB restore.screen RETURN ELSEIF ExitCode% = 13 THEN NewFile$ = EdW$ FileName$ = "TextEdit.Set" There = Exist%(FileName$) IF There = 0 THEN M = 1 GOSUB no.ed LOCATE , , 0, 0, 0 ScanCode% = 3 GOSUB restore.screen RETURN ELSEIF There = -1 THEN OPEN "TextEdit.Set" FOR INPUT AS #9 LINE INPUT #9, WhatEditor$ CLOSE #9 ExistEd = Exist%(WhatEditor$) IF ExistEd = 0 THEN M = 2 GOSUB no.ed LOCATE , , 0 ScanCode% = 3 GOSUB restore.screen RETURN ELSEIF ExistEd = -1 THEN GoBro% = LoadExec%(WhatEditor$, NewFile$) IF SetEncryption = 1 THEN GOSUB encrypt NewFile$ = "" END IF END IF END IF LOCATE 1, 1, 0, 0, 0 IF FCount%(ComLineFiles$) = 0 THEN GOSUB restore.screen GOSUB no.more.files RETURN ELSE GOTO begin END IF END IF LOOP press.esc: DO DO EscKey$ = INKEY$ LOOP UNTIL LEN(EscKey$) > 0 EscKeyCode% = CVI(EscKey$ + CHR$(0)) IF EscKeyCode% = 27 THEN RETURN END IF LOOP fullview: 'IF SetColor% = 1 THEN ' Clr% = 31 'ELSEIF SetColor% = 2 THEN ' Clr% = 15 'END IF GOSUB save.screen OPEN "TextView.Set" FOR INPUT AS #6 LINE INPUT #6, NameViewer$ CLOSE #6 IF NameViewer$ = "" THEN NameViewer$ = "SeeBee.Exe" END IF IsSeeBee% = Exist%(NameViewer$) IF IsSeeBee% = 0 THEN CALL PaintBox0(13, 15, 19, 70, 8) CALL ClearScr0(12, 13, 18, 68, C112) CALL Box0(12, 14, 18, 67, 1, C112) LOCATE 13, 21: CALL MQPrint("Unable To Find Your Viewer: " + NameViewer$, C112) LOCATE 14, 14: CALL MQPrint("Ć" + STRING$(52, 196) + "“", C112) LOCATE 15, 21: CALL MQPrint("Press now to exit to menu. Once", C112) LOCATE 16, 21: CALL MQPrint("in the main menu, press to", C112) LOCATE 17, 21: CALL MQPrint("give the name of another viewer.", C112) CALL QPSound(100, 2) DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restore.screen RETURN END IF IF SetColor = 2 THEN LoadSB% = LoadExec%(NameViewer$, FileName$ + " /M") ELSE LoadSB% = LoadExec%(NameViewer$, FileName$) END IF GOSUB restore.screen RETURN new.extension: CALL PaintBox0(11, 16, 16, 69, 8) CALL ClearScr0(10, 14, 15, 67, C112) CALL Box0(10, 15, 15, 66, 1, C112) Message1$ = "** Change To New Extension **" Message2$ = "Enter New Extension (3 Letters Or Less)" Message3$ = "Enter New Extension :" LOCATE 11, 26: CALL MQPrint(Message1$, C121) LOCATE 12, 23: CALL MQPrint(Message2$, C112) LOCATE 14, 26: CALL MQPrint(Message3$, C112) CALL QPSound(100, 2) NewExt$ = " " extension.path: EdW$ = "" Row% = 14: col% = 50: FCol% = 50: See% = 1: Colr% = 15 LenStr% = 3: TypeOfText$ = "": Caps% = 1 CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) WhatItIs = FCount%("*." + EdW$) IF ExitCode% = 13 THEN NewExt$ = EdW$ IF NewExt$ = UCASE$("HLP") THEN GOSUB save.screen.2 CALL PaintBox0(11, 16, 16, 69, 8) CALL ClearScr0(10, 14, 15, 67, C112) CALL Box0(10, 15, 15, 66, 1, C112) Message1$ = "<<< Error >>>" Message2$ = "The HLP extension is used for help files" Message3$ = "and as such is unusable for BeeView." Message4$ = "Press Any Key To Continue" LOCATE 11, 34: CALL MQPrint(Message1$, C121) LOCATE 12, 21: CALL MQPrint(Message2$, C112) LOCATE 13, 21: CALL MQPrint(Message3$, C112) LOCATE 14, 28, 0, 0, 0: CALL MQPrint(Message4$, C121) CALL QPSound(100, 2) DO: LOOP WHILE INKEY$ = "" GOSUB restore.screen.2 GOTO new.extension ELSEIF NewExt$ = UCASE$("SET") THEN GOSUB save.screen.2 CALL PaintBox0(11, 16, 17, 69, 8) CALL ClearScr0(10, 14, 16, 67, C112) CALL Box0(10, 15, 16, 66, 1, C112) Message1$ = "<<< Error >>>" Message2$ = "The SET extension is used for certain" Message3$ = "run time routines of the program and" Message4$ = "as such is unusable for BeeView." Message5$ = "Press Any Key To Continue" LOCATE 11, 34: CALL MQPrint(Message1$, C121) LOCATE 12, 21: CALL MQPrint(Message2$, C112) LOCATE 13, 21: CALL MQPrint(Message3$, C112) LOCATE 14, 21: CALL MQPrint(Message4$, C112) LOCATE 15, 29, 0, 0, 0: CALL MQPrint(Message5$, C121) CALL QPSound(100, 2) DO: LOOP WHILE INKEY$ = "" GOSUB restore.screen.2 GOTO new.extension END IF GOTO continue.extension ELSEIF ExitCode% = 27 THEN 'GOSUB restore.screen ReadFirst$ = SPACE$(1) CALL ReadScrn0(10, 11, ReadFirst$) IF ReadFirst$ = " " THEN GOSUB no.more.files END IF GOSUB restore.screen ScanCode% = 3 RETURN END IF continue.extension: LenNewExt = LEN(NewExt$) NewExt$ = RIGHT$(NewExt$, LenNewExt) NewExt$ = "*." + NewExt$ There = Exist%(NewExt$) IF There = 0 THEN CALL ClearScr0(11, 16, 14, 65, C112) Message1$ = "<<< ERROR >>>" Message2$ = "Unable To find" Message3$ = "on current directory" Message4$ = "Try Again? (Y/N)" LOCATE 11, 34: CALL MQPrint(Message1$, C121) LOCATE 12, 20: CALL MQPrint(Message2$, C112) LOCATE 12, 35: CALL MQPrint(NewExt$, C112) LOCATE 12, 41: CALL MQPrint(Message3$, C112) LOCATE 14, 32, 0, 0, 0: CALL MQPrint(Message4$, C112) CALL Chime(6) DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y GOTO new.extension ELSEIF K% = 78 OR K% = 110 THEN 'N,n IF NoFileExt% = 1 THEN GOTO what ELSEIF NoFileExt% = 0 THEN GOTO begin END IF ELSEIF K% = 27 THEN 'esc IF NoFileExt% = 1 THEN GOTO what ELSEIF NoFileExt% = 0 THEN GOTO begin END IF END IF LOOP ELSEIF There = -1 THEN LenNewExtension = LEN(NewExt$) LenNewExtension = LenNewExtension - 2 NewExt$ = RIGHT$(NewExt$, LenNewExtension) NewExt$ = "/" + NewExt$ ComLineFiles$ = NewExt$ GOTO command.line.parameters END IF what: CALL ClearScr0(11, 16, 14, 65, C112) LOCATE 11, 35: CALL MQPrint("<<< Error >>>", C121) LOCATE 12, 19: CALL MQPrint("Unable to proceed without a file extension.", C112) LOCATE 13, 19: CALL MQPrint("Please choose: <1> Try New Extension", C112) LOCATE 14, 36: CALL MQPrint("<2> Exit Now", C112) CALL QPSound(200, 2) GOSUB key.code IF K% = 49 THEN '1 GOTO new.extension ELSEIF K% = 50 OR K% = 27 THEN '2 or Esc COLOR 7, 0: CLS : END END IF blank.it: GOSUB save.screen Message1$ = "SCREEN BLANKED TO PROTECT MONITOR. PRESS TO EXIT. " Message2$ = " <<< BeeView >>> " Row% = 3: col% = 12 Halt = 0 COLOR 0, 0, 0: CLS DO LOCATE Row%, col% + 1, 0, 0, 0 CALL Box0(Row% - 2, col% - 2, Row% + 1, col% + 59, 2, 7) CALL MQPrint(Message1$, 7) LOCATE Row% - 1, 32: CALL MQPrint(Message2$, 14) DO WHILE Halt < 270 EscKey$ = INKEY$ CALL Pause(1) IF EscKey$ = CHR$(27) THEN GOSUB restore.screen RETURN END IF Halt = Halt + 1 LOOP CALL ClearScr0(1, 1, 25, 80, 0) Row% = Row% + 3 IF Row% > 23 THEN Row% = 3 END IF Halt = 0 LOOP return.to.roost: GOSUB restore.screen ScanCode% = 3 RETURN add.an.encrypt: CurName$ = LEFT$(Array$(Count), 12) GOSUB save.screen CALL PaintBox0(11, 10, 19, 73, 8) CALL ClearScr0(10, 8, 18, 71, C112) CALL Box0(10, 9, 18, 70, 1, C112) Message1$ = "*** Encrypt Or Decrypt Routine ***" Message2$ = "This routine will encrypt/decrypt: " Message3$ = "If this file has already been encrypted, this step" Message4$ = "will give you an additional layer of encryption." Message5$ = "Proceed ? (Y/N)" line$ = "Ę" + STRING$(60, 205) + "µ" LOCATE 11, 23: CALL MQPrint(Message1$, C121) LOCATE 12, 9: CALL MQPrint(line$, C112) LOCATE 13, 15: CALL MQPrint(Message2$, C112) LOCATE 13, 50: CALL MQPrint(CurName$, C121) LOCATE 14, 15: CALL MQPrint(Message3$, C112) LOCATE 15, 15: CALL MQPrint(Message4$, C112) LOCATE 16, 9: CALL MQPrint(line$, C112) LOCATE 17, 30: CALL MQPrint(Message5$, C112) LOCATE 17, 42: CALL MQPrint("Y", C121) LOCATE 17, 44: CALL MQPrint("N", C121) CALL QPSound(100, 2) DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y GOTO encrypt.proceed ELSEIF K% = 78 OR K% = 110 THEN 'N,n EXIT DO ELSEIF K% = 27 THEN 'esc EXIT DO END IF LOOP GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN encrypt.proceed: CALL ClearScr0(11, 10, 17, 69, C112) Message1$ = "Give Password Below For :" Message2$ = " (1) The password is UPPER and lower case sensitive" Message3$ = " (2) Forget the password at your peril!" LOCATE 11, 19: CALL MQPrint(Message1$, C112) LOCATE 11, 46: CALL MQPrint(CurName$, C121) LOCATE 13, 10: CALL MQPrint(Message2$, C112) LOCATE 14, 10: CALL MQPrint(Message3$, C112) 'LOCATE 14, 11: CALL MQPrint(Message4$, C112) LOCATE 13, 11: CALL MQPrint("CAUTION:", C121) LOCATE 14, 11: CALL MQPrint("CAUTION:", C121) LOCATE 12, 9: CALL MQPrint("³", C112) LOCATE 12, 70: CALL MQPrint("³", C112) LOCATE 16, 9: CALL MQPrint("³", C112) LOCATE 16, 70: CALL MQPrint("³", C112) FSpec$ = " " Message3$ = STRING$(2, 255) encrypt.password: EditColor = 15: NormColor = 15 CapsOn = 0: Row% = 16: column% = 15 CALL Editor(FSpec$, Length, ScanCode%, NumOnly, CapsOn, NormColor, EditColor, Row%, column%) FSpec$ = LEFT$(FSpec$, Length) FSpec$ = QPTrim$(FSpec$) IF ScanCode% = 13 THEN 'CurName$ = LEFT$(Array$(Count), 12) CALL FileCrypt(CurName$, FSpec$, Oops%) IF Oops% = 1 THEN LOCATE 14, 13: CALL MQPrint(STRING$(56, 255), 0) LOCATE 14, 18: CALL MQPrint("File Exceeds 10000 Lines - Too Big To Encrypt", 12) CALL Chime(6) ELSEIF Oops% = 0 THEN LOCATE 16, 13: CALL MQPrint(STRING$(56, 255), 0) LOCATE 16, 20: CALL MQPrint("- - - Routine Successfully Completed - - -", 12) END IF CALL Pause(30) GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN ELSEIF ScanCode% = 27 THEN GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN ELSEIF LEN(FSpec$) = 54 THEN GOTO encrypt.password END IF ScanCode% = 1 GOTO encrypt.password sort.file: FileName$ = Array$(Count) SortNum% = 1: YesNumber$ = "" SortName$ = "": GuessFile$ = "": SortNumber$ = "" FOR XSpot% = 1 TO QPLen%(FileName$) DotDot$ = QPMid$(FileName$, XSpot%, 1) IF DotDot$ = "." THEN TheExtension$ = QPMid$(FileName$, XSpot% + 1, QPLen%(FileName$) - XSport%) EXIT FOR ELSE TheExtension$ = "TXT" END IF NEXT SortCount% = FCount%("sort*.*") IF SortCount% = 0 THEN SortName$ = "SORT1." + TheExtension$ ELSEIF SortCount% > 1 AND SortCount% < 100 THEN SortName$ = "SORT" + QPTrim$(STR$(SortCount% + 1)) + "." + TheExtension$ SortExist% = Exist%(SortName$) IF SortExist% THEN GOSUB save.screen CALL PaintBox0(13, 13, 15, 71, 8) CALL ClearScr0(12, 11, 14, 69, C112) CALL Box0(12, 12, 14, 68, 1, C112) LOCATE 13, 13: CALL MQPrint("A Sort File already exists with that name! Press .", C112) LOCATE 13, 63: CALL MQPrint("Esc", C121) CALL Chime(6) DO LOOP UNTIL INKEY$ = CHR$(27) GOSUB restore.screen ScanCode% = 3 RETURN END IF ELSEIF SortCount% > 99 THEN GOSUB too.many.sort.files ScanCode% = 3 RETURN END IF make.sort.box: GOSUB save.screen CALL PaintBox0(13, 13, 18, 71, 8) CALL ClearScr0(12, 11, 17, 69, C112) CALL Box0(12, 12, 17, 68, 1, C112) line1$ = CHR$(194) line2$ = CHR$(179) line3$ = CHR$(193) MessageF$ = " File To Sort:" MessageS$ = " Sort Name :" Message1$ = "Make Selection-" REDIM M$(4) M$(1) = "1. Ascending Order (A - Z)" M$(2) = "2. Descending Order (Z - A)" M$(3) = "3. Quit" LOCATE 12, 30: CALL MQPrint(line1$, C112) LOCATE 13, 30: CALL MQPrint(line2$, C112) LOCATE 14, 30: CALL MQPrint(line2$, C112) LOCATE 15, 30: CALL MQPrint(line2$, C112) LOCATE 16, 30: CALL MQPrint(line2$, C112) LOCATE 17, 30: CALL MQPrint(line3$, C112) IF SetColor = 1 THEN LOCATE 13, 13: CALL MQPrint(MessageF$, C27) LOCATE 15, 13: CALL MQPrint(MessageS$, C27) ELSEIF SetColor = 2 THEN LOCATE 13, 15: CALL MQPrint(MessageF$, 15) LOCATE 15, 15: CALL MQPrint(MessageS$, 15) END IF LOCATE 14, 17: CALL MQPrint(FileName$, C112) LOCATE 16, 17: CALL MQPrint(SortName$, C112) LOCATE 13, 33: CALL MQPrint(Message1$, C112) CALL QPSound(150, 2) IF Bsv.Color% = 11 THEN C15 = 112 ELSE C15 = 15 END IF CALL CMenu(M$(), 14, 14, 36, C112, C15, 3, Choice%) CALL QPSound(150, 2) DO IF Choice% = 1 THEN '1 LOCATE 16, 52: CALL MQPrint("- Wait -", 12) Dir = 0 WhichSort = 1 GOSUB sort.str CALL ClearScr0(13, 12, 16, 68, C112) CALL Box0(12, 11, 17, 69, 1, C112) M1$ = "*** Done ***" M2$ = "Ć" + STRING$(57, "Ä") + "“" M3$ = "Press to leave the sort routine." LOCATE 13, 33: CALL MQPrint(M1$, C121) LOCATE 13, 37: CALL MQPrint("Done", C121) LOCATE 14, 11: CALL MQPrint(M2$, C112) LOCATE 16, 22: CALL MQPrint(M3$, C112) LOCATE 16, 29: CALL MQPrint("Esc", C121) CALL QPSound(100, 3) GOSUB press.esc Array$(Count) = FileName$ GOSUB restore.screen GOTO begin ELSEIF Choice% = 2 THEN '2 LOCATE 16, 52: CALL MQPrint("- Wait -", 12) Dir = 1 GOSUB sort.str CALL ClearScr0(13, 12, 16, 68, C112) CALL Box0(12, 11, 17, 69, 1, C112) M1$ = "*** Done ***" M2$ = "Ć" + STRING$(57, "Ä") + "“" M3$ = "Press to leave the sort routine." LOCATE 13, 33: CALL MQPrint(M1$, C112) LOCATE 13, 37: CALL MQPrint("Done", C121) LOCATE 14, 11: CALL MQPrint(M2$, C112) LOCATE 16, 22: CALL MQPrint(M3$, C112) LOCATE 16, 29: CALL MQPrint("Esc", C121) CALL QPSound(100, 3) GOSUB press.esc Array$(Count) = FileName$ GOSUB restore.screen GOTO begin ELSEIF Choice% = 3 THEN '3 GOSUB restore.screen ScanCode% = 3 RETURN END IF LOOP sort.str: IF FileSize&(FileName$) > (FRE("") - 2000) THEN Message$ = " Not enough memory to sort this file. Press . " CALL ClearScr0(13, 13, 16, 67, 12) CALL Box0(13, 13, 16, 67, 2, 12) LOCATE 14, 35: CALL MQPrint("Oops!", 12) LOCATE 15, 14: CALL MQPrint(Message$, 12) Chime (6) GOSUB press.esc CLOSE GOTO begin END IF Lines = LineCount%(FileName$, SPACE$(4096)) 'count the number of lines REDIM SortA$(Lines) 'make an array to hold it OPEN FileName$ FOR INPUT AS #1 'read the file into an array Lines = 0 WHILE NOT EOF(1) Lines = Lines + 1 LINE INPUT #1, SortA$(Lines) SortA$(Lines) = QPTrim$(SortA$(Lines)) WEND Start = 1 'specify sorting the whole array Size = Lines SortStr2 VARPTR(SortA$(Start)), Size, Dir IF WhichSort = 2 THEN CLOSE RETURN END IF OPEN SortName$ FOR OUTPUT AS #2 FOR SortX = 1 TO Size OutFile$ = (QPLeft$(SortA$(SortX), 1000)) PRINT #2, OutFile$ NEXT CLOSE SortItMan% = 0 IF SetEncryption = 1 THEN TempCount = Count SortItMan% = 1 GOSUB encrypt END IF ERASE SortA$ RETURN column.sort: IF HeadFoot = 0 THEN HF = 66 IF HeadFoot = 3 THEN HF = 60 IF HeadFoot = 6 THEN HF = 54 IF Size = 0 THEN RETURN 'Column45 = 45 - 10 + LEN(SortA$(SortX)) 'IF Column45 < 1 THEN Column45 = 1 OPEN SortName$ FOR OUTPUT AS #2 column.print: DO IF HeadFoot > 0 THEN FOR BlankLines = 1 TO HeadFoot PRINT #2, STRING$(20, 255) NEXT END IF BlankLines = 0 StartSorting = 1 + SortX FOR SortX = StartSorting TO HF + SortX StrikeKey$ = INKEY$ IF StrikeKey$ = CHR$(27) THEN SortX = 0: SomeSort = 0: CLOSE : ERASE SortA$: RETURN END IF IF SortX >= Size THEN SortX = 0: SomeSort = 0: CLOSE : ERASE SortA$: RETURN END IF SortA$(SortX) = LEFT$(SortA$(SortX), 35) IF SortX + HF <= Size THEN OutFile$ = STRING$(10, 255) + SortA$(SortX) + STRING$((35 - LEN(SortA$(SortX))), 255) + SortA$(SortX + HF) PRINT #2, OutFile$ ELSEIF SortX + HF > Size THEN SubSort = SubSort + 1 IF SortX + HF - SubSort < Size THEN OutFile$ = STRING$(10, 255) + SortA$(SortX) + STRING$((35 - LEN(SortA$(SortX))), 255) + SortA$(SortX + HF - SubSort) PRINT SortX, "HF"; HF, SubSort, SortX + HD - SubSort PRINT #2, OutFile$ ELSEIF SortX + HD - SubSort >= Size THEN SetSort = 1 END IF ELSEIF SetSort = 1 THEN OutFile$ = STRING$(10, 255) + SortA$(SortX) PRINT #2, OutFile$ END IF NEXT SomeSort = 0 IF HeadFoot > 0 THEN FOR BlankLines = 1 TO HeadFoot PRINT #2, STRING$(20, 255) NEXT END IF BlankLines = 0 LOOP UNTIL SortX >= Size SortX = 0: SomeSort = 0: CLOSE : ERASE SortA$: RETURN too.many.sort.files: GOSUB save.screen IF Bsv.Color% = 10 OR Bsv.Color% = 10 THEN Ops75 = 11: Ops78 = 14: Ops79 = 15 ELSE Ops75 = 75: Ops78 = 78: Ops79 = 79 END IF CALL PaintBox0(13, 12, 19, 72, 8) CALL ClearScr0(12, 10, 18, 70, C79) CALL Box0(12, 11, 18, 69, 1, C79) LOCATE 13, 16: CALL MQPrint("*** Oops! *** The " + WhatFile$ + " routine will only allow", Ops79) LOCATE 13, 16: CALL MQPrint("*** Oops! ***", Ops78) LOCATE 14, 16: CALL MQPrint("a maximum of 99 SORT files. Delete some of them", Ops79) LOCATE 15, 16: CALL MQPrint("by using or rename them <4>.", Ops79) LOCATE 15, 26: CALL MQPrint("F6", Ops75) LOCATE 15, 46: CALL MQPrint("F8", Ops75) LOCATE 15, 51: CALL MQPrint("4", Ops75) LOCATE 16, 11: CALL MQPrint("Ć" + STRING$(57, 196) + "“", Ops79) LOCATE 17, 29: CALL MQPrint("Press To Continue.", Ops79) LOCATE 17, 36: CALL MQPrint("Esc", Ops78) CALL Chime(6) DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB restore.screen RETURN no.help.doc: GOSUB save.screen.2 File$ = "BeeView.Hlp" CALL PaintBox0(12, 16, 17, 69, 8) CALL ClearScr0(11, 14, 16, 67, C112) CALL Box0(11, 15, 16, 66, 1, C112) Message1$ = "<<< ERROR >>>" Message2$ = "Unable To Find Help File -> " + CHR$(34) + File$ + CHR$(34) Message3$ = "Press " LOCATE 12, 34: CALL MQPrint(Message1$, C121) LOCATE 13, 21: CALL MQPrint(Message2$, C112) LOCATE 15, 35, 0, 0, 0: CALL MQPrint(Message3$, C112) LOCATE 15, 42, 0, 0, 0: CALL MQPrint("Esc", C121) CALL Chime(6) GOSUB press.esc GOSUB restore.screen.2 ScanCode% = 3 RETURN save.screen: REDIM SaveScrnArray%(2500) CALL ScrnSave0(1, 1, 25, 80, SEG SaveScrnArray%(1)) RETURN restore.screen: CALL ScrnRest0(1, 1, 25, 80, SEG SaveScrnArray%(1)) LOCATE , , 0, 0, 0 ERASE SaveScrnArray% RETURN stop.the.show: 'BLOAD "c:\dos\program\bsv\bhalt5.bsv" CALL BHalt5(MonoCode%) LOCATE 1, 1, 0, 0, 0 GOSUB key.code IF K% = 27 THEN CLS : LOCATE , , 1, 6, 7: END ELSEIF K% = 13 THEN SetScreen% = 2 SetColor% = 2 ELSE GOSUB key.code END IF FileName$ = "BeeView.Hlp" GOSUB fullview CLS : LOCATE , , 1, 6, 7: END access.password.box: GOSUB save.screen GOSUB make.box.and.color.it access.password.box.two: LOCATE 13, 14: CALL MQPrint(" LOCK KEYS ROUTINE", C112) LOCATE 14, 14: CALL MQPrint("To Access This Routine You Must Enter Password:", C112) CALL EditString(EdW$, 16, 23, 23, 30, 1, "", 1, 15, "", ExitCode%) IF ExitCode% = 27 THEN GOSUB restore.screen RETURN ELSEIF EdW$ = "" THEN GOSUB restore.screen RETURN ELSEIF EdW$ = PassW$ THEN CALL ClearScr0(13, 11, 17, 70, C112) LOCATE 14, 14: CALL MQPrint("Password Is Correct. Now type in your new password:", C112) CALL EditString(EdW$, 16, 23, 23, 30, 1, "", 1, 15, "", ExitCode%) IF EdW$ = "" THEN GOSUB restore.screen RETURN ELSEIF EdW$ <> "" THEN PassW$ = EdW$ ELSEIF ExitCode% > 0 THEN GOSUB restore.screen RETURN ELSE GOSUB restore.screen RETURN END IF Twice = 0 GOTO two.key.presses ELSEIF EdW$ <> PassW$ THEN CALL ClearScr0(13, 11, 17, 70, C112) LOCATE 15, 19: CALL MQPrint("Password incorrect. Press to return", C112) LOCATE 16, 19: CALL MQPrint("to menu or press to try again.", C112) DO DO PW$ = INKEY$ LOOP UNTIL LEN(PW$) > 0 PW% = CVI(PW$ + CHR$(0)) IF PW% = 27 THEN GOSUB restore.screen RETURN ELSEIF PW% = 13 THEN CALL ClearScr0(13, 11, 17, 70, C112) GOTO access.password.box.two END IF LOOP ELSE GOTO access.password.box.two END IF two.key.presses: CALL ClearScr0(13, 11, 17, 70, C112) LOCATE 13, 16, 0: CALL MQPrint("To fix your Lock Keys, please press two keys or", C112) LOCATE 14, 16, 0: CALL MQPrint(" key combinations.", C112) two.key.presses.next: DO TryLock$ = INKEY$ LOOP UNTIL LEN(TryLock$) > 0 IF ASC(TryLock$) = 0 THEN TryLock% = -ASC(RIGHT$(TryLock$, 1)) ELSE TryLock% = ASC(TryLock$) END IF Twice = Twice + 1 IF Twice = 1 THEN FirstLock% = TryLock% LOCATE 16, 14, 0: CALL MQPrint("First Key Set. Press Again Please.", C112) FirstLock% = TryLock% GOTO two.key.presses.next ELSEIF Twice = 2 THEN LOCATE 16, 28, 0: CALL MQPrint(" Second Key Also Set. Press .", C112) SecondLock% = TryLock% DO: LOOP UNTIL INKEY$ = CHR$(27) OPEN "Lock.Set" FOR OUTPUT AS #1 PRINT #1, PassW$ PRINT #1, STR$(FirstLock%) PRINT #1, STR$(SecondLock%) CLOSE #1 CALL FileCrypt("Lock.Set", "Nardy", Oops%) GOSUB restore.screen RETURN END IF make.box.and.color.it: CALL PaintBox0(13, 12, 19, 73, 8) CALL Box0(12, 10, 18, 71, 1, C112) CALL ClearScr0(13, 11, 17, 70, C112) RETURN copy.files: GOSUB save.screen copy.files.2: CurName$ = LEFT$(Array$(Count), 12) CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) CurName$ = LEFT$(Array$(Count), 12) MessageS$ = " Make Selection - " LOCATE 13, 13: CALL MQPrint(MessageS$, C112) REDIM Message$(6) Message$(1) = "1. Make Copy Of: " + CurName$ Message$(2) = "2. Complete Backup Of " + "*." + UCASE$(TheExt$) + " Files" Message$(3) = "3. Import File" Message$(4) = "4. Rename: " + CurName$ Message$(5) = "5. Exit" copy.files.3: IF Bsv.Color% = 11 THEN C15 = 112 ELSE C15 = 15 END IF CALL CMenu(Message$(), 13, 13, 33, C112, C15, 5, Choice%) CALL QPSound(100, 2) DO 'GOSUB key.code IF Choice% = 1 THEN '1 GOSUB copy.one GOTO begin ELSEIF Choice% = 2 THEN '2 CALL ClearScr0(13, 11, 17, 70, C119) GOSUB backup.baby RETURN ELSEIF Choice% = 3 THEN '3 GOTO import.file ELSEIF Choice% = 4 THEN '4 GOSUB rename.da.file GOTO begin ELSEIF Choice% = 5 THEN '5 GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN ELSEIF Choice% > 5 THEN 'esc EXIT DO END IF LOOP GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN rename.da.file: CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) Message1$ = "*** Rename File ***" Message2$ = "Below Give New Filename For:" Message3$ = "" LOCATE 13, 31: CALL MQPrint(Message1$, C112) LOCATE 14, 21: CALL MQPrint(Message2$, C112) LOCATE 14, 52, 0, 0, 0: CALL MQPrint(Array$(Count), C121) edit.name: Row% = 16: col% = 17: FCol% = 17: Colr% = 15 LenStr% = 49: TypeOfText$ = "": Caps% = 1: See% = 1 CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) 'Dest$ = EdW$ ReNameFile$ = EdW$ IF ExitCode% = 27 THEN GOSUB restore.screen RETURN ELSEIF ExitCode% = 13 THEN GOTO rename.file END IF CALL Chime(1) ScanCode% = 1 GOTO edit.name rename.file: CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) LOCATE 13, 16 CALL MQPrint("Old Name : New Name :", C112) LOCATE 13, 27: CALL MQPrint(CurName$, C121) LOCATE 13, 56: CALL MQPrint(ReNameFile$, C121) LOCATE 14, 11 ReNameLine$ = CHR$(195) + STRING$(58, 196) + CHR$(180) CALL MQPrint(ReNameLine$, C112) LOCATE 15, 24 CALL NameFile(CurName$, ReNameFile$) IF DOSError THEN LOCATE 15, 24: CALL MQPrint("Error In Creating New File Name!", C112) CALL Chime(6) ELSE LOCATE 15, 24: CALL MQPrint("ReName Task Completed Successfully", C112) END IF LOCATE 16, 11: CALL MQPrint(ReNameLine$, C112) LOCATE 17, 30: CALL MQPrint("Press To Continue", C112) LOCATE 17, 37, 0, 0, 0: CALL MQPrint("Esc", C121) GOSUB press.esc GOSUB restore.screen IF FCount%(ComLineFiles$) = 0 THEN GOSUB no.more.files RETURN ELSE RETURN END IF copy.one: CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) Message$ = "Give Drive, Path And Name To Copy :" LOCATE 13, 26: CALL MQPrint(Message$, C112) LOCATE 14, 35: CALL MQPrint(CurName$, C121) copy.one.path: Row% = 16: col% = 15: FCol% = 15: See% = 1 LenStr% = 50: TypeOfText$ = "": Caps% = 1: Colr% = 15 CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) IF ExitCode% = 13 THEN GOTO continue.copy.one ELSEIF ExitCode% = 27 THEN GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 EdW$ = "" RETURN END IF continue.copy.one: PresentColr% = SCREEN(1, 1, 1) CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) line$ = CHR$(195) + STRING$(58, 196) + CHR$(180) LOCATE 14, 11: CALL MQPrint(line$, C112) LOCATE 16, 11: CALL MQPrint(line$, C112) LOCATE 13, 15: CALL MQPrint("Name Of Copy File:", C112) LOCATE 13, 36: CALL MQPrint(EdW$, C121) LOCATE 15, 24 COLOR 0, 7 IF SetEncryption = 1 THEN GOSUB encrypt END IF CALL FCopy(CurName$, EdW$, SPACE$(5000), ErrCode%) IF DOSError THEN LOCATE 15, 26: CALL MQPrint("Oops! A DOS Error Just Occurred", C112) ELSE LOCATE 15, 26: CALL MQPrint("1 file copied", C112) END IF LOCATE 17, 30: CALL MQPrint("Press To Continue", C112) LOCATE 17, 37, 0, 0, 0: CALL MQPrint("Esc", C121) GOSUB press.esc GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 RETURN import.file: CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) Message1$ = "Give Drive And Path Of File To Import:" Message2$ = "(Wildcards * ? Not Accepted)" Message3$ = STRING$(2, 255) LOCATE 13, 23: CALL MQPrint(Message1$, C112) LOCATE 14, 27: CALL MQPrint(Message2$, C112) import.file.path: Row% = 16: col% = 15: FCol% = 15: Colr% = 15 LenStr% = 52: TypeOfText$ = "": Caps% = 1: See% = 1 CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) FSpec$ = EdW$ IF ExitCode% = 13 THEN GOTO continue.import.file ELSEIF ExitCode% = 27 THEN GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 NewFSpec$ = "" RETURN END IF continue.import.file: IF DOSError OR FSpec$ = "" THEN GOSUB Dos.Error DO DO ImportKey$ = INKEY$ LOOP UNTIL LEN(ImportKey$) > 0 ImportKey% = CVI(ImportKey$ + CHR$(0)) IF ImportKey% = 89 OR ImportKey% = 121 THEN 'Y,y 'GOTO continue.import.file GOTO import.file 'N, n, esc ELSEIF ImportKey% = 78 OR ImportKey% = 110 OR ImportKey% = 27 THEN GOSUB restore.screen ScanCode% = 3 RETURN END IF LOOP END IF OldFSpec$ = FSpec$ FOR ReMoveIt = 1 TO LEN(FSpec$) SearchIt$ = QPMid$(FSpec$, ReMoveIt, 1) 'IF SearchIt$ = "\" OR SearchIt$ = ":" THEN IF SearchIt$ = "\" OR SearchIt$ = "#" THEN FOR ReMove = 1 TO LEN(FSpec$) Search$ = QPMid$(FSpec$, ReMove, 1) 'IF Search$ = "\" OR Search$ = ":" THEN IF Search$ = "\" OR Search$ = "#" THEN NewFSpec$ = RIGHT$(FSpec$, LEN(FSpec$) - ReMove) END IF NEXT FSpec$ = NewFSpec$ END IF NEXT There = Exist%(FSpec$) IF There = 0 THEN GOTO yes.import.file ELSEIF There = -1 THEN CALL ClearScr0(13, 12, 17, 69, C112) Message1$ = "WARNING :" Message2$ = "There is a file with the same" Message3$ = "name on the current directory!" Message4$ = "Overwrite? (Y/N)" LOCATE 13, 14: CALL MQPrint(Message1$, C121) LOCATE 13, 27: CALL MQPrint(Message2$, C112) LOCATE 14, 27: CALL MQPrint(Message3$, C112) LOCATE 16, 27, 0, 0, 0: CALL MQPrint(Message4$, C112) CALL Chime(6) DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y CALL KillFile(FSpec$) GOTO yes.import.file ELSEIF K% = 78 OR K% = 110 OR K% = 27 THEN 'N,n,esc EXIT DO END IF LOOP FSpec$ = "" GOTO copy.files.2 END IF yes.import.file: OldFiles = FCount%("*.*") CALL FCopy(OldFSpec$, FSpec$, SPACE$(4096), ErrCode%) NewFiles = FCount%("*.*") IF OldFiles = NewFiles THEN GOSUB Dos.Error DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y GOTO import.file ELSEIF K% = 78 OR K% = 110 OR K% = 27 THEN 'N,n,esc EXIT DO END IF LOOP GOSUB restore.screen ScanCode% = 3 LOCATE 1, 1, 0, 0, 0 FSpec$ = "" RETURN ELSEIF NewFiles > OldFiles THEN LOCATE 1, 1, 0, 0, 0 GOTO begin END IF GOSUB restore.screen ScanCode% = 3 LOCATE 1, 1, 0, 0, 0 FSpec$ = "" RETURN backup.baby: CALL PaintBox0(13, 12, 19, 73, 8) CALL ClearScr0(12, 10, 18, 71, C112) CALL Box0(12, 11, 18, 70, 1, C112) Source$ = "": Dest$ = "": CurrDir$ = "" OneInputNum = 0: TwoInputNum = 0 Message1$ = "Backup all Files. Press To Cancel." Message2$ = "Please Indicate The Drive And Path To Use For Backup -" Message3$ = "*." + UCASE$(TheExt$) Message4$ = "Backup" Message5$ = "Esc" LOCATE 13, 13: CALL MQPrint(Message1$, C112) LOCATE 14, 13: CALL MQPrint(Message2$, C112) LOCATE 13, 24: CALL MQPrint(Message3$, C121) LOCATE 13, 13: CALL MQPrint(Message4$, C121) LOCATE 13, 47: CALL MQPrint(Message5$, C121) backup.path: Row% = 16: col% = 15: FCol% = 15: Colr% = 15 LenStr% = 50: TypeOfText$ = "": Caps% = 1: See% = 1 CALL EditString(EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) Dest$ = EdW$ Dest$ = UCASE$(Dest$) Dest$ = QPTrim$(Dest$) IF Dest$ = "" THEN GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN END IF IF RIGHT$(Dest$, 1) <> "\" THEN Dest$ = Dest$ + "\" END IF Drive$ = CHR$(GetDrive%) Directory$ = Drive$ + ":" + GetDir$(Drive$) Directory$ = QPTrim$(Directory$) IF RIGHT$(Directory$, 1) <> "\" THEN Directory$ = Directory$ + "\" END IF IF Directory$ = Dest$ THEN LOCATE 16, 13: CALL MQPrint(STRING$(56, " "), 0) LOCATE 16, 14 CALL MQPrint("Cannot copy to the same directory! Try Again? (Y/N)?", 12) CALL Chime(6) DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y GOTO backup.path ELSEIF K% = 78 OR K% = 110 OR K% = 27 THEN 'N,n,esc EXIT DO END IF LOOP GOSUB restore.screen ScanCode% = 3 RETURN END IF IF ExitCode% = 13 THEN GOTO continue.backup ELSEIF ExitCode% = 27 THEN GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN END IF GOTO backup.path continue.backup: IF FRE("") > 4096 THEN BuffLen = 4096 '4096 bytes is sufficient ELSE BuffLen = FRE(0) - 100 - 512 'take all but a few bytes BuffLen = (BuffLen \ 512) * 512 'round to a multiple of 512 bytes END IF Buffer$ = SPACE$(BuffLen) 'this will be FCopy's file buffer BackAll% = 0 BackUpCount = FCount%("*." + TheExt$) X = 0 DO X = X + 1: BackAll% = 0 IF SetEncryption = 1 THEN BackAll% = 1 GOSUB encrypt END IF CALL FCopy(Array$(X), Dest$ + Array$(X), Buffer$, ErrCode) IF DOSError THEN IF SetEncryption = 1 THEN BackAll% = 1 GOSUB encrypt END IF GOSUB Dos.Error DO GOSUB key.code IF K% = 89 OR K% = 121 THEN 'Y,y GOTO backup.path ELSEIF K% = 78 OR K% = 110 OR K% = 27 THEN 'N,n,esc EXIT DO END IF LOOP GOSUB restore.screen BackAll% = 0 ScanCode% = 3 RETURN END IF LOCATE 16, 15: CALL MQPrint(STRING$(50, " "), 0) LOCATE 16, 13, 0, 0, 0 Message$ = " Now Copying -" CALL MQPrint(Message$, 15) LOCATE 16, 44, 0, 0, 0 CALL MQPrint(Array$(X), 14) CALL Pause(2) IF SetEncryption = 1 THEN BackAll% = 1 GOSUB encrypt END IF BackAll% = 0 LOOP UNTIL X = BackUpCount Buffer$ = "" 'free up the memory GOSUB restore.screen ScanCode% = 3 RETURN Dos.Error: LOCATE 16, 13: CALL MQPrint(STRING$(56, " "), 0) LOCATE 16, 14 CALL MQPrint("**Error** An Error Just Occurred! Try Again? (Y/N)?", 12) CALL Chime(6) RETURN SUB CMenu (M$(), Row%, TopRow%, col%, RegColr%, HiLiteColr%, MaxItems%, Choice%) ' +---------------------------------------------------------------------+ ' | CMenu means "Chico Menu". Chico means little or tiny in Spanish. | ' | I first developed this menu while revising PrintDoc.Bas, | ' | on 03/11/2002. This particular version of Chico Menu is designed | ' | to be used with the QuickPak Quick Library and the Pro Library for | ' | compiling. Chico Menu is a Public Domain FreeWare program by | ' | Don Smith, EMail: smithdonb@earthlink.net | ' +---------------------------------------------------------------------+ ' +--------------+------------------------------------------------------+ ' | M$() | REDIM M$(MaxItem% + 1). REDIM in main program. | ' +--------------+------------------------------------------------------+ ' | Row% | Row to place menu. Set Row% = 1 in main program | ' | | to always hi-light the first item. To allow the | ' | | menu to reenter on last hi-lighted item, do not | ' | | set the Row%. | ' | | | ' +--------------+------------------------------------------------------+ ' | TopRow% | TopRow% is same as Row%, except Row% will change. | ' +--------------+------------------------------------------------------+ ' | Col% | The column to place menu. | ' +--------------+------------------------------------------------------+ ' | RegColr% | RegColr% is the menu color stated as one number. | ' +--------------+------------------------------------------------------+ ' | HiLiteColr% | HiLiteColr% is color of hi-lighted menu item. | ' | | I usually set this to 15 (White on black). | ' +--------------+------------------------------------------------------+ ' | MaxItems% | The number of menu items. | ' +--------------+------------------------------------------------------+ ' | Choice% | Let Sub set Choice%. Do not set it with a number. | ' | | When the SUB exits the Choice% will be set to the | ' | | correct menu item choice. | ' +--------------+------------------------------------------------------+ 'loopdeloop: 'COLOR 15, 1: CLS 'Row% 'Let SUB set Row%. Do NOT set it with a number. 'TopRow% = 7 'TopRow% is first row of menu. 'Col% = 26 'Col% is menu column. 'RegColr% = 31 'RegColr% is one number of menu color. 'HiLiteColr% = 15 'HiLiteColr% is color of hi-lighted menu item. 'MaxItems% = 10 'Number of menu items. 'Choice% = 0 'Let Sub set Choice%. Do not set it with a number. IF Choice% = 0 THEN Row% = TopRow% END IF FOR xyz% = 1 TO MaxItems% LOCATE TopRow% - 1 + xyz%, col% + 1, 0 CALL MQPrint(M$(xyz%), RegColr%) NEXT LOCATE Row%, col% CALL MQPrint(" " + M$(Row% - TopRow% + 1) + " ", HiLiteColr%) DO DO K$ = INKEY$ LOOP UNTIL LEN(K$) > 0 K% = CVI(K$ + CHR$(0)) 'Remove next line if more that 9 choices Choice% = K% - 48 'Choice corresponds to K%= 49-57 (1-9) IF Choice% = 0 THEN Choice% = 10 IF K% = 13 THEN LOCATE Row%, col% CALL MQPrint(" " + M$(Row% - (TopRow% - 1)) + " ", RegColr%) Choice% = Row% - (TopRow% - 1) EXIT SUB ELSEIF K% = 27 THEN 'Press and exit 'COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END Choice% = MaxItems% EXIT SUB 'Remove next two lines if more than 10 items 'If not more than 10, adjust the numbers to fit. 0 = 34, 9 = 57 ELSEIF K% > 47 AND K% < 58 THEN '#0-9 IF Choice% > 0 AND Choice% < MaxItems% + 1 THEN Choice% = K% - 48 EXIT SUB END IF ELSEIF K% = 20480 THEN ' LOCATE Row%, col% CALL MQPrint(" " + M$(Row% - (TopRow% - 1)) + " ", RegColr%) Row% = Row% + 1 IF Row% = TopRow% + MaxItems% THEN Row% = TopRow% END IF LOCATE Row%, col% CALL MQPrint(" " + M$(Row% - (TopRow% - 1)) + " ", HiLiteColr%) ELSEIF K% = 18432 THEN ' LOCATE Row%, col% CALL MQPrint(" " + M$(Row% - (TopRow% - 1)) + " ", RegColr%) Row% = Row% - 1 IF Row% = (TopRow% - 1) THEN Row% = TopRow% + (MaxItems% - 1) END IF LOCATE Row%, col% CALL MQPrint(" " + M$(Row% - (TopRow% - 1)) + " ", HiLiteColr%) 'ELSEIF K% = 15104 THEN ' ' ' To use other keys, use the numbers below: ' ' = 15104. = 15360. = 15616. = 15872. ' ' = 16128. = 16384. = 16640. = 16896. ' ' = 17152. = 17408. ' ' Choice% = 101 ' EXIT SUB 'ELSEIF K% = 17408 THEN ' ' Choice% = 102 ' EXIT SUB END IF LOOP END SUB DEFSNG A-Z SUB EditString (EdW$, Row%, col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, ExitCode%) STATIC ' +---------------------------------------------------------------------+ ' | Explanation of SUB EditString : | ' | ----------------------------- | ' | EdW$ = The string to be edited. | ' | Row% = The row to begin the editing. | ' | Col% = The column to begin the editing. | ' | FCol% = The column of very first character to | ' | be edited. Should be the same 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 | ' | Colr% = Color of text must be one number representing | ' | both foreground and background. | ' | FKey$ = What F keys to enable. To enabled F keys 1, | ' | 5 and 10, FKey$ = "150" ("0" is F10). | ' | ExitCode% = 1 is F1 key | ' | ExitCode% = 2 is F2 key | ' | ExitCode% = 3 is F3 key | ' | ExitCode% = 4 is F4 key | ' | ExitCode% = 5 is F5 key | ' | ExitCode% = 6 is F6 key | ' | ExitCode% = 7 is F7 key | ' | ExitCode% = 8 is F8 key | ' | ExitCode% = 9 is F9 key | ' | ExitCode% = 10 is F10 key | ' | ExitCode% = 13 is ENTER key | ' | ExitCode% = 14 is Right Arrow -> | ' | ExitCode% = 15 is Left Arrow <- | ' | ExitCode% = 16 is Up Arrow | ' | ExitCode% = 17 is Down Arrow | ' | ExitCode% = 18 is TAB key | ' | ExitCode% = 27 is EXIT key | ' | | ' | Please include at the top of the routine DEFINT A-Z | ' +---------------------------------------------------------------------+ ' IF See% = 1 THEN LOCATE Row%, col%: CALL MQPrint(STRING$(LenStr%, " "), Colr%) ELSEIF See% = 0 THEN LOCATE Row%, col%: CALL MQPrint(EdW$, Colr%) END IF BkColr% = (Colr% AND 112) \ 16 ' begin.edit.line: DO LOCATE Row%, col%, 1, 6, 7 DO EdW$ = INKEY$ LOOP UNTIL LEN(EdW$) > 0 SlamKey% = CVI(EdW$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'chr$(32) to chr$255) IF TypeOfText$ = "" THEN GOSUB show.char ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, EdW$) > 0 THEN GOSUB show.char END IF END IF ELSEIF SlamKey% = 27 THEN 'Esc Key ExitCode% = 27 GOSUB get.string GOTO leave.sub ELSEIF SlamKey% = 19712 THEN 'Right Arrow col% = col% + 1 IF col% > FCol% + LenStr% - 1 THEN GOSUB get.string col% = FCol% 'ExitCode% = 14 'GOTO leave.sub ELSE LOCATE Row%, col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN 'Left Arrow col% = col% - 1 IF col% = FCol% - 1 OR col% < FCol% THEN GOSUB get.string col% = FCol% + LenStr% - 1 'ExitCode% = 15 'GOTO leave.sub END IF ELSEIF SlamKey% = 18432 THEN 'Up Arrow GOSUB get.string ExitCode% = 16 GOTO leave.sub ELSEIF SlamKey% = 20480 THEN 'Down Arrow GOSUB get.string: ExitCode% = 17 GOTO leave.sub ELSEIF SlamKey% = 13 THEN 'Enter GOSUB get.string ExitCode% = 13 GOTO leave.sub ELSEIF SlamKey% = 9 THEN 'Tab GOSUB get.string ExitCode% = 18 GOTO leave.sub ELSEIF SlamKey% = 8 THEN 'Back Space col% = col% - 1 IF col% = FCol% OR col% < FCol% THEN col% = FCol% END IF LOCATE Row%, col% CALL MQPrint(" ", Colr%) ELSEIF SlamKey% = 32 THEN 'Space Bar IF col% = FCol% + LenStr% THEN LOCATE Row%, FCo4l% col% = FCol% END IF LOCATE Row%, col% CALL MQPrint(" ", BkColr%) col% = col% + 1 ELSEIF SlamKey% = 21248 THEN 'Delete Key LenToSave = ((FCol% + LenStr%) - col%) - 1 SaveScr$ = SPACE$(LenToSave) CALL ReadScrn0(Row%, col% + 1, SaveScr$) LOCATE Row%, col% CALL MQPrint(SaveScr$ + " ", Colr%) ELSEIF SlamKey% = 18176 THEN 'Home Key col% = FCol% LOCATE Row%, col%, 1, 6, 7 ELSEIF SlamKey% = 20224 THEN 'End Key GOSUB get.string col% = FCol% + LEN(EdW$) LOCATE Row%, col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN 'Ctrl-Y LOCATE Row%, FCol% WipeOut$ = SPACE$(LenStr%) CALL MQPrint(WipeOut$, Colr%) ELSEIF SlamKey% > 1503 AND SlamKey% < 17409 THEN 'F1 - F10 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% = 10 GOSUB get.string GOTO leave.sub ELSE ExitCode% = VAL(IdentKey$) GOSUB get.string GOTO leave.sub END IF END IF END IF LOOP show.char: LOCATE Row%, col% IF Caps% > 0 THEN CALL MQPrint(UCASE$(EdW$), Colr%) ELSEIF Caps% = 0 THEN CALL MQPrint(EdW$, Colr%) END IF col% = col% + 1 IF col% = FCol% + LenStr% THEN col% = FCol% RETURN END IF RETURN get.string: EditLine$ = SPACE$(LenStr%) CALL ReadScrn0(Row%, FCol%, EditLine$) EdW$ = QPTrim$(EditLine$) RETURN leave.sub: END SUB DEFINT A-Z '----- Expand CHR$(9) TAB characters to the appropriate number of spaces FUNCTION ExpandTab$ (X$, NumSpaces) STATIC Count = InCount(X$, CHR$(9)) 'find number of Tab characters IF Count THEN 'are there any? 'make room for new string Work$ = SPACE$(QPLen%(X$) + 1 + (NumSpaces - 1) * Count) LSET Work$ = X$ + CHR$(0) 'put existing string in it ' and a char. 0 for later Where = 1 'set search position to 1 FOR X = 1 TO Count 'do each tab 'find the next Tab character Where = INSTR(Where, Work$, CHR$(9)) + 1 Length = Where - 2 'calc length of left part 'calc spaces to next tab stop Sp = Length + NumSpaces - (Length MOD NumSpaces) - Length 'insert the spaces IF Where > 1 THEN MID$(Work$, Where - 1) = SPACE$(Sp) + MID$(Work$, Where) NEXT 'assign the function looking ' for the char. 0 ExpandTab$ = LEFT$(Work$, INSTR(Work$, CHR$(0)) - 1) ELSE 'no tabs, just assign the ExpandTab$ = X$ ' function END IF END FUNCTION SUB FileCrypt (FileName$, PWord$, Oops%) STATIC Oops% = 0 PassWord$ = PWord$ 'don't actually change the password encrypt PassWord$, "ÄA2ńŽ," 'double encrypt the password copy L = LEN(PassWord$) 'remember the length of PassWord$ FOpen FileName$, Handle 'open the file for QuickPak binary IF DOSError% THEN EXIT SUB 'it's not there or drive door is open Size& = FileSize&(FileName$) BufSize& = 14000 LinesOfFile% = LineCount%(FileName$, SPACE$(5000)) IF LinesOfFile% > 20000 THEN Oops% = 1 EXIT SUB END IF IF Size& < BufSize& THEN BufSize& = Size& END IF BufSize& = BufSize& - (Size& MOD L) 'BufSize& = BufSize& - (FileSize& MOD L) 'LEN(Buffer$) must be an even ' multiple of LEN(PassWord$) IF BufSize& = 0 THEN 'it's a very small file, use 'BufSize = FileSize& ' FileSize& instead BufSize& = Size& END IF Buffer$ = SPACE$(BufSize&) 'create a buffer to hold the file Done& = 0 'Done& tracks how much we've done DO FGet Handle, Buffer$ 'get this portion of the file encrypt Buffer$, PassWord$ 'encrypt it FSeek Handle, Done& 'seek back to the start of this block FPut Handle, Buffer$ 'write out the encrypted data Done& = Done& + LEN(Buffer$) 'track what we've already done IF Size& - Done& < LEN(Buffer$) THEN 'IF FileSize& - Done& < LEN(Buffer$) THEN 'less than LEN(Buffer$) remains Buffer$ = "" 'this shouldn't be necessary 'Buffer$ = SPACE$(FileSize& - Done&) 'adjust buffer to what remains Buffer$ = SPACE$(Size& - Done&) END IF LOOP WHILE LEN(Buffer$) AND NOT DOSError% 'loop while there's still more to do ' and no errors have occurred FClose Handle 'close the file END SUB 'see ya later, oscillator SUB HorizMenu (Item$(), Row(), col(), MaxItems%, Items%, TempItems%, Colr%, HiLiteColr%, Hit%) FOR Items% = 1 TO MaxItems% LOCATE Row(Items%), col(Items%) CALL MQPrint(Item$(Items%), Colr%) NEXT TempCount% = TempCount% + 1 IF TempCount% = 1 THEN Items% = 1 ELSE Items% = TempItems% END IF DO LOCATE Row(Items%), col(Items%) CALL MQPrint(Item$(Items%), HiLiteColr%) DO Hit$ = INKEY$ LOOP UNTIL LEN(Hit$) > 0 Hit% = CVI(Hit$ + CHR$(0)) LOCATE Row(Items%), col(Items%) CALL MQPrint(Item$(Items%), Colr%) IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% = 13 THEN ' Hit% = Items% + 48 EXIT SUB ELSEIF Hit% = 19200 THEN ' Items% = Items% - 1 IF Items% < 1 THEN Items% = MaxItems% END IF ELSEIF Hit% = 19712 OR Hit% = 9 THEN ' / Items% = Items% + 1 IF Items% > MaxItems% THEN Items% = 1 END IF ELSEIF Hit% > 47 OR Hit% < 58 THEN EXIT SUB END IF LOOP END SUB FUNCTION KeyCode% STATIC DO K$ = INKEY$ LOOP UNTIL K$ <> "" KeyCode% = CVI(K$ + CHR$(0)) END FUNCTION FUNCTION Rand% (Hi%, Lo%) STATIC Rand% = RND * (Hi% - Lo%) + Lo% END FUNCTION SUB SpecChars (text$, HiBit) STATIC IF QPLen%(text$) THEN text$ = ExpandTab$(text$, 8) IF HiBit THEN LowASCII text$ 'clear the hi-bit RemCtrl text$, "" 'replace Ctrl characters with spaces END IF END IF END SUB SUB StuffBuffer (Cmd$) STATIC '----- Limit the string to 14 characters plus Enter ' and save the length. Work$ = LEFT$(Cmd$, 14) + CHR$(13) Length = LEN(Work$) '----- Set the segment for poking, define the buffer ' head and tail, and then poke each character. DEF SEG = 0 POKE 1050, 30 POKE 1052, 30 + Length * 2 FOR X = 1 TO Length POKE 1052 + X * 2, ASC(MID$(Work$, X)) NEXT END SUB