' +-------------------------------------------------------------------+ ' | IMPORTANT NOTE: This file actually contains the code of two | ' | QuickBASIC basic programs, the first is SecurePW.Bas which is the | ' | password program, and the second is ConfigPW.Bas which is the | ' | password configuration file. Therefore it will be necessary for | ' | you to split them into two files. The second file occurs after | ' | the double line at line #992. | ' +-------------------------------------------------------------------+ ' +-----------------------------------------------------+ ' | | ' | WARNING WARNING WARNING | ' | ------- ------- ------- | ' | When you load this program into QuickBASIC 4.5, you must also | ' | load QuickBASIC's quick library. So, at the prompt enter: | ' | | ' | QB /L QB.QLB SecurePW.Bas | ' | | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | | ' | S e c u r e P W . B a s | ' | ----------------------- | ' | | ' | (Public Domain FreeWare - 09/10/2007) | ' | | ' +-------------------------------------------------------------------+ ' | The SecurePW program is a small "light weight" password program. | ' | It is not world-strength National Security Agency secure, but it | ' | would be very difficult to break it and/or hack it. The SecurePW | ' | program first must be configured with the ConfigPW.Exe program | ' | which sets the password and saves it in a hidden file called | ' | P------W---" which has been double encrypted. SecurePW.Exe | ' | decrypts it and, if the password is correct, will exit allowing | ' | the user to continue. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +-------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a thirty-year retired teacher | ' |of Math/History/Spanish residing in Orange County, California. I | ' |am also a former six-year Sergeant of Marines. Who-Rah! On certain | ' |forums I am known as MarineDon.My email is: smithdonb@earthlink.net| ' | | ' +-------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +-------------------------------------------------------------------+ ' |Since this code is public domain and freeware, anyone may freely | ' |copy and distribute it. If you use the QuickBasic code in one of | ' |your own programs, you do not have to cite my name as the author, | ' |and you may even change its name. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | The SecurePW basic code and its four SUBs and one FUNCTiON were | ' | written by me, Don Smith, on 09/10/2007. It is a rewrite of a | ' | former program called Secure.Bas which required the use of two | ' | special libraries, Pro.Lib and PDQ.Lib. The reason for the | ' | rewrite was to set up a secure password program written solely | ' | in QuickBASIC 4.5. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | COMPILE INFORMATION: | ' +-------------------------------------------------------------------+ ' | | ' | BC: SecurePW | ' | LINK: SecurePW | ' | LIB: QB BCom45 | ' | | ' +-------------------------------------------------------------------+ tippy.top: ' Next 19 lines set up SUB GetFileAttributes and SUB InterruptX ' CID uses these SUBs to check the existence of a file (for more ' information, go to SUB GetFileAttributes) TYPE RegTypeX ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE ' DEFINT A-Z ' '------------------------------- CONST ESCAPE = 27 CONST ENTER = 13 CONST UpperY = 89 CONST LowerY = 121 CONST UpperN = 78 CONST LowerN = 110 CONST UpperP = 80 CONST LowerP = 112 CONST Ctrl.F1 = 24064 CONST ACCENT = 96 CONST ArrowDn = 20480 CONST ArrowUp = 18432 '------------------------------- DECLARE FUNCTION KeyCode% () '------------------------------- DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) DECLARE SUB Encrypt (PassWord$, X$) DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX) DECLARE SUB GetFileAttributes (fileName$, result%) '-------------------------------s begin: CALL GetFileAttributes("P------W.---", result%) IF result% > 0 THEN 'File does NOT exist GOTO no.password.file END IF opening.screen: COLOR 15, 1: CLS CALL BoxBoy("", 10, 11, 16, 69, 0, 0, 0, 0, 0, 7, 2, 1, 8, 1) CALL BoxBoy("", 13, 14, 15, 65, 0, 0, 0, 0, 0, 7, 1, 0, 0, 0) COLOR 0, 7 LOCATE 12, 14, 0, 0, 0: PRINT "Give Password Below:"; SOUND 100, 3 CALL GetFileAttributes("P------W.---", result%) IF result% = 0 THEN 'file does indeed exist OPEN "P------W.---" FOR INPUT AS #1 LINE INPUT #1, PWord$ LINE INPUT #1, Ky1$ LINE INPUT #1, Ky2$ LINE INPUT #1, Ky3$ CLOSE #1 Key1$ = Ky1$: Key2$ = Ky2$: Key3$ = Ky3$ '-------------Reverse password for PassW$-------- EncryptP2$ = CHR$(250) + CHR$(196) + CHR$(145) + CHR$(212) + CHR$(129) EncryptP1$ = CHR$(245) + CHR$(178) + CHR$(205) + CHR$(237) + CHR$(219) '-------------Reverse password for Key1$--------- Encrypt12$ = CHR$(246) + CHR$(192) + CHR$(149) + CHR$(207) + CHR$(224) Encrypt11$ = CHR$(252) + CHR$(185) + CHR$(212) + CHR$(244) + CHR$(228) '-------------Reverse password for Key2$--------- Encrypt22$ = CHR$(245) + CHR$(191) + CHR$(148) + CHR$(206) + CHR$(223) Encrypt21$ = CHR$(253) + CHR$(186) + CHR$(213) + CHR$(245) + CHR$(227) '-------------Reverse password for Key3$--------- Encrypt32$ = CHR$(244) + CHR$(190) + CHR$(147) + CHR$(205) + CHR$(222) Encrypt31$ = CHR$(255) + CHR$(188) + CHR$(215) + CHR$(247) + CHR$(229) '-------------Reverse encrypt PWord$------------- CALL Encrypt(EncryptP2$, PWord$) CALL Encrypt(EncryptP1$, PWord$) '-------------Reverse encrypt Key1$-------------- CALL Encrypt(Encrypt12$, Key1$) CALL Encrypt(Encrypt11$, Key1$) '-------------Reverse encrypt Key2$-------------- CALL Encrypt(Encrypt22$, Key2$) CALL Encrypt(Encrypt21$, Key2$) '-------------Reverse encrypt Key3$-------------- CALL Encrypt(Encrypt32$, Key3$) CALL Encrypt(Encrypt31$, Key3$) '------------------------------------------------ Key1$ = RTRIM$(LTRIM$(Key1$)) Key2$ = RTRIM$(LTRIM$(Key2$)) Key3$ = RTRIM$(LTRIM$(Key3$)) Key1 = VAL(Key1$) Key2 = VAL(Key2$) Key3 = VAL(Key3$) GOTO input.pass.word ELSEIF ThereIs = 0 THEN GOTO no.password.file END IF input.pass.word: '-----------------Set Up To Type In Password------------------ EdW$ = "" Row% = 14 Col% = 18 FCol% = 18 LenStr% = 40 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 0 BGColr% = 7 FKey$ = "" Ins% = 0 PW% = 1 COLOR 0, 7 LOCATE Row%, Col%, 1, 6, 7 PRINT " "; CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) EdW$ = UCASE$(RTRIM$(LTRIM$(EdW$))) DO PassW$ = UCASE$(RTRIM$(LTRIM$(PWord$))) IF PassW$ = EdW$ THEN GOTO leave ELSEIF PassW$ <> EdW$ THEN GOTO error.screen END IF LOOP leave: COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END error.screen: COLOR 15, 0: CLS CALL BoxBoy("", 4, 20, 6, 60, 0, 0, 0, 0, 14, 0, 2, 0, 0, 0) COLOR 14, 0 LOCATE 5, 28, 0, 0, 0: PRINT "<<<<<<< WARNING >>>>>>>"; COLOR 15, 0 LOCATE 10, 24: PRINT "YOU ARE NOT CLEARED IF YOU DO NOT"; LOCATE 12, 29: PRINT "KNOW THE PASSWORD !!!"; CALL BoxBoy("", 18, 25, 20, 55, 0, 0, 0, 0, 15, 0, 1, 0, 0, 0) COLOR 11, 0 LOCATE 19, 29: PRINT "Press To Try Again"; COLOR 15, 0 LOCATE 19, 36: PRINT "Esc"; IF Key1 > 64 AND Key1 < 91 THEN Key4 = Key1 + 32 IF Key2 > 64 AND Key2 < 91 THEN Key5 = Key2 + 32 IF Key3 > 64 AND Key3 < 91 THEN Key6 = Key3 + 32 DO SELECT CASE KeyCode% CASE Key1, Key4 SELECT CASE KeyCode% CASE Key2, Key5 SELECT CASE KeyCode% CASE Key3, Key6 GOSUB input.new.pass.word GOTO opening.screen END SELECT END SELECT CASE ArrowDn SELECT CASE KeyCode% 'Back Door CASE ArrowDn 'Press Down Arrow SELECT CASE KeyCode% '3 times and program CASE ArrowDn 'exits GOTO leave END SELECT GOTO leave END SELECT 'CASE 112, 80 'p, P ' +-----------------+ ' SELECT CASE KeyCode% ' | Enter P,A,S at | ' CASE 97, 65 'A, a ' | error.screen to | ' SELECT CASE KeyCode% ' | bypass password | ' CASE 115, 83 'S, s ' +-----------------+ ' GOTO leave ' | PAS = "PASS" | ' END SELECT ' +-----------------+ ' END SELECT ' 'CASE 115, 83 'S, s ' +-----------------+ ' SELECT CASE KeyCode% ' |Enter S,P,W at | ' CASE 112, 80 'P, p ' |error.screen to | ' SELECT CASE KeyCode% ' |see password | ' CASE 119, 87 'W, w ' +-----------------+ ' CLS : COLOR 15, 0 ' |SPW means "See | ' PRINT PassW$: END ' |Pass Word" | ' END SELECT ' +-----------------+ ' END SELECT ' CASE ESCAPE ' GOTO opening.screen END SELECT LOOP no.password.file: M1$ = STRING$(80, 255) M2$ = "-----------------------------------------------------------------------------" M3$ = " The SECURE Program " M4$ = " (1) The Secure Program will not execute unless it has been first " M5$ = " configured. This is done with its companion program, SECCFG.EXE." M6$ = " To run this program, enter SECCFG at the command prompt. The " M7$ = " program will set a beginning password and three password keys. " M8$ = STRING$(80, 255) M9$ = " (2) Please read the documentation file, by entering README.BAT at" M10$ = " the command prompt. To print out the documentation file," M11$ = " at the prompt enter PRINTME.BAT" M12$ = STRING$(80, 255) M13$ = " (3) To access this help screen, enter SECURE /h " M14$ = STRING$(80, 255) M15$ = "-----------------------------------------------------------------------------" M16$ = "Public Domain program by Don Smith, 08/20/97. EMail: smithdonb@earthlink.net" M17$ = "-----------------------------------------------------------------------------" COLOR 15, 0: CLS LOCATE 1, 1: PRINT M1$; LOCATE 2, 1: PRINT M2$; LOCATE 3, 1: PRINT M3$; LOCATE 4, 1: PRINT M4$; LOCATE 5, 1: PRINT M5$; LOCATE 6, 1: PRINT M6$; LOCATE 7, 1: PRINT M7$; LOCATE 8, 1: PRINT M8$; LOCATE 9, 1: PRINT M9$; LOCATE 10, 1: PRINT M10$; LOCATE 11, 1: PRINT M11$; LOCATE 12, 1: PRINT M12$; LOCATE 13, 1: PRINT M13$; LOCATE 14, 1: PRINT M14$; LOCATE 15, 1: PRINT M15$; LOCATE 16, 1: PRINT M16$; LOCATE 17, 1: PRINT M17$; END input.new.pass.word: COLOR 15, 0: CLS P1$ = STRING$(40, 255) P2$ = "Input New Password Here -" P3$ = "----------------------------------------" CALL BoxBoy("", 3, 10, 8, 70, 0, 0, 0, 0, 15, 0, 1, 0, 0, 0) COLOR 15, 0 LOCATE 4, 20: PRINT P2$; LOCATE 7, 22: PRINT P3$; FOR ClrDaScreen% = 1 TO 15 LOCATE ClrDaScreen% + 9, 1 PRINT STRING$(80, " "); NEXT SOUND 100, 3 continue.new.pass.word: PassW$ = SPACE$(40) CapsOn = 1: Row% = 6: Column% = 22 NormColor = 14: EditColor = 14: Length = 40 EdW$ = "" Row% = 6 Col% = 22 FCol% = 22 LenStr% = 40 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 14 BGColr% = 0 FKey$ = "" Ins% = 0 PW% = 0 CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) IF ExitCode% = 10 THEN 'F10 GOSUB smith.id GOTO input.new.pass.word END IF IF ExitCode% = 13 THEN PassW$ = LEFT$(EdW$, LenStr%) P4$ = PassW$ P5$ = "Is this your new password? (Y/N)" P6$ = "Press To Quit Routine" RowPassW = (40 - (LEN(P4$) / 2)) CALL BoxBoy("", 13, 10, 22, 70, 0, 0, 0, 0, 15, 0, 1, 0, 0, 0) COLOR 14, 0: LOCATE 14, RowPassW: PRINT P4$; COLOR 15, 0: LOCATE 16, 25: PRINT P5$; CALL BoxBoy("", 19, 25, 21, 56, 0, 0, 0, 0, 15, 0, 1, 0, 0, 0) COLOR 11, 0: LOCATE 20, 28: PRINT P6$; COLOR 15, 0: LOCATE 20, 35: PRINT "Esc"; SOUND 100, 3 DO SELECT CASE KeyCode% CASE UpperY, LowerY SHELL "ATTRIB" + " " + "-H" + " " + "P------W.---" OPEN "P------W.---" FOR OUTPUT AS #2 EncryptP1$ = CHR$(245) + CHR$(178) + CHR$(205) + CHR$(237) + CHR$(219) EncryptP2$ = CHR$(250) + CHR$(196) + CHR$(145) + CHR$(212) + CHR$(129) CALL Encrypt(EncryptP1$, PassW$) CALL Encrypt(EncryptP2$, PassW$) PRINT #2, PassW$ PRINT #2, Ky1$ PRINT #2, Ky2$ PRINT #2, Ky3$ CLOSE #2 SHELL "ATTRIB" + " " + "+H" + " " + "P------W.---" RETURN CASE UpperN, LowerN GOTO input.new.pass.word CASE ESCAPE RETURN CASE ELSE END SELECT LOOP ELSEIF ExitCode% = 27 THEN RETURN ELSEIF LEN(PassW$) = 21 THEN GOTO continue.new.pass.word END IF RETURN smith.id: COLOR 15, 0: CLS CALL BoxBoy("", 7, 10, 16, 70, 0, 0, 0, 0, 15, 0, 1, 0, 0, 0) LOCATE 8, 13: PRINT "IDENTIFICATION OF AUTHOR. Hello! My name is Donald"; LOCATE 8, 13: COLOR 14, 0: PRINT "IDENTIFICATION OF AUTHOR"; : COLOR 15, 0 LOCATE 9, 13: PRINT "Bernard Smith, and I am the author of the Secure Program."; LOCATE 10, 13: PRINT "I will not give my social security number, but for"; LOCATE 11, 13: PRINT "purposes of identification, my USMC military serial"; LOCATE 12, 13: PRINT "number is 1672175. Today's date is 08/20/1997. The"; LOCATE 13, 13: PRINT "Secure Program is Public Domain FreeWare."; : COLOR 11, 0 LOCATE 15, 19: PRINT "Press To Return To Input New Password."; : COLOR 15, 0 LOCATE 15, 26: PRINT "Esc"; ' LOCATE 18, 34: COLOR 11, 0: PRINT "- Enjoy -"; ' LOCATE , , 0, 0, 0 DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) ' +--------------------------------------------------------------------+ ' | | ' | SUB BoxBoy | ' | | ' +--------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB BoxBoy has 121 lines. | ' +--------------------------------------------------------------------+ ' | Version 1.0 of SUB BoxBoy was written by Don Smith on 03/25/2002. | ' | This is Version 2.0 and it was written on 10/01/2002. Both | ' | versions are declared Public Domain FreeWare. Other programmers | ' | may use this SUB without naming me as the author, and they may | ' | modify the code in any way they see fit. | ' | | ' | Don's EMail: smithdonb@earthlink.net | ' | | ' | This SUB only saves that portion of the underlying screen under | ' | the box and repaints with a shadow. So recommend using the SUB | ' | SaveRestScrn to save/restore the complete screen, or a larger | ' | portion of the screen than the box. | ' +-------------+------------------------------------------------------+ ' | Title$ | The title of the menu. To make a box without a title,| ' | | use: Title$ = "". When there is no Title, the cross | ' | | bar is not deployed. | ' +-------------+------------------------------------------------------+ ' | ULRow% | The upper left row to place the box. | ' +-------------+------------------------------------------------------+ ' | ULCol% | The upper left column to place the box. | ' +-------------+------------------------------------------------------+ ' | LRRow% | The lower right row to place the box. | ' +-------------+------------------------------------------------------+ ' | LRCol% | The lower right column to place the box. | ' +-------------+----------------------------------+-------------------+ ' | TitleRow% | The row to place the title. | If Title$ = "" | ' +-------------+----------------------------------| (or NO title), | ' | TitleCol% | The column to place the title. | report these four | ' +-------------+----------------------------------| values as zero (0)| ' | TitColrFG% | The foreground color of the title| . . . . . . . . | ' +-------------+----------------------------------| Example -> | ' | TitColrBG% | The background color of the title| TitColrFG% = 0 | ' +-------------+----------------------------------+-------------------+ ' | BoxColrFG% | The foreground color of the box itself. | ' +-------------+------------------------------------------------------+ ' | BoxColrBG% | The back ground color of the box. | ' +-------------+------------------------------------------------------+ ' | BoxStyle% | BoxStyle% = 0 (No line around box) | ' | | BoxStyle% = 1 (Single line around box) | ' | | BoxStyle% = 2 (Double line around box) | ' +-------------+------------------------------------------------------+ ' | Shadow% | If Shadow% equals 0, there will be no shadow. | ' | | If Shadow% equals 1, there will be a right shadow. | ' | | If Shadow% equals 2, there will be a left shadow | ' | +------------------------------------------------------+ ' | | NOTE #1: | ' | | ------- | ' | | When a shadow is used, the underlying text will | ' | | be saved and printed with the ShadeColr% (just | ' | | below). This causes the shadow to look like a | ' | | real shadow. | ' | | | ' | | NOTE #2: | ' | | ------- | ' | | If the first four values of BoxBoy are 1, 1, 25, 80, | ' | | in other words a full screen, please set Shadow% = 0;| ' | | otherwise an error will result (no room for shadow). | ' +-------------+------------------------------------------------------+ ' | ShadowColr% | The ShadowColr% is the foreground color of the | ' | | shadow. The background color will always be | ' | | black. Either choose ShadowColr% = 7 or | ' | | ShadowColr% = 8. | ' | | | ' | | ShadowColr% = 7 saves the foreground color and | ' | | changes it to a shade darker, if possible. For | ' | | example, a bright white on blue (COLOR 15, 1) | ' | | becomes dim white on black (COLOR 7, 0). A bright | ' | | blue on blue (COLOR 9, 1) becomes regular blue | ' | | on black (COLOR 1, 0). Very realistic. | ' | | | ' | | ShadowColr% = 8 saves the foreground and reprints | ' | | it as COLOR 8, 0. Darker then ShadowColr% = 7 | ' +-------------+----------------+-------------------------------------+ ' | EdgeYN% | EdgeYN% = 0 | Do NOT print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | EdgeYN% = 1 | YES, DO print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | What does it mean to "print an edge of one space | ' | | with BoxColrFG% color on the right and left edges | ' | | of the box". Well, I will attempt to demonstrate | ' | | by drawing the boxes with non-extended ASCII | ' | | characters. The X's represent a shadow to the | ' | | right. | ' | | | ' | | NO EDGE RIGHT/LEFT 1 SPACE EDGE RIGHT/LEFT | ' | | ~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ | ' | | (EdgeYN% = 0) (EdgeYN% = 1 | ' | | | ' | | +-----------------+ +-------------------+ | ' | | |+---------------+| | +---------------+ | | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | |+---------------+|XX | +---------------+ |XX | ' | | +-----------------+XX +-------------------+XX | ' | | XXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXX | ' | | | ' +-------------+------------------------------------------------------+ IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN IF Shadow% > 0 THEN LRCol% = 78 ELSEIF Shadow% = 0 THEN LRCol% = 79 END IF END IF make.box: IF BoxStyle% = 0 THEN 'No Lines ULCorner$ = CHR$(255) URCorner$ = CHR$(255) HorLine$ = CHR$(255) LeftSide$ = CHR$(255) RightSide$ = CHR$(255) VertLine$ = CHR$(255) LLCorner$ = CHR$(255) LRCorner$ = CHR$(255) ELSEIF BoxStyle% = 1 THEN 'Single Line ULCorner$ = CHR$(218) URCorner$ = CHR$(191) HorLine$ = CHR$(196) LeftSide$ = CHR$(195) RightSide$ = CHR$(180) VertLine$ = CHR$(179) LLCorner$ = CHR$(192) LRCorner$ = CHR$(217) ELSEIF BoxStyle% = 2 THEN 'Double Line ULCorner$ = CHR$(201) URCorner$ = CHR$(187) HorLine$ = CHR$(205) LeftSide$ = CHR$(199) RightSide$ = CHR$(182) VertLine$ = CHR$(186) LLCorner$ = CHR$(200) LRCorner$ = CHR$(188) END IF IF Shadow% > 0 THEN IF EdgeYN% = 1 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 5 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% END IF ELSEIF EdgeYN% = 0 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 3 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% - 1 END IF END IF REDIM ReadLine$(25): REDIM ReadColr%(25, 80) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = LeftLimit% TO RightLimit% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT FOR FindRow% = ULRow% + 1 TO LRRow% + 1 FOR ScrnCol% = LeftLimit% TO RightLimit% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 'make colors less bright IF FGScrnColr% = 0 THEN FGScrnColr% = 7 IF FGScrnColr% = 9 THEN FGScrnColr% = 1 IF FGScrnColr% = 10 THEN FGScrnColr% = 2 IF FGScrnColr% = 11 THEN FGScrnColr% = 3 IF FGScrnColr% = 12 THEN FGScrnColr% = 4 IF FGScrnColr% = 13 THEN FGScrnColr% = 5 IF FGScrnColr% = 14 THEN FGScrnColr% = 7 IF FGScrnColr% = 15 THEN FGScrnColr% = 7 BGScrnColr% = OneColr% \ 16 IF ShadowColr% = 7 THEN COLOR FGScrnColr%, 0 ELSEIF ShadowColr% = 8 THEN COLOR 8, 0 END IF IF Shadow% = 1 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% + 1)); ELSEIF Shadow% = 2 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% - 3)); END IF NEXT NEXT ERASE ReadLine$: ERASE ReadColr% END IF IF EdgeYN% = 1 THEN Edge$ = " " END IF Title.Length% = LEN(Title$) COLOR BoxColrFG%, BoxColrBG% 'ÚÄÄÄ¿ or ÉÍÍÍ» LOCATE ULRow%, ULCol% PRINT Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + Edge$; '³ ³ or º º LOCATE ULRow% + 1, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol% PRINT Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; END IF '³ ³ or º º FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0 PRINT Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + Edge$; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol% COLOR TitColrFG%, TitColrBG% PRINT Title$; END IF END SUB SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) STATIC ' +--------------------------------------------------------------------+ ' | SUB EditLoco: | ' +--------------------------------------------------------------------+ ' | This is a version of SUB EditString is called SUB EditLoco. The | ' | SUB EditString is compiled with the Pro.Lib from Cresent SoftWare.| ' | This version, called SUB EditLoco is compiled with regular ol' | ' | QuickBASIC v4.5 and needs no special library. | ' +--------------------------------------------------------------------+ ' | EdW$ | The string to be edited. | ' +--------------+-----------------------------------------------------+ ' | Row% | The row to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | Col% | The column to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | FCol% | Use same number as Col% | ' +--------------+-----------------------------------------------------+ ' | LenStr% | Length of the string to edit. | ' +--------------+-----------------------------------------------------+ ' | See% | If See% = 0 then existing text will be displayed. | ' | | If See% = 1 existing text will be wiped. | ' +--------------+-----------------------------------------------------+ ' | TypeOfText$ | For all ASCII characers 32 to 255, TypeOfText = "" | ' | | For numbers only, TypeOfText$ = "1234567890" | ' | | For numbers with commas and decimals points, | ' | | TypeOfText$ = ".,1234567890" | ' | | For Yes or No answers, TypeOfText$ = "YNyn" | ' | | Whatever is included within the parethesis | ' | | is what will be accepted. | ' +--------------+-----------------------------------------------------+ ' | Caps% | Capital letters enabled, Caps% = 1 | ' +--------------+-----------------------------------------------------+ ' | FGColr% | The text foreground color. | ' +--------------+-----------------------------------------------------+ ' | BGColr% | The text back ground color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | Which keys to enable. To enabled | ' | | and , FKey$ = "150" ("0" is F10). | ' +--------------+-----------------------------------------------------+ ' | PW% | PW% = 1 - password mode enabled. | ' | | PW% = 0 - password mode NOT enabled. | ' +--------------+-----------------------------------------------------+ ' | Ins% | Ins% = 0 then INSERT OFF. Ins% = 1 then INSERT ON | ' +--------------+-----------------------------------------------------+ ' +------------------------------------+-------------------------------+ ' | Please include at the top of the routine DEFINT A-Z | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Use KeyCode.Bas below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +--------------------------------------------------------------------+ ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ EdW$ = "": Ky$ = "" IF See% = 1 THEN LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT STRING$(LenStr%, " "); END IF begin.edit.line: DO IF Ins% = 1 THEN 'Insert On COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 4, 7 ELSEIF Ins% = 0 THEN 'Insert Off COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 6, 7 END IF DO Ky$ = INKEY$ IF PW% = 1 THEN IF BlankIt% = 1 THEN BlankIt% = 0 END IF END IF LOOP UNTIL LEN(Ky$) > 0 SlamKey% = CVI(Ky$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'CHR$(31) to CHR$255) IF TypeOfText$ = "" THEN 'CHR$(32) is IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, Ky$) > 0 THEN IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF END IF END IF ELSEIF SlamKey% = 27 THEN ' Key ExitCode% = 27 GOSUB get.string EXIT SUB ELSEIF SlamKey% = 19712 THEN ' Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN ' Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1 END IF ELSEIF SlamKey% = 13 THEN ' IF PW% = 0 THEN GOSUB get.string END IF ExitCode% = 13 EXIT SUB ' or or - If not used, REM these 3 out. ELSEIF SlamKey% = 9 OR SlamKey% = 18432 OR SlamKey% = 20480 THEN GOSUB get.string ExitCode% = SlamKey% EXIT SUB ELSEIF SlamKey% = 8 THEN ' Col% = Col% - 1 IF Col% = FCol% OR Col% < FCol% THEN Col% = FCol% END IF LOCATE Row%, Col% COLOR FGColr%, BGColr%: PRINT " "; IF PW% = 1 THEN EdW$ = LEFT$(EdW$, LEN(EdW$) - 1) END IF ELSEIF SlamKey% = 20992 THEN ' 'If 1 (on), turn off (0). If 0 (off), turn on (1). IF Ins% = 1 THEN Ins% = 0 'unREM if need to print "Insert Off/On" 'LOCATE 2, 66: Print "Insert Off "; ELSEIF Ins% = 0 THEN 'REM out "Insert Off/On" if not used. Ins% = 1 'LOCATE 2, 66: Print "Insert On "; END IF ELSEIF SlamKey% = 21248 THEN ' SaveScr$ = "" FOR DelK% = Col% + 1 TO FCol% + LenStr% SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, DelK%)) NEXT SaveScr$ = MID$(SaveScr$, 1, LEN(SaveScr$) - 1) LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT EdW$ + SaveScr$; SaveScr$ = "" ELSEIF SlamKey% = 18176 THEN ' Col% = FCol% ELSEIF SlamKey% = 20224 THEN ' GOSUB get.string Col% = FCol% + LEN(EdW$) LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN ' = clears line of LOCATE Row%, FCol% 'all text. WipeOut$ = SPACE$(LenStr%) COLOR FGColr%, BGColr% PRINT WipeOut$; ELSEIF SlamKey% > 15103 OR SlamKey% < 17409 THEN ' to IdentKey$ = STR$(((SlamKey% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 GOSUB get.string EXIT SUB ELSE ExitCode% = VAL(IdentKey$) GOSUB get.string EXIT SUB END IF END IF END IF LOOP show.char: IF Ins% = 1 THEN ' FOR Horizontal% = Col% TO FCol% + LenStr% - 1 EditL$ = EditL$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT IF Caps% > 0 THEN EditL$ = UCASE$(EditL$) Ky$ = UCASE$(Ky$) END IF COLOR FGColr%, BGColr% LOCATE Row%, Col%, 1 PRINT LEFT$(Ky$ + EditL$, FCol% + LenStr% - Col%); IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 EditL$ = "" ELSEIF Ins% = 0 THEN ' LOCATE Row%, Col% IF Caps% > 0 THEN COLOR FGColr%, BGColr%: PRINT UCASE$(Ky$); ELSEIF Caps% = 0 THEN COLOR FGColr%, BGColr%: PRINT Ky$; END IF Col% = Col% + 1 IF Col% = FCol% + LenStr% THEN Col% = FCol% RETURN END IF END IF RETURN get.string: EditLine$ = SPACE$(LenStr%) FOR Horizontal% = FCol% TO FCol% + LenStr% EditLine$ = EditLine$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT EditLine$ = LTRIM$(RTRIM$(EditLine$)) EdW$ = EditLine$ RETURN edit.password: EdW$ = UCASE$(EdW$) + UCASE$(Ky$) COLOR FGColr%, BGColr% LOCATE Row%, Col% PRINT "ù"; 'CHR$(249) LOCATE Row%, Col% + 1, 1, 6, 7 IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 RETURN END SUB SUB Encrypt (PassWord$, X$) L = LEN(PassWord$) FOR X = 1 TO LEN(X$) Pass = ASC(MID$(PassWord$, (X MOD L) - L * ((X MOD L) = 0), 1)) MID$(X$, X, 1) = CHR$(ASC(MID$(X$, X, 1)) XOR Pass) NEXT END END SUB DEFSNG A-Z SUB GetFileAttributes (fileName$, result%) STATIC ' +---------------------------------------------------------------------+ ' | GetFileAttributes is used to determine if a file exists or not. | ' | To use this SUB within QuickBASIC 4.5, you must load the QuickBASIC | ' | Quick Library. At the prompt it would be: | ' | | ' | QB /L QB.QLB ConfigPW.Bas (and press ENTER) | ' | | ' | See example, below: | ' +---------------------------------------------------------------------+ ' | | ' | To use SUB GetFileAttributes -> | ' | | ' | CALL GetFileAttributes (fileName$, result%) | ' | IF result% > 0 THEN | ' | 'file does not exist. Use a pop-up screen and | ' | 'back out. | ' | ELSEIF result% = 0 THEN | ' | 'file does indeed exist. Continue with routine. | ' | END IF | ' | | ' +---------------------------------------------------------------------+ DIM regX AS RegTypeX regX.ax = &H4300 F$ = fileName$ + CHR$(0) regX.ds = VARSEG(F$) regX.dx = SADD(F$) InterruptX &H21, regX, regX IF regX.flags AND 1 THEN result% = regX.ax ELSE result% = 0 END IF END SUB FUNCTION KeyCode% STATIC DO K$ = INKEY$ LOOP UNTIL K$ <> "" KeyCode% = CVI(K$ + CHR$(0)) END FUNCTION '========================================================================= '========================================================================= ' Split into two QuickBASIC BAS file right here. ' ' The file above is: (1) SecurePW.Bas ' The file below is: (2) ConfigPW.Bas '========================================================================= '========================================================================= ' +-----------------------------------------------------+ ' | | ' | WARNING WARNING WARNING | ' | ------- ------- ------- | ' | When you load this program into QuickBASIC 4.5, you must also | ' | load QuickBASIC's quick library. So, at the prompt enter: | ' | | ' | QB /L QB.QLB ConfigPW.Bas | ' | | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | | ' | C o n f i g P W . B a s | ' | ----------------------- | ' | | ' | (Public Domain FreeWare - 12/01/2002) | ' | | ' +-------------------------------------------------------------------+ ' | The ConfigPW program is a companion and configuration program to | ' | set up the SecurePW program. Uses for the SecurePW program would | ' | be to exclude users from access to important files on the computer| ' | such as bank records, data files and bookkeeping and accounting | ' | records. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +-------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a thirty-year retired teacher | ' |of Math/History/Spanish residing in Orange County, California. I | ' |am also a former six-year Sergeant of Marines. Who-Rah! On certain | ' |forums I am known as MarineDon.My email is: smithdonb@earthlink.net| ' | | ' +-------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +-------------------------------------------------------------------+ ' |Since this code is public domain and freeware, anyone may freely | ' |copy and distribute it. If you use the QuickBasic code in one of | ' |your own programs, you do not have to cite my name as the author, | ' |and you may even change its name. | ' +-------------------------------------------------------------------+ ' | ConfigPW.Bas is a companion file to SecurePW.Exe which configures | ' | the password to be double encrypted, afterwhich ConfigPW.Exe may | ' | be deleted. | ' +-------------------------------------------------------------------+ ' | The SecurePW basic code and all its eight SUBs were written | ' | me, Don Smith, on 09/10/2007. It is a rewrite of a former | ' | program called Seccfg.Bas which required the use of two special | ' | libraries, Pro.Lib and PDQ.Lib. The reason for the rewrite was | ' | to set up a configuration program written solely in QuickBASIC | ' | 4.5. | ' +-------------------------------------------------------------------+ ' | The ConfigPW.Bas code and the executable program are support | ' | platform for SecurePW.Bas program, and SecurePW.Bas puts on | ' | a screen requesting a password. The password has been previouly | ' | been stored in a hidden file call P------W.--- which has been | ' | double encrypted. Also, the ConfigPW program asks the user | ' | to input 3 keys of key combinations which are also stored in | ' | P------W.---. The reason for this is so that user can within the | ' | SecurePW program change the password. Changing the passord with- | ' | in SecurePW requires the user to make an error on entering the | ' | password so as to bring up an error screen. Once in the error | ' | screen, the user would press the 3 key combinations previously | ' | set within the ConfigPW program. The reason for all the | ' | machinations is so the this program, ConfigPW may deleted and no | ' | potential thief would have access to it. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | COMPILE INFORMATION: | ' +-------------------------------------------------------------------+ ' | | ' | BC: ConfigPW | ' | LINK: ConfigPW | ' | LIB: QB BCom45 | ' | | ' +-------------------------------------------------------------------+ tippy.top: ' Next 19 lines set up SUB GetFileAttributes and SUB InterruptX ' ConfigPW.Bas uses these SUBs to check the existence of a file ' (for more information, go to SUB GetFileAttributes) TYPE RegTypeX ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE '--------------------------------------------------------------------- DEFINT A-Z '------------------------------------------------------------------------ DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB CMenu (M$(), Row%, Col%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) DECLARE SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) DECLARE SUB EditString (EdW$, NumKey%, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, ColrFG%, ColrBG%, FKey$, ExitCode%) DECLARE SUB Encrypt (PassWord$, X$) DECLARE SUB GetFileAttributes (fileName$, result%) DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX) DECLARE SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '------------------------------------------------------------------------ begin: CLS : LOCATE , , 0, 0, 0 GOSUB screen.one REDIM M$(4) M$(1) = "1. Set Password" M$(2) = "2. View Info File " + CHR$(34) + "SecurePW.Txt" + CHR$(34) M$(3) = "3. Delete Hidden File (P------W.---)" M$(4) = "4. Exit" Row% = 8 Col% = 24 RegColrFG% = 15 RegColrBG% = 1 HiLiteFG% = 15 HiLiteBG% = 0 MaxItems% = 4 LenLine% = 0 SD% = 1 Selection% = 1 CALL CMenu(M$(), Row%, Col%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) DO IF ExitCode% = 27 THEN COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END END IF IF Selection% = 1 THEN GOSUB clear.lil.box PWord$ = SPACE$(20) COLOR 0, 7: LOCATE 8, 54, 0, 0, 0: PRINT PWord$; PMessage1$ = "Input Password Here (20 Characters Or Less) :" LOCATE 8, 8, 0, 0, 0 COLOR 15, 1 PRINT PMessage1$; GOTO input.password ELSEIF Selection% = 2 THEN GOSUB view.doc GOTO begin ELSEIF Selection% = 3 THEN GOTO del.password.file ELSEIF Selection% = 4 THEN COLOR 7, 0: CLS : LOCATE , , 1, 6, 7: END END IF LOOP clear.lil.box: FOR ClearLilBox% = 1 TO 11 COLOR 15, 1 LOCATE ClearLilBox% + 3, 2 PRINT STRING$(63, " "); NEXT RETURN del.password.file: ' +---------------------------------------------------------------------+ ' | GetFileAttributes is used to determine if a file exists or not. | ' | To use this SUB within QuickBASIC 4.5, you must load the QuickBASIC | ' | Quick Library. At the prompt it would be: | ' | | ' | QB /L QB.QLB ConfigPW.Bas (and press ENTER) | ' | | ' | See example, below: | ' +---------------------------------------------------------------------+ ' | | ' | To use SUB GetFileAttributes -> | ' | | ' | CALL GetFileAttributes (fileName$, result%) | ' | IF result% > 0 THEN | ' | 'file does not exist. Use a pop-up screen and | ' | 'back out. | ' | ELSEIF result% = 0 THEN | ' | 'file does indeed exist. Continue with routine. | ' | END IF | ' | | ' +---------------------------------------------------------------------+ LOCATE 1, 1, 0, 0, 0 DelLine$ = CHR$(199) + STRING$(40, 196) + CHR$(182) CALL GetFileAttributes("P------W.---", result%) IF result% = 0 THEN 'Set Attribute as NOT hidden SHELL "ATTRIB" + " " + "-H" + " " + "P------W.---" KILL "P------W.---" COLOR 15, 3 CALL BoxBoy("", 12, 20, 18, 60, 0, 0, 0, 0, 15, 3, 2, 1, 7, 1) Del1$ = "The hidden file P------W.---" Del2$ = " is now deleted!" Del3$ = "Press To Continue." LOCATE 13, 27: PRINT Del1$; LOCATE 15, 27: PRINT Del2$; LOCATE 16, 21: PRINT DelLine$; LOCATE 17, 29: PRINT Del3$; SOUND 150, 2 GOSUB press.esc GOTO begin ELSEIF result% > 0 THEN COLOR 15, 3 CALL BoxBoy("", 12, 20, 18, 60, 0, 0, 0, 0, 15, 3, 2, 1, 7, 1) Del4$ = "The hidden file P------W.---" Del5$ = "isn't on current directory." Del6$ = "Press To Continue." LOCATE 13, 27: PRINT Del4$; LOCATE 15, 27: PRINT Del5$; LOCATE 16, 21: PRINT DelLine$; LOCATE 17, 29: PRINT Del6$; SOUND 150, 2 GOSUB press.esc GOTO begin END IF press.esc: LOCATE 1, 1, 0, 0, 0 DO DO HitOldKey$ = INKEY$ LOOP UNTIL LEN(HitOldKey$) > 0 HitOldKey% = CVI(HitOldKey$ + CHR$(0)) IF HitOldKey% = 27 THEN EXIT DO END IF LOOP RETURN input.password: 'NumOnly% = 0: CapsOn% = 1: NormalColor% = 112: EditColor% = 112 'Row% = 8: Column% = 54: SOUND 150, 2 EdW$ = "" Row% = 8 Col% = 54 FCol% = 54 LenStr% = 20 See% = 0 TypeOfText$ = "" Caps% = 1 FGColr% = 0 BGColr% = 7 FKey$ = "" Ins% = 0 PW% = 0 ExitCode% = 0 CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) PWord$ = RTRIM$(LTRIM$(EdW$)) IF ExitCode% = 13 THEN FOR ClearLilBox% = 1 TO 11 COLOR 15, 1 LOCATE ClearLilBox% + 3, 2 PRINT STRING$(78, " "); NEXT PMessage2$ = "Your Password Is :" PMessage3$ = PWord$ PMessage4$ = "(Y/N)?" LOCATE 8, 21: PRINT PMessage2$; : COLOR 0, 7 LOCATE 8, 41: PRINT PMessage3$; : COLOR 15, 1 LOCATE 8, 41 + LEN(PWord$) + 3, 0: PRINT PMessage4$; SOUND 100, 2 DO HitKey$ = INKEY$ IF HitKey$ = "Y" OR HitKey$ = "y" THEN GOSUB screen.two key$ = SPACE$(3) Column% = 17 NumKey% = 1 GOSUB three.keys SOUND 100, 2 GOTO input.keys ELSEIF HitKey$ = "N" OR HitKey$ = "n" THEN PWord$ = SPACE$(20) COLOR 15, 1 LOCATE 8, 2: PRINT STRING$(76, 255) LOCATE 8, 8 PRINT "Input PassWord Here (20 Characters Or Less) :"; GOTO input.password ELSEIF HitKey$ = CHR$(27) THEN GOTO begin END IF LOOP ELSEIF ExitCode% = 27 THEN GOTO begin ELSE GOTO begin END IF three.keys: REDIM KyN$(105) KyN$(1) = "Ctrl - F1" KyN$(2) = "Ctrl - F2" KyN$(3) = "Ctrl - F3" KyN$(4) = "Ctrl - F4" KyN$(5) = "Ctrl - F5" KyN$(6) = "Ctrl - F6" KyN$(7) = "Ctrl - F7" KyN$(8) = "Ctrl - F8" KyN$(9) = "Ctrl - F9" KyN$(10) = "Ctrl - F10" KyN$(11) = "Alt - F1" KyN$(12) = "Alt - F2" KyN$(13) = "Alt - F3" KyN$(14) = "Alt - F4" KyN$(15) = "Alt - F5" KyN$(16) = "Alt - F6" KyN$(17) = "Alt - F7" KyN$(18) = "Alt - F8" KyN$(19) = "Alt - F9" KyN$(20) = "Alt - F10" KyN$(21) = "Shft - F1" KyN$(22) = "Shft - F2" KyN$(23) = "Shft - F3" KyN$(24) = "Shft - F4" KyN$(25) = "Shft - F5" KyN$(26) = "Shft - F6" KyN$(27) = "Shft - F7" KyN$(28) = "Shft - F8" KyN$(29) = "Shft - F9" KyN$(30) = "Shft - F10" KyN$(31) = "`" KyN$(32) = "1" KyN$(33) = "2" KyN$(34) = "3" KyN$(35) = "4" KyN$(36) = "5" KyN$(37) = "6" KyN$(38) = "7" KyN$(39) = "8" KyN$(40) = "9" KyN$(41) = "0" KyN$(42) = "[" KyN$(43) = "]" KyN$(44) = "\" KyN$(45) = "/" KyN$(46) = "-" KyN$(47) = "=" KyN$(48) = ";" KyN$(49) = "'" KyN$(50) = "A" KyN$(51) = "B" KyN$(52) = "C" KyN$(53) = "D" KyN$(54) = "E" KyN$(55) = "F" KyN$(56) = "G" KyN$(57) = "H" KyN$(58) = "I" KyN$(59) = "J" KyN$(60) = "K" KyN$(61) = "L" KyN$(62) = "M" KyN$(63) = "N" KyN$(64) = "O" KyN$(65) = "P" KyN$(66) = "Q" KyN$(67) = "R" KyN$(68) = "S" KyN$(69) = "T" KyN$(70) = "U" KyN$(71) = "V" KyN$(72) = "W" KyN$(73) = "X" KyN$(74) = "Y" KyN$(75) = "Z" KyN$(76) = "Home" KyN$(77) = "End" KyN$(78) = "Insert" KyN$(79) = "Delete" KyN$(80) = "BackkSpace" KyN$(81) = "PgUp" KyN$(82) = "PgDn" KyN$(83) = "UpArrow" KyN$(84) = "DownArrow" KyN$(85) = "RightArrow" KyN$(86) = "LeftArrow" KyN$(87) = "Tab" KyN$(88) = "Enter" KyN$(89) = "@" KyN$(90) = "#" KyN$(91) = "$" KyN$(92) = "%" KyN$(93) = "+" KyN$(94) = "&" KyN$(95) = "*" KyN$(96) = "F1" KyN$(97) = "F2" KyN$(98) = "F3" KyN$(99) = "F4" KyN$(100) = "F5" KyN$(101) = "F6" KyN$(102) = "F7" KyN$(103) = "F8" KyN$(104) = "F9" KyN$(105) = "F10" RETURN input.keys: IF NumKey% = 1 THEN Col% = 20 FCol% = 20 ELSEIF NumKey% = 2 THEN SOUND 100, 2 Col% = 45 FCol% = 45 ELSEIF NumKey% = 3 THEN SOUND 100, 2 Col% = 69 FCol% = 69 END IF Row% = 21: LenStr% = 3: See% = 0: TypeOfText$ = "1234567890" Caps% = 0: ColrFG% = 15: ColrBG% = 1: FKey$ = "1": EdW$ = "" CALL EditString(EdW$, NumKey%, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, ColrFG%, ColrBG%, FKey$, ExitCode%) IF ExitCode% = 13 OR ExitCode% = 18 THEN 'Enter/Tab IF NumKey% = 3 THEN GOSUB check.edw IF EdW$ = "" THEN NumKey% = 3 GOTO input.keys END IF KeyNum3$ = EdW$ GOTO query.box ELSEIF NumKey% = 1 OR NumKey% = 2 THEN GOSUB check.edw GOTO input.keys END IF ELSEIF ExitCode% = 16 OR ExitCode% = 19 THEN 'Up Arrow, PgUp IF NumKey% = 2 THEN NumKey% = 1 GOTO input.keys ELSEIF NumKey% = 3 THEN NumKey% = 2 GOTO input.keys END IF ELSEIF ExitCode% = 27 THEN GOTO begin ELSEIF ExitCode% = 1 THEN 'F1 GOSUB save.screen GOSUB view.doc GOSUB restore.screen GOTO input.keys ELSEIF LEN(EdW$) = 3 THEN GOTO input.keys END IF check.edw: IF VAL(EdW$) > 105 THEN LOCATE 1, 1, 0, 0, 0 GOSUB save.screen CALL BoxBoy("", 21, 9, 23, 72, 0, 0, 0, 0, 12, 0, 1, 0, 0, 0) ErrWind$ = "<<< Cannot use a number that exceeds 105 >>>" LOCATE 22, 19: COLOR 12, 0: PRINT ErrWind$; SOUND 15, 2 SLEEP 25 GOSUB restore.screen RETURN ELSEIF VAL(EdW$) = 0 THEN LOCATE 1, 1, 0, 0, 0 GOSUB save.screen CALL BoxBoy("", 21, 9, 23, 72, 0, 0, 0, 0, 12, 0, 1, 0, 0, 0) ErrEnt$ = "<<< Cannot enter zero (0) or leave blank >>>" LOCATE 22, 19: COLOR 12, 0: PRINT ErrEnt$; SLEEP 25 GOSUB restore.screen RETURN ELSEIF NumKey% = 1 THEN KeyNum1$ = EdW$ NumKey% = 2 Col% = 43 EdW$ = "" RETURN ELSEIF NumKey% = 2 THEN KeyNum2$ = EdW$ NumKey% = 3 Col% = 67 EdW$ = "" RETURN END IF RETURN leave: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END save.screen: REDIM ReadLine$(25) REDIM ReadColr%(25, 80) SR.UL.Row% = 1 SR.UL.Col% = 1 SR.LR.Row% = 25 SR.LR.Col% = 80 SaveOrRest% = 1 CALL SaveRestScrn(ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) RETURN restore.screen: SR.UL.Row% = 1 SR.UL.Col% = 1 SR.LR.Row% = 25 SR.LR.Col% = 80 SaveOrRest% = 2 CALL SaveRestScrn(ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) ERASE ReadLine$: ERASE ReadColr% RETURN screen.one: '-----------------------------------Screen One----------------------------- REDIM Scrn1$(25) Scrn1$(1) = "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" Scrn1$(2) = "º The SECUREPW Configuration Program (v3.0) º" Scrn1$(3) = "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" Scrn1$(4) = "º º" Scrn1$(5) = "º ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ º" Scrn1$(6) = "º ³ Use <> <> Or Press # ³ º" Scrn1$(7) = "º ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ º" Scrn1$(8) = "º ³ 1. Set Password ³ º" Scrn1$(9) = "º ³ 2. View Info File " + CHR$(34) + "Secure.Txt" + CHR$(34) + " ³ º" Scrn1$(10) = "º ³ 3. Delete Hidden File (P------W.---) ³ º" Scrn1$(11) = "º ³ 4. Exit ³ º" Scrn1$(12) = "º ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ º" Scrn1$(13) = "º ³ Press To Quit At Any Time ³ º" Scrn1$(14) = "º ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ º" Scrn1$(15) = "º º" Scrn1$(16) = "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" Scrn1$(17) = "º This program will essentially do two things. (1) It will configure º" Scrn1$(18) = "º the SECURE Program with a password and then it lets you select the three º" Scrn1$(19) = "º keys which will be your secret combination to changing your password º" Scrn1$(20) = "º within the SECURE Program. The password and password keys will be º" Scrn1$(22) = "º placed in a hidden, double-encrypted file called " + CHR$(34) + "P------W.---" + CHR$(34) + ". º" Scrn1$(23) = "º (2) It will allow you to delete the hidden file just mentioned; the º" Scrn1$(24) = "º usual DOS command DEL will not work with a hidden file. º" Scrn1$(25) = "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" COLOR 15, 1: CLS FOR Scrn1% = 1 TO 25 PRINT Scrn1$(Scrn1%); NEXT COLOR 11, 1 LOCATE 6, 31: PRINT CHR$(25); LOCATE 6, 35: PRINT CHR$(24); LOCATE 6, 39: PRINT "Enter"; LOCATE 6, 55: PRINT "#" LOCATE 13, 33: PRINT "Esc"; LOCATE 17, 54: PRINT "1"; LOCATE 21, 55: PRINT "P------W.---"; LOCATE 22, 6: PRINT "2"; RETURN screen.two: '-----------------------------Screen Two---------------------------------- COLOR 15, 1: CLS REDIM Scrn2$(25) Scrn2$(1) = " PASSWORD KEYS: Info" Scrn2$(2) = "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍ»" Scrn2$(4) = "º 1 =³16 = ³31 = <`>³46 = <->³61 = ³76 = ³ 91 = <$> º" Scrn2$(5) = "º 2 =³17 = ³32 = <1>³47 = <=>³62 = ³77 = ³ 92 = <%> º" Scrn2$(6) = "º 3 =³18 = ³33 = <2>³48 = <;>³63 = ³78 = ³ 93 = <+> º" Scrn2$(7) = "º 4 =³19 = ³34 = <3>³49 = <,>³64 = ³79 = ³ 94 = <&> º" Scrn2$(8) = "º 5 =³20 =³35 = <4>³50 = ³65 =

