' +-------------------------------------------------------------------+ ' | | ' | - D e s t r o y . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | Destroy Program written on 07/01/2002 by Don Smith. Declared | ' | Public Domain and FreeWare. Destroy counts the number of lines | ' | in a file, then writes over each line with 160 X's and then | ' | deletes the file. Designed for ASCII text files, but it might | ' | work with other types of files but no guarentee. | ' | Requires Pro.Lib and Pdq.Lib (see below - Acknowledgements) | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | - 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. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | Compiling: | ' | --------- | ' | BC : Destroy | ' | LINK : Destroy /noe | ' | LIB : /seg:500 Pro Pdq | ' | | ' +-------------------------------------------------------------------+ ' | | ' | +--------------------+ | ' | | ACKNOWLEDGEMENTS | | ' | +--------------------+ | ' | A great assist in writing and compiling CC.BAS are two toolboxes | ' | originally from Crescent Software. They are: Pro.Lib and PDQ.Lib. | ' | 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 | ' | two 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. Another toolbox, the QuickScreen | ' | program, Qscr.Exe, which makes short work of converting a "BSaved"| ' | (.BSV) file into a linkable .OBJ file. | ' | | ' | 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 | ' +-------------------------------------------------------------------+ DEFINT A-Z '---------------------------------- DECLARE SUB AMenu (BYVAL address%, Start%, Count%, ScanCode%, FileColr%, HiLiteColr%, Rows%, Columns%, Spacing%, Row%, Column%) DECLARE SUB CMenu (M$(), Row%, Col%, RegColr%, HiLiteColr%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) DECLARE SUB Encrypt (Secret$, PassWord$) DECLARE SUB FClose (Handle) DECLARE SUB FileCrypt (FileName$, PWord$) DECLARE SUB FGet (Handle, Destination$) DECLARE SUB FileView (FileName$, Ky, Action, FVI AS ANY, SEG Array) DECLARE SUB FOpen (FileName$, Handle) DECLARE SUB FPut (Handle, Source$) DECLARE SUB FSeek (Handle, Offset&) DECLARE SUB LilString (EdW$, Row%, Col%, FCol%, LenStr%, TypeOfText$, Caps%, Colr%, ExitCode%) DECLARE SUB ReadFile (BYVAL address) '---------------------------------- DECLARE FUNCTION DOSError% () DECLARE FUNCTION Exist% (FileName$) DECLARE FUNCTION FCount% (FileSpec$) DECLARE FUNCTION FLof& (Handle) DECLARE FUNCTION LineCount% (FileName$, Buffer$) DECLARE FUNCTION LoadExec% (Work$, CmdLine$) DECLARE FUNCTION QPLen% (FileName$) DECLARE FUNCTION QPLeft$ (File$, Many%) DECLARE FUNCTION QPMid$ (Work$, Where%, HowMany%) DECLARE FUNCTION QPTrim$ (File$) DECLARE FUNCTION DOSError% () '---------------------------------- 'Use next four lines to make *.xxx files for practice purposes 'FOR Coco% = 65 TO 80 ' SHELL "copy" + " " + "printdoc.txt" + " " + CHR$(Coco%) + ".xxx" 'NEXT 'END ComLineFiles$ = COMMAND$ ComLineFiles$ = QPTrim$(ComLineFiles$) GOSUB try.extension IF try = -1 THEN GOTO leave END IF try = 0 begin: COLOR 15, 0: CLS COLOR 0, 7 LOCATE 1, 2 CALL MQPrint(" " + "Ś" + STRING$(74, "Ā") + "æ" + " ", 25) FOR MkScrn = 2 TO 24 LOCATE MkScrn, 2 CALL MQPrint(" " + "Ć" + STRING$(74, "Å") + "“" + " ", 25) NEXT LOCATE 25, 2 CALL MQPrint(" " + "Ą" + STRING$(74, "Į") + "Ł" + " ", 25) CALL PaintBox0(4, 21, 6, 63, 8) CALL ClearScr0(3, 19, 5, 61, 79) CALL Box0(3, 20, 5, 60, 2, 79) LOCATE 4, 23 CALL MQPrint("š D e s t r o y P r o g r a m š", 79) LOCATE 4, 23: CALL MQPrint("š", 75) LOCATE 4, 57: CALL MQPrint("š", 75) CALL PaintBox0(9, 12, 24, 71, 8) CALL ClearScr0(8, 10, 23, 69, 112) CALL Box0(8, 11, 23, 68, 1, 112) InfoMessage$ = "Press View File Destroy File(s)." line$ = CHR$(198) + STRING$(56, 205) + CHR$(181) LOCATE 9, 24: CALL MQPrint(" View File", 112) LOCATE 9, 25: CALL MQPrint("Enter", 113) LOCATE 9, 12: CALL MQPrint(" Select Ķ", 79) LOCATE 10, 24: CALL MQPrint(" Destroy Routine", 112) LOCATE 10, 25: CALL MQPrint("F1", 113) LOCATE 9, 46: CALL MQPrint(" Change Extension", 112) LOCATE 9, 47: CALL MQPrint("F5", 113) LOCATE 10, 46: CALL MQPrint(" Program Info", 112) LOCATE 10, 47: CALL MQPrint("F10", 113) LOCATE 11, 11, 0: CALL MQPrint(line$, 112) LOCATE 21, 11, 0: CALL MQPrint(line$, 112) LOCATE 22, 30, 0: CALL MQPrint("Press To Exit", 112) LOCATE 22, 37, 0: CALL MQPrint("Esc", 113) NoFileExt% = 0 NumOnly = 0 'allow both letters and numbers CapsOn = 0 'don't automatically capitalize letters Count = FCount%(ComLineFiles$) 'first count the number of matching files DaCount = Count 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 ReadFile VARPTR(Array$(0)) 'get the file names CALL SortStr(BYVAL VARPTR(Array$(1)), Count, 0) 'sort the file names LOCATE 1, 1, 0, 0, 0 begin% = 1 File.Color% = 63 Hi.Light.Color% = 15 display.menu: DO AMenu VARPTR(Array$(1)), begin%, Count, ScanCode%, 112, 15, 9, 4, 2, 12, 13 ' ^ ^ ^ ^ ^ ^ ^ ' ³ ³ ³ ³ ³ ³ ³ ' 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 ScanCode% = 13 THEN GOSUB save.screen GOSUB showoff GOSUB restore.screen ScanCode = 3 'Letters: A - Z or a - z ELSEIF 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 Count = Count + 1 IF FindLetr$ <> QPLeft$(Array$(Count), 1) THEN Initialize% = 0 END IF begin% = zzz% + Initialize% Initialize% = Initialize% + 1 Count = DaCount GOTO display.menu END IF NEXT ELSEIF ScanCode% = -79 THEN ' begin = DaCount Count = DaCount GOTO display.menu ELSEIF ScanCode% = -71 THEN ' begin = 1 Count = DaCount GOTO display.menu ELSEIF ScanCode% = -59 THEN ' GOTO destroy.files ScanCode = 3 ELSEIF ScanCode% = -63 THEN ' GOSUB input.extension GOTO begin ELSEIF ScanCode% = -68 THEN ' GOSUB save.screen GOSUB program.info GOSUB restore.screen ScanCode% = 3 'Leave/quit/abort ELSEIF ScanCode% = 27 THEN 'Esc GOTO leave ELSE ScanCode% = 3 END IF ScanCode% = 3 LOOP program.info: CALL PaintBox0(10, 14, 22, 67, 8) CALL ClearScr0(9, 12, 21, 65, 31) CALL Box0(9, 13, 21, 64, 2, 31) line$ = CHR$(199) + STRING$(50, CHR$(196)) + CHR$(182) LOCATE 10, 28: CALL MQPrint("* Program Information *", 27) LOCATE 10, 28: CALL MQPrint("*", 30) LOCATE 10, 50: CALL MQPrint("*", 30) LOCATE 11, 13: CALL MQPrint(line$, 31) LOCATE 19, 13: CALL MQPrint(line$, 31) LOCATE 20, 30: CALL MQPrint("Press To Exit", 27) LOCATE 20, 37: CALL MQPrint("Esc", 31) REDIM M$(63) M$(1) = "The Destroy program is a Public Domain, FreeWare " M$(2) = "program written by Don Smith on 07/01/2002 in " M$(3) = "QuickBASIC 4.5 and compiled with two libraries " M$(4) = "from Full Moon Software, Pro.Lib and PDQ.Lib. " M$(5) = SPACE$(49) M$(6) = "The purpose of the Destroy Program is to tear a " M$(7) = "designated file into little pieces and destroy " M$(8) = "it to such an extent that the material in the " M$(9) = "file will be, hopefully, unrecoverable. This " M$(10) = "will be accomplished in three steps (See Below): " ' 1 2 3 4 5 ' 12345678901234567890123456789012345678901234567890 ' M$(11) = SPACE$(49) M$(12) = "Step 1: The designated file is encrypted 100" M$(13) = "times with each encryption using a random pass- " M$(14) = "word of 80 characters in length. Each one of the" M$(15) = "80 password characters is a random ASCII charac-" M$(16) = "ter from 14 to 254, or 240 possibilities at each" M$(17) = "position. This means that every single one of " M$(18) = "100 encryptions is employing a random 80 charac-" M$(19) = "ter password. That password has a probability of" M$(20) = "240 X 240 X 240.....(eighty 240's). This is a " M$(21) = "hugh number: 261155596399066 followed by 176 " M$(22) = "zeros." M$(23) = SPACE$(49) M$(24) = "Step 2: The program then replaces all charac- " M$(25) = "ters of the now 100 times encrypted file with " M$(26) = "upper case X's. " M$(27) = SPACE$(49) M$(28) = "Step 3: The designed file is then erased. " M$(29) = SPACE$(49) M$(30) = " CAUTION! " M$(31) = " " + STRING$(7, "Ä") M$(32) = "This is a public domain program! DO NOT " M$(33) = "accept anything for granted. Use scratch " M$(34) = "files to try out everything. " M$(35) = SPACE$(49) M$(36) = " WARNING! " M$(37) = " " + STRING$(7, "Ä") M$(38) = "Warning #1: The author of the Destroy program " M$(39) = "does not guarantee nor warranty the program. " M$(40) = "In addition, the author accepts no liability " M$(41) = "for damages resulting from its use or misuse. " M$(42) = "Please read carefully the CAUTION given above! " M$(43) = "In opening and using the program, the computer " M$(44) = "user and/or programmer accepts the program in " M$(45) = "an " + CHR$(34) + "as is" + CHR$(34) + " condition and further the user and/or" M$(46) = "programmer accepts total responsibility for it " M$(47) = "and its use. " M$(48) = SPACE$(49) M$(49) = "Warning #2: You are directed to use scratch " M$(50) = "files to practice with previous to using the " M$(51) = "DESTROY program with regular files. Take the " M$(52) = "above CAUTION seriously. " M$(53) = SPACE$(49) M$(54) = "You are only free to use the DESTROY program " M$(55) = "these two warnings in mind! " M$(56) = SPACE$(49) M$(57) = " Author Information: " M$(58) = " " + STRING$(18, "Ä") M$(59) = "Author - Don Smith. The DESTROY program is a " M$(60) = " Public Domain, FreeWare program. " M$(61) = "Date: 07/01/2002. EMail: smithdonb@earthlink.net" M$(62) = SPACE$(49) LRow% = 12 LCol% = 15 RRow% = 18 RCol% = 64 MaxNum% = 49 FOR place% = 1 TO 6 LOCATE place% + LRow% - 1, LCol% CALL MQPrint(M$(place%), 31) NEXT LOCATE 18, 30: CALL MQPrint("Use <" + CHR$(24) + "> <" + CHR$(25) + "> Arrows", 30) LOCATE 18, 35: CALL MQPrint(CHR$(24), 31) LOCATE 18, 39: CALL MQPrint(CHR$(25), 31) Where% = 0 DO DO Press$ = INKEY$ LOOP UNTIL LEN(Press$) > 0 Press% = CVI(Press$ + CHR$(0)) IF Press% = 27 THEN Where% = 0 RETURN ELSEIF Press% = 20480 THEN 'DnArrow Where% = Where% + 1 IF Where% = 45 THEN CALL QPSound(200, 2) END IF ELSEIF Press% = 18432 THEN 'UpArrow Where% = Where% - 1 IF Where% = -1 THEN CALL QPSound(200, 2) END IF ELSEIF Press% = 20736 THEN 'PgDn Where% = Where% + (RRow% - LRow%) ELSEIF Press% = 18688 THEN 'PgUp Where% = Where% - (RRow% - LRow%) ELSEIF Press% = 20224 THEN 'End Where% = MaxNum% - 5 FOR ABC% = 1 TO 2 LOCATE LRow% + 3 + ABC%, LCol% CALL MQPrint(SPACE$(49), 31) NEXT ELSEIF Press% = 18176 THEN 'Home Where% = 0 END IF GOSUB place.down LOOP place.down: FOR PlaceDn% = 1 TO RRow% - LRow% IF PlaceDn% + Where% - 1 = MaxNum% + 1 THEN RETURN ELSE IF Where% > MaxNum% - 5 THEN Where% = MaxNum% - 5 ELSEIF Where% <= 0 THEN Where% = 0 END IF LOCATE PlaceDn% + LRow% - 1, LCol% Work$ = LEFT$(M$(PlaceDn% + Where%), RCol% - LCol%) Work$ = Work$ + SPACE$((RCol% - LCol%) - LEN(Work$)) CALL MQPrint(Work$, 31) END IF NEXT RETURN showoff: FileName$ = Array$(Count) TYPE FVInfo Colr AS INTEGER ULRow AS INTEGER ULCol AS INTEGER LRRow AS INTEGER LRCol AS INTEGER HorizOffset AS INTEGER LoPtr AS INTEGER FileHandle AS INTEGER EndOfFile AS INTEGER LineNumber AS LONG TabStop AS INTEGER FileSeek AS LONG FileOffset AS LONG END TYPE Top$ = STRING$(80, 255) 'Top1$ = " [Viewing File] " ' 4 1 3 4 5 7 ' 9 7 7 9 2 Top1$ = "[ ]" Top2$ = "Viewing File" Top3$ = "[ ]" Top4$ = "Top Line" Top5$ = "[ ]" Top6$ = "Top Line" Bot$ = STRING$(80, 255) Bot1$ = " [Quit] Esc [Move] " + CHR$(27) + " " + CHR$(24) + " " + CHR$(25) + " " + CHR$(26) + " PgUp PgDn Home End Tab Shift+Tab" ' 1 2 2 ' 4 1 9 Bot2$ = "[ ]" Bot3$ = "Quit" Bot4$ = "Esc" Bot5$ = "[ ]" Bot6$ = "Move" LOCATE 1, 1: CALL MQPrint(Top$, 112) LOCATE 1, 4: CALL MQPrint(Top1$, 112) LOCATE 1, 5: CALL MQPrint(Top2$, 112) LOCATE 1, 19: CALL MQPrint(FileName$, 112) LOCATE 1, 54: CALL MQPrint(Top3$, 112) LOCATE 1, 55: CALL MQPrint(Top4$, 112) CALL ClearScr0(2, 1, 24, 80, 0) LOCATE 25, 1: CALL MQPrint(Bot$, 112) LOCATE 25, 1: CALL MQPrint(Bot1$, 112) LOCATE 25, 5: CALL MQPrint(Bot2$, 112) LOCATE 25, 6: CALL MQPrint(Bot3$, 112) LOCATE 25, 13: CALL MQPrint(Bot4$, 112) LOCATE 25, 20: CALL MQPrint(Bot5$, 112) LOCATE 25, 21, 0, 0, 0: CALL MQPrint(Bot6$, 112) '----------------------------------------------------------------------- REDIM Array(1 TO 16384) 'set up the MANDATORY 32K buffer REDIM FVI(1) AS FVInfo '----------------------------------------------------------------------- FVI(1).Colr = 31 FVI(1).ULRow = 2 'window 1 FVI(1).ULCol = 1 FVI(1).LRRow = 24 FVI(1).LRCol = 80 FVI(1).TabStop = 8 Action = 1 File = 1 DO FileView FileName$, Ky, Action, FVI(1), SEG Array(1) TopLineNum$ = STR$(FVI(1).LineNumber) + " " Neg$ = LEFT$(TopLineNum$, 1) IF Neg$ = "-" THEN LenTopLineNum = LEN(TopLineNum$) - 1 TopLineNum$ = RIGHT$(TopLineNum$, LenTopLineNum) EndMessage$ = STRING$(34, "-") + "End Of File" + STRING$(35, "-") IF Ky = -80 OR Ky = -81 THEN REDIM BottArray%(100) CALL ScrnSave0(25, 1, 25, 80, SEG BottArray%(1)) CALL QPSound(150, 2) LOCATE 25, 1 CALL MQPrint(EndMessage$, 79) CALL Pause(2) CALL ScrnRest0(25, 1, 25, 80, SEG BottArray%(1)) ERASE BottArray% END IF ELSE LOCATE 1, 65, 0, 0, 0: CALL MQPrint(TopLineNum$, 112) END IF IF Ky = 9 THEN 'tab IF Both THEN FVI(1).HorizOffset = FVI(1).HorizOffset + 8 FVI(2).HorizOffset = FVI(2).HorizOffset + 8 ELSE FVI(File).HorizOffset = FVI(File).HorizOffset + 8 END IF Action = 2 END IF IF Ky = -15 THEN 'shift-tab IF Both THEN FVI(1).HorizOffset = FVI(1).HorizOffset - 8 IF FVI(1).HorizOffset < 0 THEN FVI(1).HorizOffset = 0 FVI(2).HorizOffset = FVI(2).HorizOffset - 8 IF FVI(2).HorizOffset < 0 THEN FVI(2).HorizOffset = 0 ELSE FVI(File).HorizOffset = FVI(File).HorizOffset - 8 IF FVI(File).HorizOffset < 0 THEN FVI(File).HorizOffset = 0 END IF Action = 2 END IF IF Ky = 27 THEN Ky = 0: Action = 5 FileView FileName$, Ky, Action, FVI(1), SEG Array(1) ERASE Array RETURN END IF LOOP try.extension: Count% = FCount%(ComLineFiles$) REDIM Array$(Count% + 10) Array$(0) = ComLineFiles$ FOR ReadItAll% = 1 TO Count% Array$(ReadItAll%) = SPACE$(12) NEXT CALL ReadFile(BYVAL VARPTR(Array$(0))) IF DOSError% = -1 THEN COLOR 15, 0: CLS LOCATE 1, 10: CALL MQPrint("ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ", 15) LOCATE 2, 10: CALL MQPrint("³ ***Error*** ³", 15) LOCATE 2, 35: CALL MQPrint("***Error***", 12) LOCATE 3, 10: CALL MQPrint("ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ“", 15) LOCATE 4, 10: CALL MQPrint("³ The error was probably caused by one of the following: ³", 15) LOCATE 5, 10: CALL MQPrint("³ (1) An extension/filename was not given as a parameter. ³", 15) LOCATE 6, 10: CALL MQPrint("³ (2) The extension/filename was typed incorrectly. ³", 15) LOCATE 7, 10: CALL MQPrint("³ (3) The extension/filename was not found on the current ³", 15) LOCATE 8, 10: CALL MQPrint("³ directory. ³", 15) LOCATE 9, 10: CALL MQPrint("ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ“", 15) LOCATE 10, 10: CALL MQPrint("³ Directions: For a group of files, enter DESTROY, followed³", 15) LOCATE 11, 10: CALL MQPrint("³ by a space, then an asterisk, then a period, and then a ³", 15) LOCATE 12, 10: CALL MQPrint("³ 1-3 character extension. For just one file, type the ³", 15) LOCATE 13, 10: CALL MQPrint("³ name of the file after typing in DESTROY. ³", 15) LOCATE 14, 10: CALL MQPrint("ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ“", 15) LOCATE 15, 10: CALL MQPrint("³ Example for a group of files ĶĶ DESTROY *.Txt ³", 15) LOCATE 16, 10: CALL MQPrint("³ Example for just one file ĶĶ DESTROY FileName.Ext ³", 15) LOCATE 15, 42: CALL MQPrint("ĶĶ", 14) LOCATE 16, 42: CALL MQPrint("ĶĶ", 14) LOCATE 17, 10: CALL MQPrint("ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ“", 15) LOCATE 18, 10: CALL MQPrint("³ DESTROY is a Public Domain FreeWare program written by ³", 15) LOCATE 19, 10: CALL MQPrint("³ Don Smith, a math/history teacher residing in Orange ³", 15) LOCATE 20, 10: CALL MQPrint("³ County, California, U.S.A. ³", 15) LOCATE 21, 10: CALL MQPrint("³ ³", 15) LOCATE 22, 10: CALL MQPrint("³ Today's Date : 07/01/2002 ³", 15) LOCATE 23, 10: CALL MQPrint("³ EMail : smithdonb@earthlink.net ³", 15) LOCATE 24, 10: CALL MQPrint("³ ³", 15) LOCATE 25, 10: CALL MQPrint("ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[PRESS ANY KEY TO CONTINUE]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ", 15) LOCATE 25, 27, 0: CALL MQPrint("PRESS ANY KEY TO CONTINUE", 11) Melody = 0: Throat = 0 DO Throat = Throat + 1 FOR Melody = 600 TO 1000 STEP 300 '150 SOUND Melody, Melody / 1000 '1000 NEXT FOR Melody = 1000 TO 600 STEP -150 '-200 SOUND Melody, Melody / 1000 '1000 NEXT LOOP UNTIL Throat = 2 try% = -1 DO: LOOP WHILE INKEY$ = "" RETURN END IF RETURN destroy.files: GOSUB save.screen CALL QPSound(150, 2) FileName$ = Array$(Count%) FileName$ = QPTrim$(FileName$) CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 31) CALL Box0(11, 14, 16, 64, 1, 31) MessageS$ = " Make Selection - " LOCATE 12, 16: CALL MQPrint(MessageS$, 79) Selection% = 1 Row% = 12 Col% = 36 RegColr% = 31 HiLiteColr% = 15 MaxItems% = 4 LenLine% = 20 SD% = 1 FOR CheckDot% = 1 TO LEN(ComLineFiles$) Dot$ = MID$(ComLineFiles$, CheckDot%, 1) IF Dot$ = "." THEN ComLineFiles$ = "*" + MID$(ComLineFiles$, CheckDot%, 4) ComLineFiles$ = RTRIM$(LTRIM$(ComLineFiles$)) END IF NEXT REDIM M$(MaxItems% + 1) M$(1) = "1. Destroy: " + FileName$ M$(2) = "2. Destroy All " + UCASE$(ComLineFiles$) + " Files" M$(3) = "3. Exit This Routine" M$(4) = "4. Exit Program" CALL CMenu(M$(), Row%, Col%, RegColr%, HiLiteColr%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) DO IF ExitCode% = 27 THEN GOTO leave END IF IF Selection% = 1 THEN '1 GOSUB destroy.one GOSUB restore.screen GOTO begin ELSEIF Selection% = 2 THEN '2 IF ComLineFiles$ = "*.*" THEN really = 0 GOSUB really IF really = 0 THEN GOTO begin ELSEIF really = 1 THEN really = 0 GOTO destroy.all.baby GOSUB restore.screen GOTO begin END IF ELSE really = 0 GOSUB really.dilly IF really = 0 THEN GOTO begin ELSEIF really = 1 THEN really = 0 GOTO destroy.all.baby GOSUB restore.screen GOTO begin END IF END IF ELSEIF Selection% = 3 THEN '3 GOSUB restore.screen ScanCode% = 3 GOTO begin ELSEIF Selection% = 4 THEN '4 GOTO leave END IF LOOP GOSUB restore.screen LOCATE 1, 1, 0, 0, 0 ScanCode% = 3 RETURN leave: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END make.noise: Melody = 100: Throat = 0 DO Throat = Throat + 1 FOR Melody = 600 TO 1000 STEP 300 '150 SOUND Melody, Melody / 1000 '1000 NEXT FOR Melody = 1000 TO 600 STEP -150 '-200 SOUND Melody, Melody / 1000 '1000 NEXT LOOP UNTIL Throat = 2 RETURN really: CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 79) CALL Box0(11, 14, 16, 64, 1, 79) LOCATE 12, 33: CALL MQPrint("***Caution***", 78) LOCATE 13, 16: CALL MQPrint("If you proceed, ALL the files on this directory", 79) LOCATE 13, 32: CALL MQPrint("ALL", 75) LOCATE 14, 16: CALL MQPrint("will be erased, except DESTROY.EXE. Do you", 79) LOCATE 15, 16: CALL MQPrint("wish to continue (Y/N)? Y for YES, or N for NO.", 79) LOCATE 15, 34: CALL MQPrint("Y", 75) LOCATE 15, 36: CALL MQPrint("N", 75) LOCATE 15, 41: CALL MQPrint("Y", 75) LOCATE 15, 55: CALL MQPrint("N", 75) GOSUB make.noise DO YN$ = INKEY$ IF YN$ = CHR$(27) THEN really = 0 RETURN ELSEIF YN$ = CHR$(89) OR YN$ = CHR$(121) THEN 'Y/y really = 1 RETURN ELSEIF YN$ = CHR$(78) OR YN$ = CHR$(110) THEN 'N/n really = 0 RETURN END IF LOOP really.dilly: CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 79) CALL Box0(11, 14, 16, 64, 1, 79) LOCATE 12, 33: CALL MQPrint("***Caution***", 78) LOCATE 13, 16: CALL MQPrint("If you proceed, ALL the files on this directory", 79) LOCATE 13, 32: CALL MQPrint("ALL", 75) LOCATE 14, 16: CALL MQPrint("with the extension " + UCASE$(ComLineFiles$) + " will be destroyed. You", 79) LOCATE 15, 16: CALL MQPrint("wish to continue (Y/N)? Y for YES, or N for NO.", 79) LOCATE 15, 34: CALL MQPrint("Y", 75) LOCATE 15, 36: CALL MQPrint("N", 75) LOCATE 15, 41: CALL MQPrint("Y", 75) LOCATE 15, 55: CALL MQPrint("N", 75) GOSUB make.noise DO YN$ = INKEY$ IF YN$ = CHR$(27) THEN really = 0 RETURN ELSEIF YN$ = CHR$(89) OR YN$ = CHR$(121) THEN 'Y/y really = 1 RETURN ELSEIF YN$ = CHR$(78) OR YN$ = CHR$(110) THEN 'N/n really = 0 RETURN END IF LOOP destroy.one: OnOrMore% = 0 CALL PaintBox0(12, 15, 18, 67, 8) CALL ClearScr0(11, 13, 17, 65, 31) CALL Box0(11, 14, 17, 64, 1, 31) line$ = CHR$(195) + STRING$(49, 196) + CHR$(180) LOCATE 13, 14: CALL MQPrint(line$, 31) LOCATE 15, 14: CALL MQPrint(line$, 31) LOCATE 12, 21: CALL MQPrint("Name Of Destroyed File: " + FileName$, 31) OPEN FileName$ FOR INPUT AS #1 DO CountDaLines& = CountDaLines& + 1 LINE INPUT #1, ThrowAway$ LOOP UNTIL EOF(1) CLOSE #1 GOSUB encrypt.and.kill OPEN FileName$ FOR OUTPUT AS #1 FOR DestroyOne& = 1 TO CountDaLines& PRINT #1, STRING$(160, "X") NEXT CLOSE #1 KILL FileName$ IF DOSError THEN LOCATE 14, 22: CALL MQPrint("Oops! A DOS Error Just Occurred", 30) ELSE LOCATE 14, 30: CALL MQPrint("1 file destroyed", 30) END IF LOCATE 16, 27: CALL MQPrint("Press To Continue", 31) LOCATE 16, 34, 0, 0, 0: CALL MQPrint("Esc", 27) DO: LOOP UNTIL INKEY$ = CHR$(27) CountAll% = FCount%(ComLineFiles$) REDIM Array$(CountAll%) Array$(0) = ComLineFiles$ FOR ReadItAll = 1 TO CountAll% Array$(ReadItAll) = SPACE$(12) NEXT CALL ReadFile(BYVAL VARPTR(Array$(0))) IF DOSError% = -1 THEN CALL PaintBox0(12, 15, 18, 67, 8) CALL ClearScr0(11, 13, 17, 65, 31) CALL Box0(11, 14, 17, 64, 1, 31) line$ = CHR$(195) + STRING$(50, 196) + CHR$(180) LOCATE 12, 35: CALL MQPrint("Problem!", 30) LOCATE 13, 15: CALL MQPrint("The program detects that there are no more files", 31) LOCATE 14, 15: CALL MQPrint("left in the current directory with an extension", 31) LOCATE 15, 15: CALL MQPrint("of " + ComLineFiles$ + ".", 31) LOCATE 15, 28: CALL MQPrint("Press to exit program, or", 31) LOCATE 16, 15: CALL MQPrint("press to type in another extension.", 31) LOCATE 15, 35: CALL MQPrint("Esc", 27) LOCATE 16, 22: CALL MQPrint("Enter", 27) GOSUB make.noise DO CC$ = INKEY$ IF CC$ = CHR$(27) THEN GOTO leave ELSEIF CC$ = CHR$(13) THEN GOSUB restore.screen GOSUB save.screen GOTO input.extension END IF LOOP END IF RETURN destroy.all.baby: OneOrMore% = 1 Source$ = ComLineFiles$ Count = FCount%(Source$) 'count the number of matching files IF DOSError THEN COLOR 14, 1: CLS : LOCATE 3, 20 CALL MQPrint("Unknown DOS Error - Press Any Key " + STR$(ERR), 30) GOSUB make.noise DO: LOOP WHILE INKEY$ = "": GOTO begin END IF IF Count = 0 THEN 'there were no matching files COLOR 14, 1: CLS : LOCATE 3, 20 CALL MQPrint("Unable to find matching files - Press Any Key", 30) GOSUB make.noise DO: LOOP WHILE INKEY$ = "" GOTO begin END IF REDIM DestroyArray$(0 TO Count) 'make an array to hold their names FOR X = 1 TO Count 'fill with spaces DestroyArray$(X) = SPACE$(12) NEXT DestroyArray$(0) = Source$ 'put the spec into element zero ReadFile VARPTR(DestroyArray$(0)) 'and use ReadFile to get them CALL SortStr(BYVAL VARPTR(DestroyArray$(1)), Count, 0) FOR YesSir% = 1 TO Count DestroyArray$(YesSir%) = QPTrim$(DestroyArray$(YesSir%)) IF DestroyArray$(YesSir%) = QPTrim$("DESTROY.EXE") THEN DestroyArray$(YesSir%) = "" END IF NEXT 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 CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 79) CALL Box0(11, 14, 16, 64, 1, 79) LOCATE 13, 34: CALL MQPrint("- Wait -", 79) FOR KillDaFile% = 1 TO Count EscapePlease$ = INKEY$ IF EscapePlease$ = CHR$(27) THEN CALL ClearScr0(12, 15, 15, 63, 79) LOCATE 13, 23: CALL MQPrint("Aborting Routine - Please Wait.", 79) CALL Pause(30) IF KillDaFile% >= Count THEN GOTO all.gone ELSE GOTO begin END IF END IF IF DestroyArray$(KillDaFile%) <> "" THEN OPEN DestroyArray$(KillDaFile%) FOR INPUT AS #1 DO CountDaLines& = CountDaLines& + 1 LINE INPUT #1, ThrowAway$ LOOP UNTIL EOF(1) CLOSE #1 GOSUB encrypt.and.kill OPEN DestroyArray$(KillDaFile%) FOR OUTPUT AS #1 FOR DestroyOne& = 1 TO CountDaLines& PRINT #1, STRING$(160, "X") NEXT CLOSE #1 KILL DestroyArray$(KillDaFile%) CALL ClearScr0(12, 15, 15, 63, 79) LOCATE 13, 19 CALL MQPrint("Shredding And Destroying (" + QPTrim$(STR$(KillDaFile%)) + "): " + DestroyArray$(KillDaFile%), 79) LOCATE 15, 27 CALL MQPrint("To Abort, Press ", 75) LOCATE 15, 44 CALL MQPrint("Esc", 79) END IF NEXT all.gone: IF FCount%(BackUpArray$) = 0 THEN CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 31) CALL Box0(11, 14, 16, 64, 1, 31) LOCATE 12, 16 CALL MQPrint("All " + ComLineFiles$ + " files have been destroyed. Since", 31) LOCATE 13, 16 CALL MQPrint(ComLineFiles$ + " is no longer a valid extension, to change", 31) LOCATE 14, 16 CALL MQPrint("to another extension, press , otherwise", 31) LOCATE 14, 45: CALL MQPrint("Enter", 27) LOCATE 15, 16 CALL MQPrint("to exit press .", 31) LOCATE 15, 31: CALL MQPrint("Esc", 27) CALL QPSound(150, 2) DO MM$ = INKEY$ IF MM$ = CHR$(27) THEN GOTO leave ELSEIF MM$ = CHR$(13) THEN GOTO input.extension END IF LOOP END IF input.extension: CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 31) CALL Box0(11, 14, 16, 64, 1, 31) LOCATE 12, 19: CALL MQPrint("Below type a 1 to 3 character extension:", 31) LOCATE 13, 19: CALL MQPrint("(To view ALL files in the current directory,", 27) LOCATE 13, 19: CALL MQPrint("(", 31) LOCATE 14, 19: CALL MQPrint("type a single asterisk *)", 27) LOCATE 14, 43: CALL MQPrint(")", 31) LOCATE 13, 62: CALL MQPrint(",", 31) LOCATE 15, 48: CALL MQPrint(STRING$(3, " "), 15) CALL QPSound(150, 2) EdW$ = "" Row% = 15 Col% = 48 FCol% = 48 LenStr% = 3 TypeOfText$ = "" Caps% = 1 Colr% = 15 ExitCode% = 0 CALL LilString(EdW$, Row%, Col%, FCol%, LenStr%, TypeOfText$, Caps%, Colr%, ExitCode%) EdW$ = QPTrim$(EdW$) IF ExitCode% = 27 THEN Count% = FCount%(ComLineFiles$) IF Count% <> 0 THEN GOTO begin END IF ELSEIF ExitCode% = 13 THEN IF EdW$ = "" THEN GOSUB save.screen CALL Box0(13, 24, 15, 57, 1, 79) LOCATE 14, 25, 0 CALL MQPrint(" May not input blank! ", 79) CALL Pause(20) GOSUB restore.screen GOTO input.extension ELSEIF EdW$ <> "" THEN GOSUB save.screen SaveComLine$ = ComLineFiles$ ComLineFiles$ = "*." + EdW$ ComLineFiles$ = QPTrim$(ComLineFiles$) Count% = FCount%(ComLineFiles$) IF Count% = 0 THEN CALL PaintBox0(12, 15, 17, 67, 8) CALL ClearScr0(11, 13, 16, 65, 31) CALL Box0(11, 14, 16, 64, 1, 31) LOCATE 12, 19 CALL MQPrint("Unable to find an extension of " + ComLineFiles$ + " on", 31) LOCATE 13, 19: CALL MQPrint("current directory. Press to exit", 31) LOCATE 14, 19: CALL MQPrint("program, or press to type in", 31) LOCATE 15, 19: CALL MQPrint("another extension.", 31) LOCATE 13, 46: CALL MQPrint("Esc", 27) LOCATE 14, 38, 0: CALL MQPrint("Enter", 27) CALL Chime(6) DO EE$ = INKEY$ IF EE$ = CHR$(27) THEN GOSUB restore.screen try = 0 ComLineFiles$ = SaveComLine$ GOTO begin ELSEIF EE$ = CHR$(13) THEN ComLineFiles$ = SaveComLine$ GOTO input.extension END IF LOOP END IF GOSUB restore.screen GOTO begin ELSE GOTO input.extension END IF END IF GOTO input.extension 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 encrypt.and.kill: 'begin encryption and deleting here pick.random.number: FOR XYZ% = 1 TO 100 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 carraige 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$ IF OneOrMore% = 1 THEN CALL FileCrypt(DestroyArray$(KillDaFile%), PassWord$) ELSEIF OneOrMore% = 0 THEN CALL FileCrypt(FileName$, PassWord$) END IF A$ = "": AAA$ = "": PassWord$ = "" NEXT RETURN SUB CMenu (M$(), Row%, Col%, RegColr%, HiLiteColr%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) ' +---------------------------------------------------------------------+ ' | CMenu means "Chico Menu". Chico means little or tiny in Spanish. | ' | I first developed this menu while revising PrintDoc.Bas, | ' | on 03/28/2002. This particular version of Chico Menu is designed | ' | to be used with the QuickPak Quick Library and the Pro Library for | ' | compiling. CMenu differs from ChicMenu (Chico Menu) in that it can | ' | (1) double space items if needed, (2) insert horizontal line(s) in | ' | the menu and (3) it is a real SUB. | ' +---------------------------------------------------------------------+ ' | 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, place | ' | | Row% above the loop. | ' +--------------+------------------------------------------------------+ ' | 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. | ' +--------------+------------------------------------------------------+ ' | LenLine% | Length of horizontal line. Example: M$(4) = "-" | ' +--------------+------------------------------------------------------+ ' | SD% | SD% = 1 (Menu is single spaced) | ' | | SD% = 2 (Menu is double spaced) | ' +--------------+------------------------------------------------------+ ' | Selection% | The Selection is always given as a number. | ' | | IMPORTANT. PLEASE READ -> Every menu item is counted| ' | | as a number, including horizontal lines, so take | ' | | that into consideration when trapping after the | ' | | SUB exits. All selections are counted as a number, | ' | | even letters. Letter E for example would be | ' | | Selection% = 5. If there were a horizontal line | ' | | above E, then Selection% = 6. | ' | | | ' | | CMenu.Bas self-reads the extreme left hand | ' | | character of each menu item, allowing the user | ' | | to press that number or letter. | ' | | | ' | | Example: M$(3) = "3. Utilities" | ' | | | ' | | Here, the "3" is the number read. When the user | ' | | presses "3", the SUB exits with Selection% = 3. | ' | | | ' | | Letters also may be used: | ' | | | ' | | Example: M$(3) = "C. Utilities" | ' | | | ' | | Here, the "C" is the letter read. When the user | ' | | presses "C", the SUB with the Selection% = 3. | ' | | | ' | | Selection% = 3 will become Selection% = 4 if | ' | | there exists a horizontal line above M$(3). | ' | | | ' +--------------+------------------------------------------------------+ ' | ExitCode% | ExitCode% is the last key pressed. is | ' | | ExitCode% = 27 and is ExitCode% = 13. | ' | | If an key were pressed, then ExitCode% should | ' | | be renamed as ExitCode% = 1 for , and | ' | | ExitCode% = 10 for . See explanation | ' | | below. | ' +--------------+------------------------------------------------------+ FOR Jefe% = 1 TO MaxItems% HotKey$ = HotKey$ + LEFT$(M$(Jefe%), 1) NEXT LetrOrNum% = 0 HotKey$ = UCASE$(HotKey$) IF Selection% = 0 THEN Selection% = 1 FindRow% = Row% FOR XYZ% = 1 TO MaxItems% LOCATE FindRow%, Col%, 0 IF LEFT$(M$(XYZ%), 1) = "-" THEN CALL MQPrint(STRING$(LenLine%, CHR$(196)), RegColr%) ELSE CALL MQPrint(" " + M$(XYZ%) + " ", RegColr%) END IF FindRow% = Row% + (XYZ% * SD%) NEXT DO LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 CALL MQPrint(" " + M$(Selection%) + " ", HiLiteColr%) DO K$ = INKEY$ LOOP UNTIL LEN(K$) > 0 K% = CVI(K$ + CHR$(0)) IF K% = 13 THEN ExitCode% = 13 EXIT SUB ELSEIF K% = 27 THEN 'Press and exit ExitCode% = 27 EXIT SUB 'K% = 27 K% = 122 is last letter, or "z". ELSEIF K% > 27 AND K% < 123 THEN IF K$ <> "-" THEN LetrOrNum% = INSTR(HotKey$, UCASE$(K$)) IF LetrOrNum% <> 0 THEN Selection% = LetrOrNum% ExitCode% = K% EXIT SUB END IF END IF ELSEIF K% = 20480 THEN ' GOSUB up.or.down ELSEIF K% = 18432 THEN ' GOSUB up.or.down ELSEIF K% = 15104 THEN ' ' To use other keys, use the numbers below: ' = 15104. = 15360. = 15616. = 15872. ' = 16128. = 16384. = 16640. = 16896. ' = 17152. = 17408. 'Use availibility of ExitCode% to rename = 1 and = 10 ExitCode% = 1 'F1> EXIT SUB ELSEIF K% = 17408 THEN ' ExitCode% = 10 EXIT SUB END IF LOOP up.or.down: LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 CALL MQPrint(" " + M$(Selection%) + " ", RegColr%) IF K% = 18432 THEN ' Selection% = Selection% - 1 IF Selection% = 0 THEN Selection% = MaxItems% IF M$(Selection%) = "-" THEN Selection% = Selection% - 1 END IF ELSEIF K% = 20480 THEN ' Selection% = Selection% + 1 IF Selection% > MaxItems% THEN Selection% = 1 IF M$(Selection%) = "-" THEN Selection% = Selection% + 1 END IF ELSE Selection% = LetrOrNum% END IF RETURN END SUB SUB FileCrypt (FileName$, PWord$) STATIC 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 FileSize& = FLof&(Handle) 'find how long the file is BufSize = 4096 '4096 evenly holds four sectors IF FileSize& < BufSize THEN 'but we can't use more than FileSize& BufSize = FileSize& 'so use that instead END IF 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 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 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 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 LilString (EdW$, Row%, Col%, FCol%, LenStr%, TypeOfText$, Caps%, Colr%, ExitCode%) STATIC ' +---------------------------------------------------------------------+ ' | Explanation of SUB LilString : | ' | ----------------------------- | ' | 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. | ' | 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. | ' | ExitCode% = 13 is ENTER key | ' | ExitCode% = 27 is EXIT key | ' | | ' | Please include at the top of the routine DEFINT A-Z | ' +---------------------------------------------------------------------+ ' LOCATE Row%, FCol% CALL MQPrint(STRING$(LenStr%, " "), Colr%) 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 Col% = FCol% 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 Col% = FCol% END IF ELSEIF SlamKey% = 13 THEN 'Enter GOSUB get.string ExitCode% = 13 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(" ", Colr%) Col% = Col% + 1 ELSEIF SlamKey% = 21248 THEN 'Delete Key SaveScr$ = "" FOR HoleStr% = Col% + 1 TO (FCol% + LenStr%) SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, HoleStr%)) NEXT LOCATE Row%, Col% CALL MQPrint(SaveScr$, Colr%) SaveScr$ = "" 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%) FOR EntireLine% = FCol% TO FCol% + LenStr% EditLine$ = EditLine$ + CHR$(SCREEN(Row%, EntireLine%)) NEXT EdW$ = EditLine$ RETURN leave.sub: END SUB