³80 = ³ 95 = <*> º" Scrn2$(9) = "º 6 =³21 =³36 = <5>³51 = ³66 = ³81 = ³ 96 = º" Scrn2$(10) = "º 7 =³22 =³37 = <6>³52 = ³67 = ³82 = ³ 97 = º" Scrn2$(11) = "º 8 =³23 =³38 = <7>³53 = ³68 = ³83 =³ 98 = º" Scrn2$(12) = "º 9 =³24 =³39 = <8>³54 = ³69 = ³84 =³ 99 = º" Scrn2$(13) = "º10=³25 =³40 = <9>³55 = ³70 = ³85 =³100 = º" Scrn2$(14) = "º11 = ³26 =³41 = <0>³56 = ³71 = ³86 =³101 = º" Scrn2$(15) = "º12 = ³27 =³42 = <[>³57 = ³72 = ³87 = ³102 = º" Scrn2$(16) = "º13 = ³28 =³43 = <]>³58 = ³73 = ³88 =³103 = º" Scrn2$(17) = "º14 = ³29 =³44 = <\>³59 = ³74 = ³89 =<@> ³104 = º" Scrn2$(18) = "º15 = ³30=³45 = ³60 = ³75 = ³90 =<#> ³105 = º" Scrn2$(19) = "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄĶ" Scrn2$(20) = "º Select three of the above numbers and enter below. Press each time. º" Scrn2$(21) = "º ÚÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿ º" Scrn2$(22) = "º ³ First ³ ³ ³ Second ³ ³ ³ Third ³ ³ º" Scrn2$(23) = "º ÀÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÙ º" Scrn2$(24) = "º To Go Ahead: To Go Back: <> Or Abort: Press º" Scrn2$(25) = "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" COLOR 15, 1: CLS FOR Scrn2% = 1 TO 25 PRINT Scrn2$(Scrn2%); NEXT COLOR 11, 1 LOCATE 1, 27: PRINT "PASSWORD KEYS"; LOCATE 1, 43: PRINT "F1"; LOCATE 20, 7: PRINT "ÚÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄ¿" LOCATE 21, 7: PRINT "³ First ³ ³ ³ Second ³ ³ ³ Third ³ ³" LOCATE 22, 7: PRINT "ÀÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÙ" COLOR 15, 1 LOCATE 21, 10: PRINT "First"; LOCATE 21, 35: PRINT "Second"; LOCATE 21, 60: PRINT "Third"; COLOR 11, 1 LOCATE 19, 62: PRINT "Enter"; LOCATE 23, 19: PRINT "Enter"; LOCATE 23, 41: PRINT CHR$(24); LOCATE 23, 48: PRINT "PgUp"; LOCATE 23, 71: PRINT "Esc"; RETURN query.box: LOCATE 1, 1, 0, 0, 0 CALL BoxBoy("", 5, 10, 19, 70, 0, 0, 0, 0, 15, 4, 2, 1, 7, 1) Stat1$ = "YOUR PASSWORD INFORMATION IS:" Stat2$ = "Your Password Is : " + PWord$ Stat3$ = "First Key Number Is : " + KyN$(VAL(KeyNum1$)) Stat4$ = "Second Key Number Is : " + KyN$(VAL(KeyNum2$)) Stat5$ = "Third Key Number Is : " + KyN$(VAL(KeyNum3$)) Stat6$ = CHR$(199) + STRING$(60, 196) + CHR$(182) Stat7$ = "IS THIS INFORMATION CORRECT? (Y/N)" COLOR 15, 4 LOCATE 6, 24: PRINT Stat1$; LOCATE 7, 11: PRINT Stat6$; LOCATE 9, 24: PRINT Stat2$; LOCATE 11, 24: PRINT Stat3$; LOCATE 13, 24: PRINT Stat4$; LOCATE 15, 24: PRINT Stat5$; LOCATE 17, 11: PRINT Stat6$; LOCATE 18, 24: PRINT Stat7$; SOUND 100, 2 DO PKey$ = INKEY$ IF PKey$ = "Y" OR PKey$ = "y" THEN GOTO make.password.file ELSEIF PKey$ = "N" OR PKey$ = "n" THEN LOCATE 1, 1, 0, 0, 0 MonoCode% = 0 GOSUB screen.one PMessage$ = "Input Password Here (20 characters or less) :" LOCATE 8, 8, 0, 0, 0: COLOR 15, 1: PRINT PMessage$; PWord$ = "" PWord$ = SPACE$(20) GOTO input.password ELSEIF PKey$ = CHR$(27) THEN GOTO begin END IF LOOP make.password.file: REDIM KeyNum(105) KeyNum(1) = 24064 ' Ctrl - F1 KeyNum(2) = 24320 ' Ctrl - F2 KeyNum(3) = 24576 ' Ctrl - F3 KeyNum(4) = 24832 ' Ctrl - F4 KeyNum(5) = 25088 ' Ctrl - F5 KeyNum(6) = 25344 ' Ctrl - F6 KeyNum(7) = 25600 ' Ctrl - F7 KeyNum(8) = 25856 ' Ctrl - F8 KeyNum(9) = 26112 ' Ctrl - F9 KeyNum(10) = 26368 ' Ctrl - F10 KeyNum(11) = 26624 ' Alt - F1 KeyNum(12) = 26880 ' Alt - F2 KeyNum(13) = 27136 ' Alt - F3 KeyNum(14) = 27392 ' Alt - F4 KeyNum(15) = 27648 ' Alt - F5 KeyNum(16) = 27904 ' Alt - F6 ÿÿ KeyNum(17) = 28160 ' Alt - F7 KeyNum(18) = 28416 ' Alt - F8 KeyNum(19) = 28672 ' Alt - F9 KeyNum(20) = 28928 ' Alt - F10 KeyNum(21) = 21504 ' Shft - F1 KeyNum(22) = 21760 ' Shft - F2 KeyNum(23) = 22016 ' Shft - F3 KeyNum(24) = 22272 ' Shft - F4 KeyNum(25) = 22528 ' Shft - F5 KeyNum(26) = 22784 ' Shft - F6 KeyNum(27) = 23040 ' Shft - F7 KeyNum(28) = 23296 ' Shft - F8 KeyNum(29) = 23552 ' Shft - F9 KeyNum(30) = 23808 ' Shft - F10 KeyNum(31) = 96 ' ` KeyNum(32) = 49 ' 1 KeyNum(33) = 50 ' 2 KeyNum(34) = 51 ' 3 KeyNum(35) = 52 ' 4 KeyNum(36) = 53 ' 5 KeyNum(37) = 54 ' 6 KeyNum(38) = 55 ' 7 KeyNum(39) = 56 ' 8 KeyNum(40) = 57 ' 9 KeyNum(41) = 48 ' 0 KeyNum(42) = 91 ' [ KeyNum(43) = 93 ' ] KeyNum(44) = 92 ' \ KeyNum(45) = 47 ' / KeyNum(46) = 45 ' - KeyNum(47) = 61 ' = KeyNum(48) = 59 ' ; KeyNum(49) = 39 ' ' KeyNum(50) = 65 ' A KeyNum(51) = 66 ' B KeyNum(52) = 67 ' C KeyNum(53) = 68 ' D KeyNum(54) = 69 ' E KeyNum(55) = 70 ' F KeyNum(56) = 71 ' G KeyNum(57) = 72 ' H KeyNum(58) = 73 ' I KeyNum(59) = 74 ' J KeyNum(60) = 75 ' K KeyNum(61) = 76 ' L KeyNum(62) = 77 ' M KeyNum(63) = 78 ' N KeyNum(64) = 79 ' O KeyNum(65) = 80 ' P KeyNum(66) = 81 ' Q KeyNum(67) = 82 ' R KeyNum(68) = 83 ' S KeyNum(69) = 84 ' T KeyNum(70) = 85 ' U KeyNum(71) = 86 ' V KeyNum(72) = 87 ' W KeyNum(73) = 88 ' X KeyNum(74) = 89 ' Y KeyNum(75) = 90 ' Z KeyNum(76) = 18176 ' Home KeyNum(77) = 20224 ' End KeyNum(78) = 20992 ' Ins KeyNum(79) = 21248 ' Del KeyNum(80) = 8 ' BkSp KeyNum(81) = 18688 ' PgUp KeyNum(82) = 20736 ' PgDn KeyNum(83) = 18432 ' UpAr KeyNum(84) = 20480 ' DnAr KeyNum(85) = 19712 ' RtAr KeyNum(86) = 19200 ' LfAr KeyNum(87) = 9 ' Tab KeyNum(88) = 13 ' Entr KeyNum(89) = 64 ' @ KeyNum(90) = 35 ' # KeyNum(91) = 36 ' $ KeyNum(92) = 37 ' % KeyNum(93) = 43 ' + KeyNum(94) = 38 ' & KeyNum(95) = 42 ' * KeyNum(96) = 15104 ' F1 KeyNum(97) = 15360 ' F2 KeyNum(98) = 15616 ' F3 KeyNum(99) = 15872 ' F4 KeyNum(100) = 16128 ' F5 KeyNum(101) = 16384 ' F6 KeyNum(102) = 16640 ' F7 KeyNum(103) = 16896 ' F8 KeyNum(104) = 17152 ' F9 KeyNum(105) = 17408 ' F10 '---------PWord$ password---------------------- EncryptP1$ = CHR$(245) + CHR$(178) + CHR$(205) + CHR$(237) + CHR$(219) EncryptP2$ = CHR$(250) + CHR$(196) + CHR$(145) + CHR$(212) + CHR$(129) '--------KeyNum(VAL(KeyNum1$)) password-------- Encrypt11$ = CHR$(252) + CHR$(185) + CHR$(212) + CHR$(244) + CHR$(228) Encrypt12$ = CHR$(246) + CHR$(192) + CHR$(149) + CHR$(207) + CHR$(224) '--------KeyNum(VAL(KeyNum2$)) password-------- Encrypt21$ = CHR$(253) + CHR$(186) + CHR$(213) + CHR$(245) + CHR$(227) Encrypt22$ = CHR$(245) + CHR$(191) + CHR$(148) + CHR$(206) + CHR$(223) '---------KeyNum(VAL(KeyNum3$)) password------- Encrypt31$ = CHR$(255) + CHR$(188) + CHR$(215) + CHR$(247) + CHR$(229) Encrypt32$ = CHR$(244) + CHR$(190) + CHR$(147) + CHR$(205) + CHR$(222) '---------Encrypt the password---------------- CALL Encrypt(EncryptP1$, PWord$) CALL Encrypt(EncryptP2$, PWord$) '---------Encrypt Key1------------------------ Key1$ = STR$(KeyNum(VAL(KeyNum1$))) CALL Encrypt(Encrypt11$, Key1$) CALL Encrypt(Encrypt12$, Key1$) '---------Encrypt Key2------------------------ Key2$ = STR$(KeyNum(VAL(KeyNum2$))) CALL Encrypt(Encrypt21$, Key2$) CALL Encrypt(Encrypt22$, Key2$) '---------Encrypt Key3------------------------ Key3$ = STR$(KeyNum(VAL(KeyNum3$))) CALL Encrypt(Encrypt31$, Key3$) CALL Encrypt(Encrypt32$, Key3$) '---------Unhide if Exist--------------------- CALL GetFileAttributes(fileName$, result%) 'Set attribute to NOT hidden IF result% = 0 THEN 'File does indeed exist SHELL "ATTRIB" + " " + "-H" + " " + "P------W.---" END IF OPEN "P------W.---" FOR OUTPUT AS #1 PRINT #1, RTRIM$(LTRIM$(PWord$)) PRINT #1, RTRIM$(LTRIM$(Key1$)) PRINT #1, RTRIM$(LTRIM$(Key2$)) PRINT #1, RTRIM$(LTRIM$(Key3$)) CLOSE #1 'Set Attribute as hidden SHELL "ATTRIB" + " " + "+H" + " " + "P------W.---" practice: LOCATE , , 0, 0, 0 CALL BoxBoy("", 9, 12, 14, 66, 0, 0, 0, 0, 15, 1, 2, 1, 7, 1) Set1$ = "SECURE Program is now configured and ready to run." Set2$ = " Press To Exit Program" COLOR 15, 1 LOCATE 10, 15: PRINT Set1$; LOCATE 12, 15: PRINT Set2$; COLOR 11, 1 LOCATE 12, 33: PRINT "Esc"; DO PoundKey$ = INKEY$ IF PoundKey$ = CHR$(27) THEN GOTO leave END IF LOOP view.doc: LOCATE 1, 1, 0, 0, 0 OPEN "ConfigPW.Txt" FOR OUTPUT AS #1 PRINT #1, SPACE$(80) PRINT #1, " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" PRINT #1, " º º" PRINT #1, " º S e c u r e P W P a s s w o r d P r o g r a m º" PRINT #1, " º º" PRINT #1, " º (Version 1.0) º" PRINT #1, " º Public Domain - FreeWare º" PRINT #1, " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" PRINT #1, " º An easy-to-use password program. º" PRINT #1, " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º PUBLIC DOMAIN ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " The SecurePW Program, version 1.0, was created by Don Smith" PRINT #1, " on 09/10/2007 and released to the public domain the same day." PRINT #1, " Anyone may use or distribute this program. It is free," PRINT #1, " Public Domain software." PRINT #1, SPACE$(80) PRINT #1, " This is Version 1.0 of the SecurePW Program. It is based on" PRINT #1, " an earlier program called Secure.Exe, written 08/20/1997," PRINT #1, " which required the use of two special libraries, Pro.Lib and" PRINT #1, " Pdq.Lib from Full Moon Software maintained by Ethan Winer, " PRINT #1, " email: http://www.ehtanwiner.com" PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º FIRST CONFIGURE PROGRAM ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " The SecurePW program will not execute unless it has been" PRINT #1, " pre-configured. To configure the SecurePW Program you" PRINT #1, " must first run a separate program called ConfigPW.Exe," PRINT #1, " which is short for "; Configure; PassWord; ". At the" PRINT #1, " command prompt, type CONFiGPW and press ." PRINT #1, SPACE$(80) PRINT #1, " The configure program will essentially do two things." PRINT #1, " It will establish a password and then it will allow" PRINT #1, " you to set three password keys. The three password keys" PRINT #1, " will allow you to later change your password from within" PRINT #1, " the SecurePW Program. There are 105 keyboard keys which" PRINT #1, " the user may select each of the three times. That means " PRINT #1, " that there are 1,157,625 different password key " PRINT #1, " combinations possible." PRINT #1, SPACE$(80) PRINT #1, " Example: , ,

" PRINT #1, SPACE$(80) PRINT #1, " You MUST remember what your keys are for future reference." PRINT #1, SPACE$(80) PRINT #1, " The password and three password keys are placed in a" PRINT #1, " hidden, double-encrypted, four-line file called " + CHR$(34) + "P------W.---" + CHR$(34) + "." PRINT #1, " In fact, each line is separately double-encrypted for" PRINT #1, " added security. A knowledgeable DOS user may be able to" PRINT #1, " access this hidden file, but would have a tough time" PRINT #1, " deciphering something that looks like this:" PRINT #1, SPACE$(80) PRINT #1, " ÚÜV¯Ä³Û ( Line 1 )" PRINT #1, " áû ½šŽ ( Line 2 )" PRINT #1, " âÖÈçþÇ ( Line 3 )" PRINT #1, " {®ÞÆ×ìî ( Line 4 )" PRINT #1, SPACE$(80) PRINT #1, " Since this hidden file cannot be deleted with DOS's delete" PRINT #1, " command (DEL), the configuration program will allow you to" PRINT #1, " delete the file " + CHR$(34) + "P------W.---" + CHR$(34) + "." PRINT #1, SPACE$(80) PRINT #1, " The Configure program will also permit you to view this file," PRINT #1, " SECUREPW.TXT, on screen." PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º NEW PASSWORD ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " If at a later time, you want to change your password from" PRINT #1, " within the SecurePW program, follow these steps :" PRINT #1, SPACE$(80) PRINT #1, " 1. Enter SECUREPW at the prompt." PRINT #1, SPACE$(80) PRINT #1, " 2. Give an incorrect password so that" PRINT #1, " the error screen will pop up." PRINT #1, SPACE$(80) PRINT #1, " 3. When the error screen appears, press the" PRINT #1, " three password keys which you previously" PRINT #1, " established with the Configure program, as" PRINT #1, " follows :" PRINT #1, SPACE$(80) PRINT #1, " --------------------------------------------" PRINT #1, " Press key(s) one (lift hands off keyboard)" PRINT #1, " --------------------------------------------" PRINT #1, " Press key(s) two (lift hands off keyboard)" PRINT #1, " --------------------------------------------" PRINT #1, " Press key(s) three" PRINT #1, " --------------------------------------------" PRINT #1, SPACE$(80) PRINT #1, " 4. A screen will appear, requesting that you" PRINT #1, " input a new password." PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º HARD DISK ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " For Users Of Win95 And Win98:" PRINT #1, " ----------------------------" PRINT #1, " One of the best uses of the SecurePW Program is to place it in" PRINT #1, " the "; Autoexec.bat; " file on the hard disk drive on your computer." PRINT #1, " When your computer is turned on, one of the first things it looks" PRINT #1, " for is this particular file. To alter your AutoExec.Bat file," PRINT #1, " look for it on the root directory of your hard disk. ALWAYS" PRINT #1, " save this file as a .txt file! When the word SECUREPW is placed" PRINT #1, " on the last line (see below) of this file, the SecurePW program" PRINT #1, " will pop up, requesting a password. Here is an example of an " PRINT #1, " "; Autoexec.bat; " file :" PRINT #1, SPACE$(80) PRINT #1, " @echo off" PRINT #1, " prompt=$p$g" PRINT #1, " path c:\dos" PRINT #1, " SECUREPW" PRINT #1, SPACE$(80) PRINT #1, " The example shown above has the SECUREPW program on the root" PRINT #1, " directory. If the program is placed in a sub-directory," PRINT #1, " then give the complete path on the line above the word SECUREPW." PRINT #1, SPACE$(80) PRINT #1, " Example ->" PRINT #1, " @echo off" PRINT #1, " prompt=$p$g" PRINT #1, " path c:\dos" PRINT #1, " C:\UTILITY\SECUREPW" PRINT #1, " SECUREPW" PRINT #1, SPACE$(80) PRINT #1, " For users Of WinXP:" PRINT #1, " ------------------" PRINT #1, " The best use of SecurePW in an WinXP environment would be to" PRINT #1, " creat a batch file and place it on the desktop. The batch" PRINT #1, " file would first call the SecurePW program and then the" PRINT #1, " targeted program." PRINT #1, SPACE$(80) PRINT #1, " Example: @echo off" PRINT #1, " c:\MyFiles" PRINT #1, " SecurePW.Exe" PRINT #1, " ExecProg.Exe" PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º A VERY SECURE SYSTEM ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " You may opt to delete the file ConfigPW.Exe from your" PRINT #1, " hard disk. In this way, another user cannot fool around" PRINT #1, " with your hidden file. Of course, a back-up copy should" PRINT #1, " be made of ConfigPW.Exe and placed in a separate directory" PRINT #1, " with a changed names. Example: REN ConfigPW.Exe ConfPW.Exe." PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º SEEBEE PROGRAM ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " The ConfigPW.Exe program uses SeeBee.Exe to view this file." PRINT #1, " The SeeBee Program is a stand alone file browser or viewer." PRINT #1, " With this program, a user will able to view really hugh ASCII" PRINT #1, " text files. The largest file I have browsed had over 12" PRINT #1, " Megabytes containing 195985 lines of text." PRINT #1, SPACE$(80) PRINT #1, " To use this program, type : SEEBEE FileName.Ext This program" PRINT #1, " may also be viewed in monochrome by placing an /M after the" PRINT #1, " ASCII filename. Example -> SEEBEE FileName.Ext /M" PRINT #1, SPACE$(80) PRINT #1, " I consider the SeeBee Program to be Public Domain FreeWare." PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º DISCLAIMER ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " The three included stand-alone programs, SECUREPW.EXE," PRINT #1, " CONFIGPW.EXE and SEEBEE.EXE are all Public Domain, FreeWare" PRINT #1, " programs. The author does not warrantee perfection," PRINT #1, " nor does he warrantee much of anything, other than he enjoys" PRINT #1, " writing computer programs for his own use and makes them" PRINT #1, " available to other computer users. But as a practical" PRINT #1, " matter, the author of SECUREPW.EXE, CONFIGPW.EXE and" PRINT #1, " SEEBEE.EXE accepts no liability for damages resulting from" PRINT #1, " their use or misuse. The user in opening and using these" PRINT #1, " programs accepts them in an " + CHR$(34) + "as is" + CHR$(34) + " condition and further" PRINT #1, " accepts full responsibility for them." PRINT #1, SPACE$(80) PRINT #1, " ÖÄÄÄÄÄÄÄÄÄ¿" PRINT #1, " º AUTHOR ³" PRINT #1, " ÓÄÄÄÄÄÄÄÄÄÙ" PRINT #1, " Hello. My name is Don Smith and I am a thirty-year retired" PRINT #1, " teacher of Math/History/Spanish residing in Orange County," PRINT #1, " California. I am also a former six-year Sergeant of Marines." PRINT #1, " Who-Rah! On certain forums I am known as MarineDon. My email" PRINT #1, " is: smithdonb@earthlink.net" PRINT #1, SPACE$(80) PRINT #1, " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" PRINT #1, " º º" PRINT #1, " º Author : Donald Bernard Smith º" PRINT #1, " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" PRINT #1, " º EMail address : smithdonb@earthlink.net º" PRINT #1, " º º" PRINT #1, " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" PRINT #1, SPACE$(80) PRINT #1, " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" PRINT #1, " º - Happy Computing - º" PRINT #1, " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" PRINT #1, SPACE$(80) CLOSE #1 CALL GetFileAttributes("seebee.exe", result%) IF result% = 0 THEN 'file exists SHELL "seebee.exe" + " " + "ConfigPW.Txt" KILL "ConfigPW.Txt" ELSEIF result% > 0 THEN 'file does NOT exist CALL BoxBoy("<<>>", 9, 15, 14, 63, 10, 35, 14, 3, 15, 3, 1, 1, 7, 1) COLOR 15, 3 LOCATE 12, 19: PRINT "Unable to find text file browser: SEEBEE.EXE"; LOCATE 13, 26: COLOR 11, 3: PRINT "- Press Any Key To Continue -"; DO: LOOP WHILE INKEY$ = "" RETURN END IF RETURN REM $DYNAMIC DEFSNG A-Z SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) ' +--------------------------------------------------------------------+ ' | | ' | SUB BoxBoy | ' | | ' +--------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB BoxBoy has 121 lines. | ' +--------------------------------------------------------------------+ ' | Version 1.0 of SUB BoxBoy was written by Don Smith on 03/25/2002. | ' | This is Version 2.0 and it was written on 10/01/2002. Both | ' | versions are declared Public Domain FreeWare. Other programmers | ' | may use this SUB without naming me as the author, and they may | ' | modify the code in any way they see fit. | ' | | ' | Don's EMail: smithdonb@earthlink.net | ' | | ' | This SUB only saves that portion of the underlying screen under | ' | the box and repaints with a shadow. So recommend using the SUB | ' | SaveRestScrn to save/restore the complete screen, or a larger | ' | portion of the screen than the box. | ' +-------------+------------------------------------------------------+ ' | Title$ | The title of the menu. To make a box without a title,| ' | | use: Title$ = "". When there is no Title, the cross | ' | | bar is not deployed. | ' +-------------+------------------------------------------------------+ ' | ULRow% | The upper left row to place the box. | ' +-------------+------------------------------------------------------+ ' | ULCol% | The upper left column to place the box. | ' +-------------+------------------------------------------------------+ ' | LRRow% | The lower right row to place the box. | ' +-------------+------------------------------------------------------+ ' | LRCol% | The lower right column to place the box. | ' +-------------+----------------------------------+-------------------+ ' | TitleRow% | The row to place the title. | If Title$ = "" | ' +-------------+----------------------------------| (or NO title), | ' | TitleCol% | The column to place the title. | report these four | ' +-------------+----------------------------------| values as zero (0)| ' | TitColrFG% | The foreground color of the title| . . . . . . . . | ' +-------------+----------------------------------| Example -> | ' | TitColrBG% | The background color of the title| TitColrFG% = 0 | ' +-------------+----------------------------------+-------------------+ ' | BoxColrFG% | The foreground color of the box itself. | ' +-------------+------------------------------------------------------+ ' | BoxColrBG% | The back ground color of the box. | ' +-------------+------------------------------------------------------+ ' | BoxStyle% | BoxStyle% = 0 (No line around box) | ' | | BoxStyle% = 1 (Single line around box) | ' | | BoxStyle% = 2 (Double line around box) | ' +-------------+------------------------------------------------------+ ' | Shadow% | If Shadow% equals 0, there will be no shadow. | ' | | If Shadow% equals 1, there will be a right shadow. | ' | | If Shadow% equals 2, there will be a left shadow | ' | +------------------------------------------------------+ ' | | NOTE #1: | ' | | ------- | ' | | When a shadow is used, the underlying text will | ' | | be saved and printed with the ShadeColr% (just | ' | | below). This causes the shadow to look like a | ' | | real shadow. | ' | | | ' | | NOTE #2: | ' | | ------- | ' | | If the first four values of BoxBoy are 1, 1, 25, 80, | ' | | in other words a full screen, please set Shadow% = 0;| ' | | otherwise an error will result (no room for shadow). | ' +-------------+------------------------------------------------------+ ' | ShadowColr% | The ShadowColr% is the foreground color of the | ' | | shadow. The background color will always be | ' | | black. Either choose ShadowColr% = 7 or | ' | | ShadowColr% = 8. | ' | | | ' | | ShadowColr% = 7 saves the foreground color and | ' | | changes it to a shade darker, if possible. For | ' | | example, a bright white on blue (COLOR 15, 1) | ' | | becomes dim white on black (COLOR 7, 0). A bright | ' | | blue on blue (COLOR 9, 1) becomes regular blue | ' | | on black (COLOR 1, 0). Very realistic. | ' | | | ' | | ShadowColr% = 8 saves the foreground and reprints | ' | | it as COLOR 8, 0. Darker then ShadowColr% = 7 | ' +-------------+----------------+-------------------------------------+ ' | EdgeYN% | EdgeYN% = 0 | Do NOT print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | EdgeYN% = 1 | YES, DO print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | What does it mean to "print an edge of one space | ' | | with BoxColrFG% color on the right and left edges | ' | | of the box". Well, I will attempt to demonstrate | ' | | by drawing the boxes with non-extended ASCII | ' | | characters. The X's represent a shadow to the | ' | | right. | ' | | | ' | | NO EDGE RIGHT/LEFT 1 SPACE EDGE RIGHT/LEFT | ' | | ~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ | ' | | (EdgeYN% = 0) (EdgeYN% = 1 | ' | | | ' | | +-----------------+ +-------------------+ | ' | | |+---------------+| | +---------------+ | | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | |+---------------+|XX | +---------------+ |XX | ' | | +-----------------+XX +-------------------+XX | ' | | XXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXX | ' | | | ' +-------------+------------------------------------------------------+ IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN IF Shadow% > 0 THEN LRCol% = 78 ELSEIF Shadow% = 0 THEN LRCol% = 79 END IF END IF make.box: IF BoxStyle% = 0 THEN 'No Lines ULCorner$ = CHR$(255) URCorner$ = CHR$(255) HorLine$ = CHR$(255) LeftSide$ = CHR$(255) RightSide$ = CHR$(255) VertLine$ = CHR$(255) LLCorner$ = CHR$(255) LRCorner$ = CHR$(255) ELSEIF BoxStyle% = 1 THEN 'Single Line ULCorner$ = CHR$(218) URCorner$ = CHR$(191) HorLine$ = CHR$(196) LeftSide$ = CHR$(195) RightSide$ = CHR$(180) VertLine$ = CHR$(179) LLCorner$ = CHR$(192) LRCorner$ = CHR$(217) ELSEIF BoxStyle% = 2 THEN 'Double Line ULCorner$ = CHR$(201) URCorner$ = CHR$(187) HorLine$ = CHR$(205) LeftSide$ = CHR$(199) RightSide$ = CHR$(182) VertLine$ = CHR$(186) LLCorner$ = CHR$(200) LRCorner$ = CHR$(188) END IF IF Shadow% > 0 THEN IF EdgeYN% = 1 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 5 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% END IF ELSEIF EdgeYN% = 0 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 3 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% - 1 END IF END IF REDIM ReadLine$(25): REDIM ReadColr%(25, 80) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = LeftLimit% TO RightLimit% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT FOR FindRow% = ULRow% + 1 TO LRRow% + 1 FOR ScrnCol% = LeftLimit% TO RightLimit% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 'make colors less bright IF FGScrnColr% = 0 THEN FGScrnColr% = 7 IF FGScrnColr% = 9 THEN FGScrnColr% = 1 IF FGScrnColr% = 10 THEN FGScrnColr% = 2 IF FGScrnColr% = 11 THEN FGScrnColr% = 3 IF FGScrnColr% = 12 THEN FGScrnColr% = 4 IF FGScrnColr% = 13 THEN FGScrnColr% = 5 IF FGScrnColr% = 14 THEN FGScrnColr% = 7 IF FGScrnColr% = 15 THEN FGScrnColr% = 7 BGScrnColr% = OneColr% \ 16 IF ShadowColr% = 7 THEN COLOR FGScrnColr%, 0 ELSEIF ShadowColr% = 8 THEN COLOR 8, 0 END IF IF Shadow% = 1 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% + 1)); ELSEIF Shadow% = 2 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% - 3)); END IF NEXT NEXT ERASE ReadLine$: ERASE ReadColr% END IF IF EdgeYN% = 1 THEN Edge$ = " " END IF Title.Length% = LEN(Title$) COLOR BoxColrFG%, BoxColrBG% 'ÚÄÄÄ¿ or ÉÍÍÍ» LOCATE ULRow%, ULCol% PRINT Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + Edge$; '³ ³ or º º LOCATE ULRow% + 1, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol% PRINT Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; END IF '³ ³ or º º FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0 PRINT Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + Edge$; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol% COLOR TitColrFG%, TitColrBG% PRINT Title$; END IF END SUB REM $STATIC SUB CMenu (M$(), Row%, Col%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, 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. | ' +--------------+------------------------------------------------------+ ' | RegColrFG% | RegColrFG% is the menu foreground color. | ' +--------------+------------------------------------------------------+ ' | RegColrBG% | RegColrBG% is the menu background color. | ' +--------------+------------------------------------------------------+ ' | HiLiteColr% | HiLiteFG% is foreground color of the hi-lighted | ' | | menu item. Note: I usually set this to 15. | ' +--------------+------------------------------------------------------+ ' | HiLiteBG% | HiLiteBG% is the background color of the hi-lighted | ' | | menu item. Note: I usually set this to 0. | ' +--------------+------------------------------------------------------+ ' | 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% COLOR RegColrFG%, RegColrBG% LOCATE FindRow%, Col%, 0 IF LEFT$(M$(xyz%), 1) = "-" THEN PRINT STRING$(LenLine%, CHR$(196)); ELSE PRINT " " + M$(xyz%) + " "; END IF FindRow% = Row% + (xyz% * SD%) NEXT DO LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 COLOR HiLiteFG%, HiLiteBG% PRINT " " + M$(Selection%) + " "; 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 COLOR RegColrFG%, RegColrBG% PRINT " " + M$(Selection%) + " "; 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 REM $DYNAMIC DEFINT A-Z SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, ExitCode%) STATIC ' +--------------------------------------------------------------------+ ' | SUB EditLoco: | ' +--------------------------------------------------------------------+ ' | This is a version of SUB EditString is called SUB EditLoco. The | ' | SUB EditString is compiled with the Pro.Lib from Cresent SoftWare.| ' | This version, called SUB EditLoco is compiled with regular ol' | ' | QuickBASIC v4.5 and needs no special library. | ' +--------------------------------------------------------------------+ ' | EdW$ | The string to be edited. | ' +--------------+-----------------------------------------------------+ ' | Row% | The row to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | Col% | The column to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | FCol% | Use same number as Col% | ' +--------------+-----------------------------------------------------+ ' | LenStr% | Length of the string to edit. | ' +--------------+-----------------------------------------------------+ ' | See% | If See% = 0 then existing text will be displayed. | ' | | If See% = 1 existing text will be wiped. | ' +--------------+-----------------------------------------------------+ ' | TypeOfText$ | For all ASCII characers 32 to 255, TypeOfText = "" | ' | | For numbers only, TypeOfText$ = "1234567890" | ' | | For numbers with commas and decimals points, | ' | | TypeOfText$ = ".,1234567890" | ' | | For Yes or No answers, TypeOfText$ = "YNyn" | ' | | Whatever is included within the parethesis | ' | | is what will be accepted. | ' +--------------+-----------------------------------------------------+ ' | Caps% | Capital letters enabled, Caps% = 1 | ' +--------------+-----------------------------------------------------+ ' | FGColr% | The text foreground color. | ' +--------------+-----------------------------------------------------+ ' | BGColr% | The text back ground color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | Which keys to enable. To enabled | ' | | and , FKey$ = "150" ("0" is F10). | ' +--------------+-----------------------------------------------------+ ' | PW% | PW% = 1 - password mode enabled. | ' | | PW% = 0 - password mode NOT enabled. | ' +--------------+-----------------------------------------------------+ ' | Ins% | Ins% = 0 then INSERT OFF. Ins% = 1 then INSERT ON | ' +--------------+-----------------------------------------------------+ ' | The ExitCode% is derived from the unique CVI Basic command. | ' | The ExitCode% for the keys gets changed to 101 to 110. | ' | To enable programmers to use the CVI code in their own programs, | ' | I have attached a short program, KeyCode.Bas (just below this | ' | section) | ' +------------------------------------+-------------------------------+ ' | ExitCode% = 101 is F1 key | I arbitrarily changed | ' | ExitCode% = 102 is F2 key | through to 101-110. | ' | ExitCode% = 103 is F3 key | Their CVI Codes are: | ' | ExitCode% = 104 is F4 key +-------------------------------+ ' | ExitCode% = 105 is F5 key | CVI: ExitCode: | ' | ExitCode% = 106 is F6 key | ---- --- -------- | ' | ExitCode% = 107 is F7 key | 15104 101 | ' | ExitCode% = 108 is F8 key | 15360 102 | ' | ExitCode% = 109 is F9 key | 15616 103 | ' | ExitCode% = 110 is F10 key | 15872 104 | ' | ExitCode% = 13 is ENTER key | 16128 105 | ' | ExitCode% = 18432 is Up Arrow | 16384 106 | ' | ExitCode% = 20480 is Down Arrow| 16640 107 | ' | ExitCode% = 9 is TAB key | 16896 108 | ' | ExitCode% = 27 is EXIT key | 17152 109 | ' | | 17408 110 | ' +------------------------------------+-------------------------------+ ' | Please include at the top of the routine DEFINT A-Z | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Use KeyCode.Bas below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +--------------------------------------------------------------------+ ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ EdW$ = "": Ky$ = "" IF See% = 1 THEN LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT STRING$(LenStr%, " "); END IF begin.edit.line: DO IF Ins% = 1 THEN 'Insert On COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 4, 7 ELSEIF Ins% = 0 THEN 'Insert Off COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 6, 7 END IF DO Ky$ = INKEY$ IF PW% = 1 THEN IF BlankIt% = 1 THEN BlankIt% = 0 END IF END IF LOOP UNTIL LEN(Ky$) > 0 SlamKey% = CVI(Ky$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'CHR$(31) to CHR$255) IF TypeOfText$ = "" THEN 'CHR$(32) is IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, Ky$) > 0 THEN IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF END IF END IF ELSEIF SlamKey% = 27 THEN ' Key ExitCode% = 27 GOSUB get.string EXIT SUB ELSEIF SlamKey% = 19712 THEN ' Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN ' Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1