' +---------------------------------------------------------------------+ ' | IMPORTANT NOTE: Instead of copying the basic code from this spot, | ' | it is better to go below and download AB30.ZIP from #43. AB30.ZIP | ' | not only contains the basic of of AddBook.Bas, but the code of | ' | the help file, ABData.BAS | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | | ' | - A d d r e s s B o o k P r o g r a m - | ' | | ' | | ' | Public Domain - FreeWare | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - 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. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | Latest code written by Don Smith Dec. 1, 2004, called Address Book | ' | or AddBook.Exe, the code located in AddBook.Bas | ' | | ' | The Address Book Program is Public Domain and FreeWare. | ' +---------------------------------------------------------------------+ ' | NOTE: This program requires three libraries to compile: | ' | ---- | ' | +----------------+-------------------------------------+ | ' | | 1. BCom45.Lib | QuickBASIC 4.5 Library | | ' | +----------------+-------------------------------------+ | ' | | ' | +----------------+-------------------------------------+ | ' | | 2. Pro.Lib | FULL MOON Libraries of Ethan Winer. | | ' | | 3. Pdq.Lib | http://www.ethanwiner.com | | ' | | | Email: ethan@ethanwiner.com | | ' | +----------------+-------------------------------------+ | ' | | ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a retired Math/History/Spanish | ' | teacher 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. | ' +---------------------------------------------------------------------+ ' | LINK INFO: | ' | | ' | BC : addbook /e /ah | ' | | ' | Link: addbook addbook1 addbook2 /noe (addbook1 = color monitor) | ' | (addbook2 = monochrome | ' | Lib : /seg:500 bcom45 pro pdq monitor) | ' | | ' +---------------------------------------------------------------------+ '$DYNAMIC DEFINT A-Z '------------------------------------------------------------------------ CONST TRUE% = -1 '------------------------------------------------------------------------ DECLARE FUNCTION CountLines% (FileName$, ThatCount%) DECLARE FUNCTION DOSError% () DECLARE FUNCTION ErrorMsg$ (ErrNumber%) DECLARE FUNCTION Exist% (FileName$) DECLARE FUNCTION FileSize& (File$) DECLARE FUNCTION FLInput$ (Handle%, Buffer$) DECLARE FUNCTION GoodDrive% (Drive$) DECLARE FUNCTION LoadExec% (FileName$, CmdLine$) DECLARE FUNCTION LineCount% (FileName$, Buffer$) DECLARE FUNCTION QPLeft$ (FileName$, Spaces%) DECLARE FUNCTION QPLen% (FileName$) DECLARE FUNCTION QPMid$ (Work$, StartChar%, NumChars%) DECLARE FUNCTION QPRight$ (FileName$, Spaces%) DECLARE FUNCTION QPTrim$ (FileName$) DECLARE FUNCTION Rand% (Hi%, Lo%) DECLARE FUNCTION FCount% (Spec$) DECLARE FUNCTION Time2Num& (t$) DECLARE FUNCTION Valid% (FileName$) DECLARE FUNCTION WhichError% () '------------------------------------------------------------------------ DECLARE SUB AMenu (BYVAL Array, StartItem, Count, ScanCode, NormColor, HiLiteColor, NumRows, NumCols, Gap, ULRow, ULCol) DECLARE SUB AddBook1 (MonoCode%) DECLARE SUB Addbook2 (MonoCode%) DECLARE SUB Adjust.Dat.File () DECLARE SUB Border () DECLARE SUB BounceBar (M$(), Start%, MenuRow%, MenuCol%, TotMenuNum%, MenuColrFor%, MenuColrBak%, HiLiteColrFor%, HiLiteColrBak%, NumSpaces%, LtrOrNum%, ExitCode%) DECLARE SUB CheckStatus (ANum%, NDX$, DAT$, ErrExist%) DECLARE SUB ChicoMenu (M$(), Row%, Col%, MenuColr%, HiLiteColr%, HotColr%, MaxItems%, LenLine%, SD%, Selection%, TagKeys$, FKeys$, ExitCode%) DECLARE SUB Chimes (Number%) DECLARE SUB CviCall (HitKey%) DECLARE SUB DataEntry (MenuNames$, DataNames$, Monitor%) DECLARE SUB Delete (Names$(), MenuNames$, DataNames$, Monitor%) DECLARE SUB Edit (Names$(), MenuNames$, DataNames$, Monitor%) DECLARE SUB EditString (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, Trim%, ExitCode%) DECLARE SUB Encrypt (FileName$, PassWord$) DECLARE SUB FileCopy (Source$, Dest$, copied, ErrFlag) DECLARE SUB FillScrn (ULRow, ULCol, LRRow, LRCol, Colr, Char, Page) DECLARE SUB FClose (Handle%) DECLARE SUB FGet (Handle%, Buffer$) DECLARE SUB FileCrypt (FileName$, PWord$, Oops%) DECLARE SUB FCopy (Source$, Dest$, Buffer$, ErrCode%) DECLARE SUB FOpen (FileName$, Handle%) DECLARE SUB Form (Monitor%) DECLARE SUB FPut (Handle%, Buffer$) DECLARE SUB FSeek (Handle%, Done&) DECLARE SUB KillFile (FileName$) DECLARE SUB Message (Monitor%) DECLARE SUB Pause (Ticks) DECLARE SUB ReadFile (BYVAL Address) DECLARE SUB save.screen (NewArray%) DECLARE SUB SetError (ErrCode) DECLARE SUB SortStr2 (BYVAL Address%, NumEls%, Dir%) DECLARE SUB Txt.Edit (Temps$(), FieldRow%, FieldCol%, Flag%, Monitor%, ExitCode%) DECLARE SUB WordWrap (X$, Wide%, PrnRow%, PrnCol%) '------------------------------------------------------------------------ ' ON ERROR GOTO errorhandler ' commence: NoDot% = 0: NoDot2% = 0 DIM Para$(3) DIM Parameter$(3) ComLine$ = COMMAND$ CALL Upper(ComLine$) ComLine$ = QPTrim$(ComLine$) FOR FindSlant% = 1 TO QPLen%(ComLine$) Slant$ = QPMid$(ComLine$, FindSlant%, 1) IF Slant$ = "/" THEN ParaNum% = ParaNum% + 1 IF ParaNum% = 1 THEN FirstSlash% = FindSlant% ELSEIF ParaNum% = 2 THEN SecondSlash% = FindSlant% YesCommand = 1 ELSEIF ParaNum% = 3 THEN ThirdSlash% = FindSlant% ELSEIF ParaNum% = 4 THEN EXIT FOR END IF END IF NEXT IF ParaNum% = 0 THEN MenuNames$ = "MyMenu.Dat" DataNames$ = "MyData.Dat" MenuMirror$ = "MyMenu.Bak" DataMirror$ = "MyData.Bak" PlainDataName$ = "MyData.Tmp" Monitor% = 2 'Monitor% = 1 is monochrome & Monitor% = 2 is color Monitor$ = "2" GOTO color.of.things ELSEIF ParaNum% = 1 THEN Monitor$ = MID$(ComLine$, FirstSlash% + 1, LEN(ComLine$) - FirstSlash%) Monitor$ = QPTrim$(Monitor$) IF Monitor$ <> UCASE$("m") THEN Monitor% = 1 GOTO Parameter.error END IF IF Monitor$ = UCASE$("M") THEN Monitor% = 1 'Monochrome monitor Monitor$ = "1" END IF MenuNames$ = "MyMenu.Dat" DataNames$ = "MYData.Dat" MenuMirror$ = "MyMenu.Bak" DataMirror$ = "MyData.Bak" PlainDataName$ = "MyData.Tmp" CALL CursorOff GOTO color.of.things ELSEIF ParaNum% = 2 THEN MenuNames$ = MID$(ComLine$, FirstSlash% + 1, SecondSlash% - FirstSlash% - 1) MenuNames$ = QPTrim$(MenuNames$) DataNames$ = MID$(ComLine$, SecondSlash% + 1, LEN(ComLine$) - SecondSlash%) DataNames$ = QPTrim$(DataNames$) Monitor% = 2 Monitor$ = "2" IF LEN(MenuNames$) = 1 OR LEN(DataNames$) = 1 THEN GOTO Parameter.error END IF GOSUB check.file.name IF MenuNames$ = "" GOTO Parameter.error IF DataNames$ = "" GOTO Parameter.error ELSEIF ParaNum% = 3 THEN MenuNames$ = MID$(ComLine$, FirstSlash% + 1, SecondSlash% - FirstSlash% - 1) MenuNames$ = QPTrim$(MenuNames$) DataNames$ = MID$(ComLine$, SecondSlash% + 1, ThirdSlash% - SecondSlash% - 1) DataNames$ = QPTrim$(DataNames$) Monitor$ = MID$(ComLine$, ThirdSlash% + 1, LEN(ComLine$) - ThirdSlash%) Monitor$ = QPTrim$(Monitor$) IF Monitor$ <> UCASE$("m") THEN Monitor% = 1 GOTO Parameter.error END IF IF Monitor$ = "M" OR Monitor$ = "m" THEN Monitor% = 1 'Monochrome monitor Monitor$ = "1" ELSE Monitor% = 2 'Color monitor Monitor$ = "2" END IF GOSUB check.file.name END IF color.of.things: Selection% = 1 IF Monitor% = 1 THEN 'Monitor = 1 (Monochrome monitor) C11 = 112 C12 = 112 C14 = 112 C15 = 112 C27 = 112 C28 = 112 C30 = 112 C31 = 112 C62 = 112 C63 = 112 C75 = 112 C78 = 112 C79 = 112 C112 = 112 C113 = 112 C116 = 112 C127 = 112 ClrScrn1 = 15 ClrScrn2 = 0 ELSEIF Monitor% = 2 THEN 'Monitor = 2 (Color Monitor) C11 = 11 C12 = 12 C14 = 14 C15 = 15 C27 = 27 C28 = 28 C30 = 30 C31 = 31 C62 = 62 C63 = 63 C75 = 75 C78 = 78 C79 = 79 C112 = 112 C113 = 113 C116 = 116 C127 = 127 ClrScrn1 = 15 ClrScrn2 = 1 END IF begin: IF MenuNames$ = DataNames$ THEN GOSUB Parameter.error COLOR 7, 0: CLS : END END IF HereTis% = Exist%(DataNames$) IF HereTis% = 0 THEN GOTO thetop 'go to thetop if a brand new file OPEN DataNames$ FOR INPUT AS #1 LINE INPUT #1, CheckTopLine$ IF LEFT$(CheckTopLine$, 10) = " " THEN PointFile% = 2 GOSUB Encrypt IF Oops% = 1 THEN COLOR 15, 1: CLS LOCATE 11, 15: CALL MQPrint("File Exceeds 10000 Lines - Too Big To Encrypt", 15) LOCATE 13, 15: CALL MQPrint("Press To Return", 15) DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN END IF END IF CLOSE #1 OPEN MenuNames$ FOR INPUT AS #1 LINE INPUT #1, CheckTopLine$ IF MID$(CheckTopLine$, 71, 1) = " " THEN PointFile% = 1 GOSUB Encrypt IF Oops% = 1 THEN COLOR 15, 1: CLS LOCATE 11, 15: CALL MQPrint("File Exceeds 10000 Lines - Too Big To Encrypt", 15) LOCATE 13, 15: CALL MQPrint("Press To Return", 15) DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN END IF END IF CLOSE #1 thetop: CALL CursorOff PointFile% = 0 StartTime$ = SPACE$(11) LaterTime$ = SPACE$(11) CALL SysTime(StartTime$) Start& = Time2Num&(StartTime$) CLOSE NamingErr% = 0 CALL CursorOff IF Monitor% = 1 THEN 'BLOAD "c:\dos\program\bsv\addbook2.bsv" ELSEIF Monitor% = 2 THEN 'BLOAD "c:\dos\program\bsv\addbook1.bsv" END IF LOCATE , , 0, 0, 0 MonoCode% = 0 IF Monitor% = 1 THEN CALL Addbook2(MonoCode%) ELSEIF Monitor% = 2 THEN CALL AddBook1(MonoCode%) END IF REDIM M$(1 TO 8) M$(1) = "1. Look Up A Name" M$(2) = "2. Add A Name" M$(3) = "3. Edit A Name" M$(4) = "4. Remove A Name" M$(5) = "5. Print Name(s)" M$(6) = "6. Preview Names" M$(7) = "7. Information" M$(8) = "8. Quit " IF Selection% = 0 THEN Selection% = 1 END IF Row% = 10 Col% = 32 IF Monitor% = 1 THEN MenuColr% = 15 HiLiteColr% = 112 ELSEIF Monitor% = 2 THEN MenuColr% = 112 HiLiteColr% = 15 END IF HotColr% = 0 MaxItems% = 8 LenLine% = 0 SD% = 1 TagKeys$ = "bckmr" FKeys$ = "150" CALL CursorOff CALL ChicoMenu(M$(), Row%, Col%, MenuColr%, HiLiteColr%, HotColr%, MaxItems%, LenLine%, SD%, Selection%, TagKeys$, FKeys$, ExitCode%) CALL CursorOff IF ExitCode% = 27 THEN GOSUB close.program COLOR 7, 0: CLS : END ELSEIF ExitCode% = 1 THEN 'F1 GOSUB f1.pressed GOTO thetop 'goto thetop or program ELSEIF ExitCode% = 5 THEN 'F5 Whiz% = Selection% Selection% = 9 GOSUB f1.pressed Selection% = Whiz% GOTO thetop ELSEIF ExitCode% = 11 THEN 'Page Up PointFile% = 0 Whiz% = Selection% Selection% = 1 GOSUB encrypt.box Selection% = Whiz% GOTO thetop ELSEIF ExitCode% = 12 THEN 'Page Down PointFile% = 0 GOSUB delete.box GOTO thetop ELSEIF ExitCode% = 107 OR ExitCode% = 75 THEN 'k/K Whiz% = Selection% Selection% = 11 GOSUB f1.pressed Selection% = Whiz% GOTO thetop ELSEIF ExitCode% = 114 OR ExitCode% = 82 THEN 'r/R GOSUB Encrypt GOSUB restore.files GOSUB Encrypt GOTO thetop ELSEIF ExitCode% = 98 OR ExitCode% = 66 THEN 'b/B GOSUB blank.it GOTO thetop ELSEIF ExitCode% = 109 OR ExitCode% = 77 THEN 'm/M GOSUB Encrypt GOSUB mirror.files GOSUB Encrypt GOTO thetop ELSEIF ExitCode% = 99 OR ExitCode% = 67 THEN 'c/C GOSUB Encrypt GOSUB saveone GOSUB Encrypt GOTO thetop ELSEIF ExitCode% = 10 THEN 'F10 GOSUB smith.id GOTO thetop END IF IF Selection% = 1 THEN GOSUB dos.naming.rules IF NamingErr% = 1 THEN GOTO thetop GOSUB Encrypt GOTO find ELSEIF Selection% = 2 THEN GOSUB dos.naming.rules IF NamingErr% = 1 THEN GOTO thetop GOSUB Encrypt GOTO DataIn ELSEIF Selection% = 3 THEN GOSUB dos.naming.rules IF NamingErr% = 1 THEN GOTO thetop GOSUB Encrypt GOTO Edit ELSEIF Selection% = 4 THEN GOSUB dos.naming.rules IF NamingErr% = 1 THEN GOTO thetop GOSUB Encrypt GOTO Delete ELSEIF Selection% = 5 THEN GOSUB dos.naming.rules IF NamingErr% = 1 THEN GOTO thetop GOSUB Encrypt GOTO PrintIt ELSEIF Selection% = 6 THEN GOSUB Encrypt GOTO preview ELSEIF Selection% = 7 THEN GOTO info ELSEIF Selection% = 8 THEN GOSUB close.program COLOR 7, 0: CLS : END END IF GOTO thetop dos.naming.rules: OkayM% = Valid%(QPTrim$(MenuNames$)) OkayD% = Valid%(QPTrim$(DataNames$)) IF OkayM% = 0 OR OkayD% = 0 THEN Whizzette% = Selection% Selection% = 10 GOSUB f1.pressed PressDif% = Whizzette% NamingErr% = 1 RETURN ELSE RETURN END IF Parameter.error: COLOR 10, 0: CLS PRINT : PRINT PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" PRINT " º <<< Error >>> º" PRINT " ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹" PRINT " º Parameter Error! Correct usage: º" PRINT " º Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä º" PRINT " º ADDBOOK (use program name by itself, or-) º" PRINT " º ADDBOOK /MenuFile.Txt /DataFile.Txt º" PRINT " º Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä Ä º" PRINT " º For monochrome monitors usage: º" PRINT " º ADDBOOK /M (use program name and /M, or-) º" PRINT " º ADDBOOK /MenuFile.Txt /DataFile.Txt /M º" PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" PRINT " º DOS RULES : Use 1 - 8 letters in the 1st º" PRINT " º section, followed by a dot (.) and no º" PRINT " º more than three letters in the extension. º" PRINT " º The dot and the extension may be omitted. º" PRINT " ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" PRINT " º Press to read ADDBOOK.DOC or press º" PRINT " º to exit. º" PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" PRINT DO CALL CviCall(HitKey%) IF HitKey% = 13 THEN 'enter ThereBrowse = Exist%("ShowOff.Exe") ThereDoc = Exist%("AddBook.Doc") IF ThereBrowse = 0 OR ThereDoc = 0 THEN CALL ClearScr0(5, 20, 11, 62, 12) CALL Box0(5, 20, 11, 62, 1, 12) LOCATE 6, 22 CALL MQPrint("Either the text browser, ShowOff.Exe,", 15) LOCATE 7, 22 CALL MQPrint("or the documentation file, AddBook.Doc,", 15) LOCATE 8, 22 CALL MQPrint("is missing. Sorry!", 15) LOCATE 9, 20 CALL MQPrint("Ã" + STRING$(41, "Ä") + "´", 12) LOCATE 10, 29 CALL MQPrint("- Press Any Key To Exit -", 15) CALL Chime(6) DO: LOOP WHILE INKEY$ = "" COLOR 7, 0: END END IF IF Monitor% = 1 THEN Flame% = LoadExec%("ShowOff.Exe", "AddBook.Doc" + " /M") ELSEIF Monitor% = 2 THEN Flame% = LoadExec%("ShowOff.Exe", "AddBook.Doc") END IF COLOR 7, 0: CLS : END ELSEIF HitKey% = 27 THEN COLOR 7, 0: CLS : END END IF LOOP RETURN check.file.name: FOR CheckDotData% = 1 TO LEN(MenuNames$) Dott$ = MID$(MenuNames$, CheckDotData%, 1) IF Dott$ = "." THEN PlainName$ = MID$(MenuNames$, 1, LEN(MenuNames$) - (LEN(MenuNames$) - CheckDotData% + 1)) DotMenu% = 1 EXIT FOR END IF NEXT IF DotMenu% = 0 THEN PlainName$ = MID$(MenuNames$, 1, LEN(MenuNames$) - (LEN(MenuNames$) - CheckDotData% + 1)) END IF PlainName$ = LEFT$(PlainName$, 8) PlainName$ = QPTrim$(PlainName$) IF PlainName$ = "" THEN GOTO Parameter.error MenuMirror$ = PlainName$ + ".BAK" MenuNames$ = PlainName$ + ".DAT" FOR CheckDotData% = 1 TO LEN(DataNames$) Dott$ = MID$(DataNames$, CheckDotData%, 1) IF Dott$ = "." THEN PlainName$ = MID$(DataNames$, 1, LEN(DataNames$) - (LEN(DataNames$) - CheckDotData% + 1)) DotData% = 1 EXIT FOR END IF NEXT IF DotData% = 0 THEN PlainName$ = MID$(DataNames$, 1, LEN(DataNames$) - (LEN(DataNames$) - CheckDotData% + 1)) END IF PlainName$ = LEFT$(PlainName$, 8) PlainName$ = QPTrim$(PlainName$) IF PlainName$ = "" THEN GOTO Parameter.error DataMirror$ = PlainName$ + ".BAK" DataNames$ = PlainName$ + ".Dat" PlainDataName$ = PlainName$ + ".TMP" RETURN Encrypt: EncryptCount% = 0 IF PointFile% = 1 THEN CurName$ = MenuNames$ EncryptCount% = 2 ELSEIF PointFile% = 2 THEN CurName$ = DataNames$ EncryptCount% = 1 ELSEIF PointFile% = 3 THEN CurName$ = PlainDataName$ EncryptCount% = 3 END IF DO IF PointFile% = 0 THEN EncryptCount% = EncryptCount% + 1 IF EncryptCount% = 1 THEN CurName$ = MenuNames$ ELSEIF EncryptCount% = 2 THEN CurName$ = DataNames$ END IF END IF REDIM FSpec$(10) FSpec$ = "¸†Þ~ÁÌÝű½" CALL FileCrypt(CurName$, FSpec$, Oops%) IF Oops% = 1 THEN COLOR 15, 1: CLS LOCATE 11, 15: CALL MQPrint("File Exceeds 10000 Lines - Too Big To Encrypt", 15) LOCATE 13, 15: CALL MQPrint("Press To Return", 15) DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN END IF LOOP UNTIL EncryptCount% = 2 OR PointFile% = 3 RETURN DataIn: LookMenu% = Exist%(MenuNames$) LookData% = Exist%(DataNames$) IF LookMenu% = 0 OR LookData% = 0 THEN CALL DataEntry(MenuNames$, DataNames$, Monitor%) CLOSE GOSUB Encrypt GOTO thetop ELSEIF LookMenu% = -1 AND LookData% = -1 THEN CALL CheckStatus(4, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(5, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 GOSUB Encrypt GOTO thetop END IF CALL DataEntry(MenuNames$, DataNames$, Monitor%) END IF CLOSE GOSUB Encrypt GOTO thetop Edit: CALL CheckStatus(4, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(5, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 GOSUB Encrypt GOTO thetop END IF REDIM Names$(9) GOSUB getname IF ExitCode% = 27 THEN ExitCode% = 0 'just added ' 'GOSUB Encrypt GOTO thetop ELSEIF ScanCode = 27 THEN ScanCode = 0 'just added ' 'GOSUB Encrypt GOTO thetop ELSEIF NoMatch% = 1 THEN NoMatclh% = 0 DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB Encrypt GOTO thetop END IF CALL Edit(Names$(), MenuNames$, DataNames$, Monitor%) CLOSE GOSUB Encrypt GOTO thetop ' Delete: CALL CheckStatus(4, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(5, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 GOSUB Encrypt GOTO thetop END IF REDIM Names$(9) GOSUB getname IF ScanCode = 27 THEN ScanCode = 0 GOSUB Encrypt GOTO thetop ELSEIF ExitCode% = 27 THEN ExitCode% = 0 GOSUB Encrypt GOTO thetop ELSEIF NoMatch% = 1 THEN NoMatch% = 0 DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB Encrypt GOTO thetop END IF CALL Delete(Names$(), MenuNames$, DataNames$, Monitor%) GOSUB Encrypt GOTO thetop ' PrintIt: CALL CheckStatus(1, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(3, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(4, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(5, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 GOSUB Encrypt GOTO thetop END IF LOCATE , , 0, 0, 0 REDIM Names$(9) Temp% = PressDif% GOSUB PrintData ERASE Names$ LOCATE , , 0, 0, 0 PressDif% = Temp% GOSUB Encrypt Selection% = 5 GOTO thetop ' preview: CALL CheckStatus(2, MenuNames$, DataNames$, ErrExist%) 'CALL CheckStatus(4, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(5, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 GOSUB Encrypt GOTO thetop END IF IF Monitor% = 1 THEN ShowDAT = LoadExec%("showoff.exe", DataNames$ + " /M") ELSEIF Monitor% = 2 THEN ShowDAT = LoadExec%("showoff.exe", DataNames$) END IF GOSUB Encrypt GOTO thetop ' info: CALL CheckStatus(1, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(2, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 GOTO thetop END IF IF Monitor% = 1 THEN ViewAddDoc% = LoadExec%("showoff.exe", "ADDBOOK.DOC" + " /M") ELSEIF Monitor% = 2 THEN ViewAddDoc% = LoadExec%("showoff.exe", "ADDBOOK.DOC") END IF GOTO thetop delete.box: GOSUB show.first.screen ThereGoesData% = Exist%(PlainDataName$) CALL PaintBox0(12, 22, 15, 57, 8) CALL ClearScr0(11, 20, 14, 55, C79) CALL Box0(11, 21, 14, 54, 1, C79) IF ThereGoesData% = 0 THEN LOCATE 12, 23: CALL MQPrint("The file " + PlainDataName$ + " is not on", C79) LOCATE 13, 23: CALL MQPrint("this directory. Press .", C79) LOCATE 13, 46: CALL MQPrint("Esc", C75) LOCATE 12, 32: CALL MQPrint(PlainDataName$, C75) DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN ELSE LOCATE 12, 23: CALL MQPrint("Are you sure you want to delete", C79) LOCATE 13, 23: CALL MQPrint(PlainDataName$ + "?" + " Select Í Y/N", C79) LOCATE 13, 23 + LEN(PlainDataName$): CALL MQPrint("?", C75) LOCATE 13, 23 + LEN(PlainDataName$) + 4: CALL MQPrint("Select", C75) LOCATE 13, 23 + LEN(PlainDataName$) + 14: CALL MQPrint("Y", C75) LOCATE 13, 23 + LEN(PlainDataName$) + 16: CALL MQPrint("N", C75) DO PDN$ = INKEY$ 'press Esc, N or n IF PDN$ = CHR$(27) OR PDN$ = CHR$(78) OR PDN$ = CHR$(110) THEN RETURN ELSEIF PDN$ = CHR$(89) OR PDN$ = CHR$(121) THEN 'N/n EXIT DO END IF LOOP CALL ClearScr0(11, 20, 14, 55, C79) CALL Box0(11, 21, 14, 54, 1, C79) PointFile% = 3: GOSUB Encrypt PointFile% = 0 REDIM PlainIn$(PlainCount% + 1) OPEN PlainDataName$ FOR OUTPUT AS #1 DO PlainCount% = PlainCount% + 1 PRINT #1, STRING$(200, "X") LOOP UNTIL PlainCount% = 200 CLOSE #1 CALL KillFile(PlainDataName$) LOCATE 12, 23: CALL MQPrint("The file " + PlainDataName$ + " has been", C79) LOCATE 13, 23: CALL MQPrint("deleted. Press .", C79) LOCATE 13, 39: CALL MQPrint("Esc", C75) LOCATE 12, 32: CALL MQPrint(PlainDataName$, C75) DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN END IF RETURN encrypt.box: GOSUB show.first.screen IF Monitor% = 1 THEN EnCrypClr% = 15: EnCrypClr2% = 11 ELSEIF Monitor% = 2 THEN EnCrypClr% = 31: EnCrypClr2% = 27 END IF CALL ClearScr0(20, 1, 25, 80, EnCrypClr%) EncryptRun% = LoadExec%("ABData.Exe", " " + "/à" + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) LOCATE 17, 9 'CALL MQPrint(CHR$(195) + STRING$(61, CHR$(196)) + CHR$(180), C79) REDIM M$(2) M$(1) = "Convert " + DataNames$ + " and create: " + PlainDataName$ + " " M$(2) = "Exit without running encryption " Row% = 20 Col% = 18 IF Monitor% = 1 THEN MenuColr% = 112 HiLiteColr% = 15 HotColr% = 0 ELSEIF Monitor% = 2 THEN MenuColr% = 79 HiLiteColr% = 15 END IF MaxItems% = 2 LenLine% = 0 SD% = 1 CALL CursorOff CALL ChicoMenu(M$(), Row%, Col%, MenuColr%, HiLiteColr%, HotColr%, MaxItems%, LenLine%, SD%, Selection%, TagKeys$, FKeys$, ExitCode%) CALL CursorOff IF ExitCode% = 27 THEN RETURN END IF IF Selection% = 1 THEN GOSUB Encrypt CALL FCopy(DataNames$, PlainDataName$, SPACE$(5000), ErrCode%) CALL PaintBox0(11, 16, 18, 69, 8) CALL ClearScr0(10, 14, 17, 67, EnCrypClr%) CALL Box0(10, 15, 17, 66, 2, EnCrypClr%) LOCATE 11, 36: CALL MQPrint("Success!", EnCrypClr%) LOCATE 12, 36: CALL MQPrint(STRING$(8, CHR$(196)), EnCrypClr2%) LOCATE 13, 19: CALL MQPrint("Your temporary non-encrypted file has been", EnCrypClr%) LOCATE 14, 19: CALL MQPrint("created and its name is: " + PlainDataName$, EnCrypClr%) LOCATE 14, 44: CALL MQPrint(PlainDataName$, EnCrypClr2%) LOCATE 15, 15: CALL MQPrint(CHR$(199) + STRING$(50, CHR$(196)) + CHR$(182), EnCrypClr%) LOCATE 16, 27: CALL MQPrint("Press to exit routine.", EnCrypClr%) LOCATE 16, 34: CALL MQPrint("Esc", EnCrypClr2%) DO: LOOP UNTIL INKEY$ = CHR$(27) GOSUB Encrypt RETURN ELSEIF Selection% = 2 THEN RETURN END IF RETURN f1.pressed: Help = Selection% f1PressedRun% = LoadExec%("ABData.Exe", " " + "/á" + STR$(Selection%) + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) IF Selection% > 0 AND Selection% < 11 THEN f1PressedRun% = LoadExec%("ABData.Exe", " " + "/á" + STR$(Selection%) + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) ELSEIF Selection% = 11 THEN f1PressedRun% = LoadExec%("ABData.Exe", " " + "/á11" + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) END IF DO DO PressKey$ = INKEY$ LOOP UNTIL PressKey$ <> "" HelpKey% = CVI(PressKey$ + CHR$(0)) IF Help = 11 THEN 'Selection% = Help IF HelpKey% = 99 OR HelpKey% = 67 THEN 'c/C Selection% = PressDif% GOSUB show.first.screen GOSUB saveone RETURN 'K/k/2 ELSEIF HelpKey% = 75 OR HelpKey% = 107 OR HelpKey% = 50 THEN CALL PaintBox0(7, 21, 14, 63, 8) CALL ClearScr0(6, 19, 13, 61, C31) CALL Box0(6, 20, 13, 60, 1, C31) Line$ = "Ã" + STRING$(39, CHR$(196)) + "´" LOCATE 7, 36: CALL MQPrint("­ Oops !", C30) LOCATE 8, 20: CALL MQPrint(Line$, C31) LOCATE 9, 25: CALL MQPrint("You are already looking at the", C31) LOCATE 10, 25: CALL MQPrint("Special Keys window right now!", C31) LOCATE 11, 20: CALL MQPrint(Line$, C31) LOCATE 12, 28: CALL MQPrint("(Press To Continue)", C30) DO: LOOP UNTIL INKEY$ = CHR$(27) Help = 11 Selection% = 11 GOTO f1.pressed ELSEIF HelpKey% = 109 OR HelpKey% = 77 THEN 'm/M Selection% = PressDif% GOSUB show.first.screen GOSUB mirror.files RETURN ELSEIF HelpKey% = 114 OR HelpKey% = 82 THEN 'r/R Selection% = PressDif% GOSUB show.first.screen GOSUB restore.files RETURN ELSEIF HelpKey% = 98 OR HelpKey% = 66 THEN 'b/B Selection% = PressDif% GOTO blank.it GOTO thetop ELSEIF HelpKey% = 16128 THEN 'F5 GOSUB show.first.screen IF Help = 11 THEN LOCATE 2, 10 CALL MQPrint(STRING$(61, " "), C31) LOCATE 3, 71: CALL MQPrint(" ", C31) Selection = 9 GOSUB f1.pressed Selection% = PressDif% RETURN ELSE Selection = 9 GOSUB f1.pressed Selectionl% = PressDif% RETURN END IF ELSEIF HelpKey% = 17408 THEN 'F10 GOSUB show.first.screen GOSUB smith.id Selection% = PressDif% RETURN ELSEIF HelpKey% = 18688 THEN 'PageUp GOSUB encrypt.box Selection% = PressDif% RETURN ELSEIF HelpKey% = 20736 THEN 'PageDn GOSUB delete.box Selection% = PressDif% RETURN ELSEIF HelpKey% = 13 OR HelpKey% = 49 THEN 'Enter/1 CALL CheckStatus(1, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(2, MenuNames$, DataNames$, ErrExist%) IF ErrExist% = 1 OR ErrExist% = 2 THEN ErrExist% = 0 RETURN END IF IF Monitor% = 1 THEN ViewHelp% = LoadExec%("showoff.exe", "addbook.doc" + " /M") ELSEIF Monitor% = 2 THEN ViewHelp% = LoadExec%("showoff.exe", "addbook.doc") END IF Selection% = PressDif% RETURN ELSEIF HelpKey% = 27 OR HelpKey% = 51 THEN 'Esc/3 Selection% = PressDif% RETURN END IF 'work here: ELSEIF HelpKey% = 89 OR HelpKey% = 121 THEN 'Y/y COLOR 7, 0: CLS : END ELSEIF HelpKey% = 78 OR HelpKey% = 110 THEN 'N/n Selection% = PressDif% RETURN ELSEIF HelpKey% = 51 OR HelpKey% = 27 THEN '3/esc RETURN ELSEIF HelpKey% = 13 OR HelpKey% = 49 THEN 'enter/1 CALL CheckStatus(1, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(2, MenuNames$, DataNames$, ErrExist%) IF ErrExist% = 1 OR ErrExist% = 2 THEN ErrExist% = 0 RETURN END IF IF Monitor% = 1 THEN ReadInfoFile = LoadExec%("showoff.Exe", "AddBook.Doc" + " /M") ELSEIF Monitor% = 2 THEN ReadInfoFile = LoadExec%("showoff.Exe", "AddBook.Doc") END IF RETURN ELSEIF HelpKey% = 107 OR HelpKey% = 75 OR HelpKey% = 50 THEN 'k/K/2 Selection% = 11 GOTO f1.pressed END IF LOOP LOCATE , , 1 RETURN show.first.screen: IF Monitor% = 1 THEN 'BLOAD "c:\dos\program\bsv\addbook2.bsv" CALL Addbook2(MonoCode%) ELSEIF Monitor% = 2 THEN 'BLOAD "c:\dos\program\bsv\addbook1.bsv" CALL AddBook1(MonoCode%) END IF RETURN save.screen: REDIM ScrnArray%(3000) CALL ScrnSave0(1, 1, 25, 80, SEG ScrnArray%(1)) RETURN restore.screen: CALL ScrnRest0(1, 1, 25, 80, SEG ScrnArray%(1)) ERASE ScrnArray% RETURN blank.it: GOSUB save.screen Message1$ = "SCREEN BLANKED TO PROTECT MONITOR. PRESS TO EXIT. " Message2$ = "* ADDRESS BOOK *" Row% = 3: Col% = 12 Halt = 0 COLOR 0, 0, 0: CLS DO LOCATE Row%, Col% + 1, 0, 0, 0 CALL Box0(Row% - 2, Col% - 2, Row% + 1, Col% + 59, 2, 7) CALL MQPrint(Message1$, 7) LOCATE Row% - 1, 32: CALL MQPrint(Message2$, 14) DO WHILE Halt < 270 EscKey$ = INKEY$ CALL Pause(1) IF EscKey$ = CHR$(27) THEN GOSUB restore.screen RETURN END IF Halt = Halt + 1 LOOP CALL ClearScr0(1, 1, 25, 80, 0) Row% = Row% + 3 IF Row% > 23 THEN Row% = 3 END IF Halt = 0 LOOP close.program: CALL FCopy(MenuNames$, MenuMirror$, SPACE$(4096), ErrCode%) CALL FCopy(DataNames$, DataMirror$, SPACE$(4096), ErrCode%) RETURN saveone: EdW$ = "" 'CALL ClearScr0(21, 1, 25, 80, C31) CALL PaintBox0(5, 12, 17, 74, 8) CALL ClearScr0(4, 9, 16, 72, C79) CALL Box0(4, 10, 16, 71, 1, C79) SMessage$ = "Give Drive and Path to place the two backup files." TMessage$ = "Please end with a back slash (\). The two files which" UMessage$ = "will be copied are:" LOCATE 5, 14: CALL MQPrint(SMessage$, C79) LOCATE 6, 14: CALL MQPrint(TMessage$, C79) LOCATE 7, 14: CALL MQPrint(UMessage$, C79) LOCATE 7, 34: CALL MQPrint("(1) (2)", C79) LOCATE 7, 38: CALL MQPrint(MenuNames$, C75) LOCATE 7, 55: CALL MQPrint(DataNames$, C75) LOCATE 8, 10: CALL MQPrint(CHR$(195) + STRING$(60, CHR$(196)) + CHR$(180), C79) LOCATE 9, 14: CALL MQPrint("Examples: (1) To a floppy -" + CHR$(16) + " A:\", C79) LOCATE 10, 25: CALL MQPrint("(2) To hard disk -" + CHR$(16) + " C:\MYFILES\", C79) CALL Box0(11, 15, 13, 66, 1, C79) LOCATE 14, 14 CALL MQPrint("Press after typing in the Drive and Path or", C79) LOCATE 15, 14 CALL MQPrint("press at any time to return to the Main Menu.", C79) LOCATE 14, 21: CALL MQPrint("Enter", C75) LOCATE 15, 21: CALL MQPrint("Esc", C75) copy.one.path: Row% = 12: Col% = 17: FCol% = 17: See% = 1: Trim% = 1 LenStr% = 48: TypeOfText$ = "": Caps% = 1: Colr% = C79 CALL EditString(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, Trim%, ExitCode%) IF ExitCode% = 13 THEN IF EdW$ = "" THEN CALL PaintBox0(9, 15, 14, 69, 8) CALL ClearScr0(8, 12, 13, 67, C112) CALL Box0(8, 13, 13, 66, 1, C112) LOCATE 9, 34: CALL MQPrint("<<< Error >>>", C116) LOCATE 10, 13: CALL MQPrint(CHR$(195) + STRING$(52, 196) + CHR$(180), C112) LOCATE 11, 24: CALL MQPrint("No Drive/Path was given!", C112) LOCATE 12, 24, 0, 0, 0 CALL MQPrint("Press to return to Main Menu", C112) LOCATE 12, 31, 0, 0, 0: CALL MQPrint("Esc", C113) CALL Chime(6) DO IF INKEY$ = CHR$(27) THEN RETURN END IF LOOP END IF GOTO continue.copy.one ELSEIF ExitCode% = 27 THEN LOCATE 1, 1, 0, 0, 0 EdW$ = "" RETURN END IF continue.copy.one: IF Monitor% = 1 THEN 'BLOAD "c:\dos\program\bsv\addbook2.bsv" CALL Addbook2(MonoCode%) ELSEIF Monitor% = 2 THEN 'BLOAD "c:\dos\program\bsv\addbook1.bsv" CALL AddBook1(MonoCode%) END IF CALL PaintBox0(8, 15, 17, 70, 8) CALL ClearScr0(7, 13, 16, 68, C63) CALL Box0(7, 14, 16, 67, 1, C63) LOCATE 9, 16, 0, 0, 0 CALL MQPrint("Backing up: (1) " + MenuNames$ + " and (2) " + DataNames$, C63) Line$ = CHR$(195) + STRING$(52, 196) + CHR$(180) LOCATE 10, 14, 0, 0, 0: CALL MQPrint(Line$, C63) CLOSE 'here DestNDX$ = EdW$ + MenuNames$ OPEN MenuNames$ FOR INPUT AS #2 OPEN DestNDX$ FOR OUTPUT AS #5 DO WHILE NOT EOF(2) LINE INPUT #2, NDXLine$ PRINT #5, NDXLine$ LOOP CLOSE #2: CLOSE #5: CLOSE DestDAT$ = EdW$ + DataNames$ OPEN DataNames$ FOR INPUT AS #9 OPEN DestDAT$ FOR OUTPUT AS #10 DO WHILE NOT EOF(9) LINE INPUT #9, DATLine$ PRINT #10, DATLine$ LOOP CLOSE #9: CLOSE #10: CLOSE LOCATE 12, 27: CALL MQPrint("Two (2) files were copied.", C63) LOCATE 14, 14: CALL MQPrint(Line$, C63) LOCATE 15, 27: CALL MQPrint("Press To Continue.", C63) LOCATE 15, 34, 0, 0, 0: CALL MQPrint("Esc", C63) DO IF INKEY$ = CHR$(27) THEN LOCATE 1, 1, 0, 0, 0 RETURN END IF LOOP RETURN restore.files: RestoreRun% = LoadExec%("ABData.Exe", " " + "/ã" + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) RETURN mirror.files: RestoreRun% = LoadExec%("ABData.Exe", " " + "/ä" + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) RETURN smith.id: IF Monitor% = 1 THEN CALL ClearScr0(20, 1, 25, 80, 15) ELSEIF Monitor% = 2 THEN CALL ClearScr0(20, 1, 25, 80, 31) END IF RestoreRun% = LoadExec%("ABData.Exe", " " + "/å" + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) CALL CviCall(HitKey%) IF HitKey% = 27 THEN RETURN ELSE GOTO smith.id END IF find: CALL CheckStatus(4, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(5, MenuNames$, DataNames$, ErrExist%) IF ErrExist% = 4 OR ErrExist% = 5 THEN ErrExist% = 0 GOTO thetop END IF REDIM Names$(9) GOSUB getname IF ScanCode = 27 THEN ScanCode = 0 GOSUB Encrypt GOTO thetop ELSEIF ExitCode% = 27 THEN ExitCode% = 0 GOSUB Encrypt GOTO thetop END IF DO: LOOP WHILE INKEY$ = "" ERASE Names$ GOSUB Encrypt GOTO thetop getname: IF Monitor% = 1 THEN COLOR 15, 0: CLS ELSEIF Monitor% = 2 THEN COLOR 15, 1: CLS END IF CALL PaintBox0(15, 16, 21, 68, 8) CALL ClearScr0(14, 14, 20, 66, C63) CALL Box0(14, 15, 20, 65, 1, C63) LOCATE 15, 31: CALL MQPrint("<<< Please Read >>>", C62) LOCATE 16, 15: CALL MQPrint("Ã" + STRING$(49, "Ä") + "´", C63) LOCATE 17, 19 CALL MQPrint("Just enter the first letter of the last name,", C63) LOCATE 18, 19: CALL MQPrint("or press to view all the names. To", C63) LOCATE 19, 19: CALL MQPrint("exit without viewing, press .", C63) LOCATE 18, 29: CALL MQPrint("Enter", C62) LOCATE 19, 48: CALL MQPrint("Esc", C62) CALL PaintBox0(7, 16, 12, 68, 8) CALL ClearScr0(6, 14, 11, 66, C112) CALL Box0(6, 15, 11, 65, 2, C112) CALL Box0(8, 21, 10, 63, 1, C112) LOCATE 7, 17: CALL MQPrint("What Is The First Letter Of The Last Name?", C112) IF soundout = 1 THEN soundout = soundout + 1 END IF LastName$ = "" CALL EditString(LastName$, 9, 23, 23, 38, 1, "", 1, C112, "", 1, ExitCode%) IF ExitCode% = 27 THEN RETURN ELSEIF LastName$ = "" THEN GOTO loop.all.names END IF LastName$ = QPTrim$(LastName$) CountNDX% = LineCount%(MenuNames$, SPACE$(5000)) CountDAT% = LineCount%(DataNames$, SPACE$(5000)) OPEN MenuNames$ FOR INPUT AS #2 loop.last.names: NumNum% = 0 REDIM Array$(CountNDX%) WHILE NOT EOF(2) LINE INPUT #2, FindInitial$ FindInitial$ = QPTrim$(FindInitial$) IF LEFT$(LastName$, 1) = LEFT$(FindInitial$, 1) THEN NumNum% = NumNum% + 1 Array$(NumNum%) = FindInitial$ END IF WEND FOR Splice% = 1 TO NumNum% Array$(Splice%) = Array$(Splice%) + SPACE$(42 - LEN(Array$(Splice%))) NEXT CountNDX% = NumNum% CLOSE #2 IF Array$(1) = "" THEN GOSUB no.file.error NoMatch% = 1 RETURN END IF GOTO continue.names loop.all.names: AllN% = 0: CountNDX% = 0: ERASE Array$ CountNDX% = LineCount%(MenuNames$, SPACE$(5000)) IF CountNDX% >= 1000 THEN CountNDX% = 1000 END IF REDIM Array$(CountNDX% + 1) OPEN MenuNames$ FOR INPUT AS #8 FOR AllN% = 1 TO CountNDX% IF EOF(8) THEN EXIT FOR LINE INPUT #8, Array$(AllN%) IF Array$(AllN%) = "" THEN EXIT FOR Array$(AllN%) = Array$(AllN%) + STRING$(42 - QPLen%(Array$(AllN%)), " ") NEXT CLOSE #8 continue.names: StartItem = 1 NormColor = 112 HiLiteColor = 15 NumRows = 15 NumCols = 1 Gap = 1 ULRow = 5 ULCol = 19 GOSUB get.name.window: LOCATE , , 0, 0, 0 show.all.names: DO CALL AMenu(VARPTR(Array$(1)), StartItem, CountNDX%, ScanCode, NormColor, HiLiteColor, NumRows, NumCols, Gap, ULRow, ULCol) IF ScanCode = 27 THEN CountNDX% = 0 CountDAT% = 0 NumNum = 0 AllN% = 0 ERASE Array$ ERASE Names$ 'GOSUB Encrypt RETURN ELSEIF ScanCode = 13 THEN Array$(CountNDX%) = QPTrim$(Array$(CountNDX%)) GOTO get.names.information ELSE ScanCode = 3 END IF LOOP get.names.information: REDIM Names$(9) OPEN DataNames$ FOR INPUT AS #3 WHILE NOT EOF(3) LINE INPUT #3, Names$ Names$ = QPTrim$(Names$) IF Names$ = Array$(CountNDX%) THEN xxx = 1 Names$(xxx) = Names$ xxx = 2 FOR Please% = 1 TO 5 xxx = xxx + 1 LINE INPUT #3, Names$(xxx) Names$(xxx) = QPMid$(Names$(xxx), 21, 42) NEXT GOTO get.one.name.info END IF WEND get.one.name.info: CLOSE #3 IF Names$(1) = "" THEN Unable = 1 GOSUB no.file.error DO: LOOP UNTIL INKEY$ = CHR$(27) GOTO thetop END IF FOR NN% = 1 TO LEN(Names$(1)) SplitName$ = MID$(Names$(1), NN%, 1) IF SplitName$ = "," THEN Names$(8) = QPTrim$(QPRight$(Names$(1), LEN(Names$(1)) - NN%)) Names$(9) = QPTrim$(QPLeft$(Names$(1), NN% - 1)) EXIT FOR END IF NEXT Names$(1) = Names$(8) Names$(2) = Names$(9) CALL Form(Monitor%) IF Monitor% = 1 THEN CALL ClearScr0(25, 1, 25, 80, 15) LOCATE 25, 26: CALL MQPrint("- Press Any Key To Continue -", 11) ELSEIF Monitor% = 2 THEN CALL ClearScr0(25, 1, 25, 80, 79) LOCATE 25, 26: CALL MQPrint("- Press Any Key To Continue -", 79) END IF FOR PlaceInfo% = 1 TO 7 LOCATE PlaceInfo% + 7, 30 IF Names$(PlaceInfo%) <> "(Blank Line)" AND Names$(PlaceInfo%) <> "" THEN IF Monitor% = 1 THEN CALL MQPrint(Names$(PlaceInfo%), 11) ELSEIF Monitor% = 2 THEN CALL MQPrint(Names$(PlaceInfo%), 63) END IF END IF NEXT CountNDX% = 0 CountDAT% = 0 NumNum = 0 AllN% = 0 ERASE Array$ RETURN get.name.window: IF Monitor% = 1 THEN CALL ClearScr0(1, 1, 25, 80, 15) ELSEIF Monitor% = 2 THEN CALL ClearScr0(1, 1, 25, 80, 31) END IF GOSUB bottom.note CALL PaintBox0(3, 19, 21, 64, 8) CALL ClearScr0(2, 17, 20, 62, C112) CALL Box0(2, 18, 20, 61, 1, C112) 'box for names LOCATE 4, 18: CALL MQPrint("Ã" + STRING$(42, "Ä") + "´", C112) LOCATE 3, 19: CALL MQPrint(" Select a file <> <> and press ", C113) LOCATE 3, 53: CALL MQPrint("<", 127): LOCATE 3, 59: CALL MQPrint(">", C127) LOCATE 3, 36: CALL MQPrint("", 127): LOCATE 3, 40: CALL MQPrint("", C127) RETURN bottom.note: Bott$ = " MOVE: <" + CHR$(24) + "> <" + CHR$(25) + "> NEXT PAGE: <-> BACK PAGE: <-> QUIT: " LOCATE 25, 1: CALL MQPrint(Bott$, C79) LOCATE 25, 5: CALL MQPrint("MOVE", C75) LOCATE 25, 24: CALL MQPrint("NEXT PAGE", C75) LOCATE 25, 45: CALL MQPrint("BACK PAGE", C75) LOCATE 25, 66: CALL MQPrint("QUIT", C75) RETURN no.file.error: CALL PaintBox0(10, 21, 16, 61, 8) CALL ClearScr0(9, 19, 15, 59, C79) CALL Box0(9, 20, 15, 58, 1, C79) LOCATE 13, 20: CALL MQPrint("Ã" + STRING$(37, "Ä") + "´", C79) LOCATE 10, 34: CALL MQPrint("<<< Oops! >>>", C75) IF Unable = 0 THEN LOCATE 11, 23: CALL MQPrint("Unable to find any names beginning", C79) LOCATE 12, 23: CALL MQPrint(" with that letter.", C79) ELSEIF Unable = 1 THEN 'Array$(CountNDX) LOCATE 11, 23: CALL MQPrint("Unable to find that name in the", C79) LOCATE 12, 23: CALL MQPrint(DataNames$ + " file. Does not exist.", C79) Unable = 0 END IF LOCATE 14, 29: CALL MQPrint("Press To Continue", C79) LOCATE 14, 36, 0, 0, 0: CALL MQPrint("ESC", C75) ERASE Array$ RETURN PrintData: IF Monitor% = 1 THEN ClrColr% = 0 ELSEIF Monitor% = 2 THEN ClrColr% = 31 END IF ERASE M$ REDIM M$(1 TO 4) M$(1) = "1. Print information on one name. " M$(2) = "2. Print information on all names. " M$(3) = "3. Print documentation file: ADDBOOK.DOC" M$(4) = "4. Return to Main Menu " 'Different set of colors than main menu. CALL ClearScr0(21, 1, 25, 80, ClrColr%) CALL PaintBox0(8, 17, 17, 67, 8) CALL ClearScr0(7, 15, 16, 65, C79) CALL Box0(7, 16, 16, 64, 1, C79) LOCATE 8, 30: CALL MQPrint("<<< PRINT ROUTINE >>>", C75) LOCATE 9, 16: CALL MQPrint("Ã" + STRING$(47, "Ä") + "´", C79) LOCATE 10, 21: CALL MQPrint("Select Below -", C75) LOCATE 11, 16: CALL MQPrint("Ã" + STRING$(47, "Ä") + "´", C79) Row% = 12 Col% = 20 IF Monitor% = 1 THEN MenuColr% = 112 HiLiteColr% = 15 ELSEIF Monitor% = 2 THEN MenuColr% = 79 HiLiteColr% = 15 HotColr% = 75 END IF Selection% = 1 MaxItems% = 4 LenLine% = 0 SD% = 1 CALL CursorOff CALL ChicoMenu(M$(), Row%, Col%, MenuColr%, HiLiteColr%, HotColr%, MaxItems%, LenLine%, SD%, Selection%, TagKeys$, FKeys$, ExitCode%) CALL CursorOff IF ExitCode% = 27 THEN RETURN END IF IF Selection% = 1 THEN GOTO onename ELSEIF Selection% = 2 THEN GOTO allnames ELSEIF Selection% = 3 THEN CALL CheckStatus(1, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(3, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 RETURN END IF ShowDocFile% = LoadExec%("PrintIt.Exe", "addbook.doc") Selection% = 5 RETURN ELSEIF Selection% = 4 THEN Selection% = 5 RETURN ELSE GOTO PrintData END IF onename: GOSUB getname IF ExitCode% = 27 THEN RETURN ELSEIF ScanCode = 27 THEN RETURN ELSEIF NoMatch% = 1 THEN NoMatch% = 0 DO: LOOP UNTIL INKEY$ = CHR$(27) RETURN END IF TheFirstName$ = Names$(2) TheFirstName$ = QPTrim$(TheFirstName$) TheLastName$ = Names$(1) TheLastName$ = QPTrim$(TheLastName$) LenFirst% = LEN(TheFirstName$) LenLast% = LEN(TheLastName$) LenOfNames% = LenFirst% + LenLast% + 2 OPEN "ONENAME.TXT" FOR OUTPUT AS #12 PRINT #12, SPACE$(60) PRINT #12, SPACE$(60) PRINT #12, SPACE$(60) PRINT #12, SPACE$(60) PRINT #12, SPACE$(30) + Names$(2) + ", " + Names$(1) PRINT #12, SPACE$(30); STRING$(LenOfNames%, "-") FOR DoPrnRest% = 3 TO 7 PRINT #12, SPACE$(30) + Names$(DoPrnRest%) NEXT 'PRINT #12, CHR$(12) CLOSE #12 LoadUpOne = LoadExec%("PrintIt.Exe", "ONENAME.TXT") CALL KillFile("ONENAME.TXT") LOCATE , , 0, 0, 0 RETURN allnames: BringPrintDoc = LoadExec%("PrintIt.Exe", DataNames$) ViewIt% = 0 LOCATE , , 0, 0, 0 RETURN errorhandler: PickErr% = ERR PickErr$ = STR$(PickErr%) PickErr$ = QPTrim$(PickErr$) ErrorRun% = LoadExec%("ABData.EXE", " /" + CHR$(232) + PickErr$ + " /" + MenuNames$ + " /" + DataNames$ + " /" + Monitor$) CALL CviCall(HitKey%) IF HitKey% = 27 THEN COLOR 7, 0: CLS : END ELSEIF HitKey% = 13 THEN RESUME thetop END IF REM $STATIC SUB CheckStatus (Trial%, MenuNames$, DataNames$, ErrExist%) STATIC ' ' Trial% = 1 check if AddBook.Doc exists. ErrExist% = 1 ' Trial% = 2 check if Showoff.Exe exists. ErrExist% = 2 ' Trial% = 3 check if PrintIt.Exe exists. ErrExist% = 3 ' Trial% = 4 check if MyMenu.Dat exists. ErrExist% = 4 ' Trial% = 5 check if MyData.Dat exists. ErrExist% = 5 ' ' ' Message1$ = "" IF Trial% = 1 THEN CheckDoc = Exist%("AddBook.Doc") IF CheckDoc = 0 THEN Message1$ = "AddBook.Doc" GOSUB show.error ErrExist% = 1 DO: LOOP UNTIL INKEY$ = CHR$(27) EXIT SUB END IF ELSEIF Trial% = 2 THEN CheckShowOff = Exist%("ShowOff.Exe") IF CheckShowOff = 0 THEN Message1$ = "ShowOff.Exe" GOSUB show.error ErrExist% = 2 DO: LOOP UNTIL INKEY$ = CHR$(27) EXIT SUB END IF ELSEIF Trial% = 3 THEN CheckPrintDoc = Exist%("PrintIt.Exe") IF CheckPrintDoc = 0 THEN Message1$ = "PrintIt.Exe" GOSUB show.error ErrExist% = 3 DO: LOOP UNTIL INKEY$ = CHR$(27) EXIT SUB END IF ELSEIF Trial% = 4 THEN CheckNamesNDX = Exist%(MenuNames$) IF CheckNamesNDX = 0 THEN Message1$ = MenuNames$ + " File!" GOSUB show.error ErrExist% = 4 DO: LOOP UNTIL INKEY$ = CHR$(27) EXIT SUB END IF ELSEIF Trial% = 5 THEN CheckNamesDAT = Exist%(DataNames$) IF CheckNamesDAT = 0 THEN Message1$ = DataNames$ + " File" GOSUB show.error ErrExist% = 5 DO: LOOP UNTIL INKEY$ = CHR$(27) EXIT SUB END IF ELSE EXIT SUB END IF EXIT SUB show.error: CALL Box0(9, 20, 14, 60, 1, 15) CALL ClearScr0(10, 21, 13, 59, 15) LOCATE 12, 20: CALL MQPrint("Ã" + STRING$(39, "Ä" + "´"), 15) LOCATE 10, 34: CALL MQPrint("<<< ERROR >>>", 12) IF Trial% = 1 OR Trial% = 2 OR Trial% = 3 THEN LOCATE 11, 27 ELSEIF Trial% = 4 OR Trial% = 5 THEN LOCATE 11, 23 END IF CALL MQPrint("Unable To Find: " + Message1$, 15) LOCATE 13, 30: CALL MQPrint("Press To Continue", 15) LOCATE 13, 37, 0, 0, 0: CALL MQPrint("ESC", 11) RETURN END SUB DEFSNG A-Z SUB ChicoMenu (M$(), Row%, Col%, MenuColr%, HiLiteColr%, HotColr%, MaxItems%, LenLine%, SD%, Selection%, TagKeys$, FKeys$, ExitCode%) ' +---------------------------------------------------------------------+ ' | "Chico" means little or tiny in Spanish. I first developed this | ' | menu while revising PrintDoc.Bas, on 03/21/2002. This particular | ' | version of Chico Menu is designed to be linked to BCom45.Lib. | ' | Pro.Lib and PDQ.Lib. | ' | | ' | One limitation to Chico Menu is that the numbers and/or letters | ' | which proceed each menu item can only be one digit, which means: | ' | 1234567890, a-r, A-R. Only 84 lines of code are used with this | ' | fairly sophisitcated menu. | ' +---------------------------------------------------------------------+ ' | SUB ChicoMenu is a Public Domain FreeWare program by Don Smith, | ' | EMail: smithdonb@earthlink.net | ' | Today's Date: 12/20/2005. | ' +---------------------------------------------------------------------+ ' +--------------+------------------------------------------------------+ ' | 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. | ' +--------------+------------------------------------------------------+ ' | MenuColr% | The menu color stated as one single number. | ' +--------------+------------------------------------------------------+ ' | HiLiteColr% | The hi light color stated as one single number. | ' +--------------+------------------------------------------------------+ ' | HotColr% | The color of the number and/or letter | ' +--------------+------------------------------------------------------+ ' | 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. | ' | | | ' | | ChicoMenu 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). | ' | | | ' +--------------+------------------------------------------------------+ ' | TagKeys$ | These are keys that the user presses to reach | ' | | a routine. | ' | | Example only - TagKey$ = "ka" | ' | | If user presses "k" a screen | ' | | pops up with Keys Routine. | ' | | If user presses "a" a screen | ' | | appears with Auther info. | ' +--------------+------------------------------------------------------+ ' | FKeys$ | Indicates which keys to turn "on". | ' | | | ' | | Example: FKeys$ = "150" This set up will turn | ' | | "on" . The "0" of "150" | ' | | means . | ' +--------------+------------------------------------------------------+ ' | 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. | ' +--------------+------------------------------------------------------+ 'The next 3 lines configure FirstKeys$, which are the leading 'character in each menu item: FOR Jefe% = 1 TO MaxItems% FirstKeys$ = FirstKeys$ + LEFT$(RTRIM$(LTRIM$(M$(Jefe%))), 1) NEXT FirstKeys$ = UCASE$(FirstKeys$) LetrOrNum% = 0 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)), MenuColr%) ELSE IF HotColr% = 0 THEN CALL MQPrint(" " + M$(xyz%) + " ", MenuColr%) ELSEIF HotColr% > 0 THEN CALL MQPrint(" " + M$(xyz%) + " ", MenuColr%) LOCATE FindRow%, Col%, 0 CALL MQPrint(" " + MID$(HotKey$, xyz%, 1), HotColr%) END IF END IF FindRow% = Row% + (xyz% * SD%) NEXT DO RR% = Row% + (Selection% * SD%) - SD% LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 CALL MQPrint(" " + M$(Selection%) + " ", HiLiteColr%) IF HotColr% > 0 THEN LOCATE Row% + (Selection% * SD%) - SD%, Col% + 1 SpotColr% = HotColr% - 48 IF SpotColr% < 1 THEN SpotColr% = HotColr% CALL MQPrint(MID$(HotKey$, Selection%, 1), SpotColr%) END IF 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(FirstKeys$, UCASE$(k$)) IF LetrOrNum% > 0 THEN ExitCode% = k% Selection% = VAL(k$) EXIT SUB END IF IncludeKeys% = INSTR(UCASE$(TagKeys$), UCASE$(k$)) IF IncludeKeys% > 0 THEN 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% > 15103 AND k% < 17409 THEN 'F1 - F10 IdentKey$ = STR$(((k% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKeys$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF ELSEIF k% = 18688 THEN ' ExitCode% = 11 EXIT SUB ELSEIF k% = 20736 THEN ' ExitCode% = 12 EXIT SUB END IF LOOP up.or.down: LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 CALL MQPrint(" " + M$(Selection%) + " ", MenuColr%) IF HotColr% > 0 THEN CALL MQPrint(" " + MID$(HotKey$, Selection%, 1), HotColr%) END IF 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 FUNCTION CountLines% (FileName$, ThatCount%) OPEN FileName$ FOR INPUT AS #30 WHILE NOT EOF(30) LINE INPUT #30, SoSo$ ThatCount% = ThatCount% + 1 WEND END FUNCTION SUB CviCall (HitKey%) DO HitKey$ = INKEY$ LOOP UNTIL LEN(HitKey$) > 0 HitKey% = CVI(HitKey$ + CHR$(0)) END SUB SUB DataEntry (MenuNames$, DataNames$, Monitor%) IF Monitor% = 1 THEN C27% = 112: C31% = 15: C75% = 112: C78% = 112: C79% = 112: C12% = 12 C112% = 112: C113% = 112: C116% = 112: C15% = 15: C1% = 0 ELSEIF Monitor% = 2 THEN C27% = 27: C31% = 31: C75% = 75: C78% = 78: C79% = 79: C12% = 12 C112% = 112: C113% = 113: C116% = 116: C15% = 15: C1% = 1 END IF REDIM Temps$(8) begin.editing: FirstCountNDX% = LineCount%(MenuNames$, SPACE$(5000)) IF FirstCountNDX% > 1000 THEN CALL PaintBox0(3, 17, 17, 70, 8) CALL ClearScr0(2, 15, 16, 68, C79%) CALL Box0(2, 16, 16, 67, 2, C79%) Line$ = "Ç" + STRING$(50, "Ä") + "¶" LOCATE 3, 35: CALL MQPrint("<<< Oops! >>>", C75%) LOCATE 4, 16: CALL MQPrint(Line$, C79%) LOCATE 5, 19: CALL MQPrint("You have" + STR$(FirstCountNDX%) + " name entries. There may be no", C79%) LOCATE 6, 19 CALL MQPrint("more than 1000 name records in one Address", C79%) LOCATE 7, 19 CALL MQPrint("Book. To input more names, make other Address", C79%) LOCATE 8, 19 CALL MQPrint("Books by using other file names. For example,", C79%) LOCATE 9, 19 CALL MQPrint("instead of MyMenu.Dat, use MARYMENU.Dat and", C79%) LOCATE 10, 19 CALL MQPrint("instead of using MyData.Dat use MARYDATA.Dat.", C79%) LOCATE 11, 19 CALL MQPrint("Place these at the command prompt like this -", C79%) LOCATE 12, 23 CALL MQPrint("ADDBOOK /MARYMENU.DAT /MARYDATA.DAT", C79%) LOCATE 12, 23: CALL MQPrint("ADDBOOK", C75%) LOCATE 12, 32: CALL MQPrint("MARYMENU.DAT", C75%) LOCATE 12, 46: CALL MQPrint("MARYDATA.DAT", C75%) LOCATE 13, 19 CALL MQPrint("Please press and read: ADDBOOK.DOC", C79%) LOCATE 13, 33: CALL MQPrint("Enter", C75%) LOCATE 13, 50: CALL MQPrint("ADDBOOK.DOC", C78%) LOCATE 14, 16: CALL MQPrint(Line$, C79%) LOCATE 15, 20 CALL MQPrint("- Press To Return To The Main Menu -", C79%) LOCATE 15, 29: CALL MQPrint("Esc", C75%) DO CALL CviCall(HitKey%) IF HitKey% = 27 THEN 'esc EXIT SUB ELSEIF HitKey% = 13 THEN 'enter CALL CheckStatus(1, MenuNames$, DataNames$, ErrExist%) CALL CheckStatus(2, MenuNames$, DataNames$, ErrExist%) IF ErrExist% > 0 THEN ErrExist% = 0 EXIT SUB ELSE IF Monitor% = 1 THEN ShowDoc% = LoadExec%("showoff.exe", "addbook.doc" + " /M") ELSEIF Monitor% = 2 THEN ShowDoc% = LoadExec%("showoff.exe", "addbook.doc") END IF EXIT SUB END IF END IF LOOP END IF IF Monitor% = 1 THEN COLOR 15, 0: CLS ELSEIF Monitor% = 2 THEN COLOR 15, 1: CLS END IF CALL Message(Monitor%) COLOR 0, 3 CALL Form(Monitor%) call.on.editstring: CALL Txt.Edit(Temps$(), 9, 30, 1, Monitor%, ExitCode%) IF ExitCode% = 27 THEN EXIT SUB END IF IF Temps$(1) = "" AND Temps$(2) = "" THEN Empty = 1 GOTO name.error END IF CALL ClearScr0(20, 1, 26, 80, C31%) CALL PaintBox0(22, 33, 24, 52, 8) CALL ClearScr0(21, 31, 23, 50, C79%) CALL Box0(21, 32, 23, 49, 1, C79%) LOCATE 22, 34: CALL MQPrint("Correct (Y/N)?", C79%) LOCATE 22, 43: CALL MQPrint("Y", C75%) LOCATE 22, 45, 0, 0, 0: CALL MQPrint("N", C75%) DO DO PoundKey$ = INKEY$ LOOP UNTIL LEN(PoundKey$) > 0 PoundKey% = CVI(PoundKey$ + CHR$(0)) IF PoundKey% = 121 OR PoundKey% = 89 THEN 'y/Y ThereMenu = Exist%(MenuNames$) IF ThereMenu = 0 THEN OPEN MenuNames$ FOR OUTPUT AS #1 PRINT #1, CLOSE #1 END IF ThereMenu = Exist%(DataNames$) IF ThereMenu = 0 THEN OPEN DataNames$ FOR OUTPUT AS #2 PRINT #2, CLOSE #2 END IF GOTO check.name ELSEIF PoundKey% = 110 OR PoundKey% = 78 THEN 'n/N CALL ClearScr0(21, 1, 25, 80, C31%) CALL Message(Monitor%) GOTO call.on.editstring ELSEIF PoundKey% = 27 THEN EXIT SUB END IF LOOP check.name: IF QPTrim$(Temps$(2)) = "" THEN Empty = 1 GOTO name.error END IF CountNDX = LineCount%(MenuNames$, SPACE$(5000)) OPEN MenuNames$ FOR INPUT AS #5 FOR FeedLot% = 1 TO CountNDX LINE INPUT #5, FindName$ FindName$ = QPTrim$(FindName$) IF FindName$ = Temps$(2) + ", " + Temps$(1) THEN Empty = 2 CLOSE #5 GOTO name.error END IF NEXT CLOSE #5 GOTO add.new.info name.error: GOSUB save.Screen2 CALL PaintBox0(9, 17, 14, 67, 8) CALL ClearScr0(8, 15, 13, 65, C112%) CALL Box0(8, 15, 13, 65, 2, C112%) LOCATE 9, 33: CALL MQPrint("<<< Error >>>", C116%) LOCATE 10, 19, 0, 0, 0 IF Empty = 1 THEN CALL MQPrint("Cannot enter a blank name. To try again,", C112%) ELSEIF Empty = 2 THEN CALL MQPrint("That name is already on file. To try again,", C112%) END IF Empty = 0 LOCATE 11, 19, 0, 0, 0 CALL MQPrint("press . To return to the Main Menu,", C112%) LOCATE 12, 19, 0, 0, 0: CALL MQPrint("press .", C112%) LOCATE 11, 26, 0, 0, 0 CALL MQPrint("Enter", C113%) LOCATE 12, 26, 0, 0, 0: CALL MQPrint("Esc", C113%) Empty = 0 DO DO Strike$ = INKEY$ LOOP UNTIL LEN(Strike$) > 0 Strike% = CVI(Strike$ + CHR$(0)) IF Strike% = 27 THEN GOSUB restore.screen2 GOTO enddataentry ELSEIF Strike% = 13 THEN GOSUB restore.screen2 CALL ClearScr0(21, 1, 25, 80, C31%) CALL Message(Monitor%) GOTO call.on.editstring END IF LOOP add.new.info: DATName$ = DataNames$ NDXName$ = MenuNames$ SortNDX$ = "sortndx.txt" ThereMenu = Exist(NDXName$) OPEN NDXName$ FOR APPEND AS #7 PRINT #7, Temps$(2) + ", "; Temps$(1) CLOSE #7 sort.str: IF FRE("") < 2048 THEN MemMessage$ = " Not enough memory to sort this file. Press . " CALL Box0(10, 14, 12, 68, 2, C12%) LOCATE 11, 15: CALL MQPrint(MemMessage$, C12%) CALL Chime(6) DO: LOOP UNTIL INKEY$ = CHR$(C27%) CLOSE EXIT SUB END IF Lines% = LineCount%(NDXName$, SPACE$(4096)) 'count the number of lines REDIM SortA$(1 TO Lines%) 'make an array to hold it OPEN NDXName$ FOR INPUT AS #8 'read the file into an array Lines% = 0 WHILE NOT EOF(8) Lines% = Lines% + 1 LINE INPUT #8, SortA$(Lines%) SortA$(Lines%) = QPTrim$(SortA$(Lines%)) WEND Start = 1 'specify sorting the whole array Size% = Lines% Dir% = 0 CALL SortStr2(VARPTR(SortA$(Start)), Size%, Dir%) OPEN SortNDX$ FOR OUTPUT AS #10 FOR SortX% = 1 TO Size% OutFile$ = (QPLeft$(SortA$(SortX%), 80)) IF OutFile$ <> "" THEN PRINT #10, OutFile$ END IF NEXT CLOSE #8 CLOSE #10 ERASE SortA$ Lines% = 0 CALL KillFile(NDXName$) CALL FCopy(SortNDX$, NDXName$, SPACE$(5000), ErrCode%) 'CALL FCopy(SortNDX$, MenuMirror$, SPACE$(5000), ErrCode%) CALL KillFile(SortNDX$) CountNDX = LineCount%(MenuNames$, SPACE$(5000)) CountDAT = LineCount%(DataNames$, SPACE$(5000)) OPEN MenuNames$ FOR INPUT AS #11 FOR NamNDXCount% = 1 TO CountNDX LINE INPUT #11, NameOfName$ CNDX% = CNDX% + 1 'CNDX% shows what line number IF NameOfName$ = Temps$(2) + ", " + Temps$(1) THEN EXIT FOR END IF NEXT CLOSE #11 OPEN DataNames$ FOR INPUT AS #12 OPEN "names2.dat" FOR OUTPUT AS #14 WHILE NOT EOF(12) LINE INPUT #12, NameOfDAT$ CheckTitle$ = QPLeft$(NameOfDAT$, 12) CheckTitle$ = QPTrim$(CheckTitle$) IF CheckTitle$ <> "" THEN CDAT% = CDAT% + 1 IF CDAT% = CNDX% THEN 'FOR Zap7% = 1 TO 7 'pass up 7 lines on input file ' IF EOF(12) THEN EXIT FOR ' LINE INPUT #12, NameOfDAT$ 'NEXT PRINT #14, SPACE$(11) + Temps$(2) + ", " + Temps$(1) FOR Spot6% = 1 TO 6 PRINT #14, SPACE$(20) + Temps$(Spot6% + 2) NEXT END IF END IF PRINT #14, NameOfDAT$ WEND IF CDAT% < CNDX% THEN PRINT #14, SPACE$(60) PRINT #14, SPACE$(11) + Temps$(2) + ", " + Temps$(1) FOR SpotMe% = 3 TO 7 PRINT #14, SPACE$(20) + Temps$(SpotMe%) NEXT END IF CLOSE #12: CLOSE #14 CALL KillFile(DataNames$) CALL FCopy("names2.dat", DataNames$, SPACE$(5000), ErrCode%) 'CALL FCopy("names2.dat", DataMirror$, SPACE$(5000), ErrCode%) CALL KillFile("names2.dat") ERASE Temps$ NamNDXCount% = 0 NameOfName$ = "" CNDX% = 0 CDAT% = 0 NameOfDAT$ = "" CheckTitle$ = "" FindComma$ = "" GivenName$ = "" Strike$ = "" DATName$ = "" NDXName$ = "" enddataentry: EXIT SUB save.Screen2: REDIM NewArray%(3000) CALL ScrnSave0(1, 1, 25, 80, SEG NewArray%(1)) RETURN restore.screen2: CALL ScrnRest0(1, 1, 25, 80, SEG NewArray%(1)) ERASE NewArray% RETURN END SUB SUB Delete (Names$(), MenuNames$, DataNames$, Monitor%) IF Monitor% = 1 THEN C31% = 15: C27% = 11: C63% = 11 ELSEIF Monitor% = 2 THEN C31% = 31: C27% = 27: C63% = 63 END IF CALL Form(Monitor%) CALL ClearScr0(22, 1, 25, 80, C31%) CALL ClearScr0(23, 26, 25, 52, C31%) CALL Box0(23, 28, 25, 51, 1, C31%) LOCATE 24, 31: CALL MQPrint("Press Y, N or ", C31%) LOCATE 24, 37: CALL MQPrint("Y", C27%) LOCATE 24, 40: CALL MQPrint("N", C27%) LOCATE 24, 46: CALL MQPrint("Esc", C27%) FOR DelName% = 1 TO 7 IF Names$(DelName%) <> "(Blank Line)" THEN LOCATE DelName% + 7, 30 CALL MQPrint(Names$(DelName%), C63%) END IF NEXT place.top.part: IF Monitor% = 1 THEN C63% = 15 ELSEIF Monitor% = 2 THEN C63% = 63 END IF LOCATE 5, 12: CALL MQPrint(" " + "É" + STRING$(56, "Í") + "»" + " ", C63%) LOCATE 6, 12 CALL MQPrint(" " + "º" + STRING$(56, " ") + "º" + " ", C63%) LOCATE 7, 13: CALL MQPrint("Ì" + STRING$(56, "Í") + "¹", C63%) LOCATE 6, 30: CALL MQPrint("Delete this Name (Y/N)?", C63%) DO CALL CviCall(HitKey%) IF HitKey% = 110 OR HitKey% = 78 OR HitKey% = 27 THEN 'n/N/Esc EXIT SUB ELSEIF HitKey% = 121 OR HitKey% = 89 THEN 'y/Y GOTO delete.process END IF LOOP delete.process: OPEN MenuNames$ FOR INPUT AS #20 OPEN "bobo.txt" FOR OUTPUT AS #22 wipe.out.one.name.ndx: WHILE NOT EOF(20) LINE INPUT #20, ReadNDX$ WhereWipe% = WhereWipe% + 1 ReadNDX$ = QPTrim$(ReadNDX$) Special$ = QPTrim$(Names$(2) + ", " + Names$(1)) IF ReadNDX$ <> Special$ THEN PRINT #22, ReadNDX$ ELSEIF ReadNDX$ = Special$ THEN DisIsItNDX% = WhereWipe% END IF WEND CLOSE #20: CLOSE #22 CALL KillFile(MenuNames$) CALL FCopy("bobo.txt", MenuNames$, SPACE$(5000), ErrCode%) 'CALL FCopy("bobo.txt", MenuMirror$, SPACE$(5000), ErrCode%) CALL KillFile("bobo.txt") wipe.out.one.name.dat: OPEN DataNames$ FOR INPUT AS #12 OPEN "tonto.dat" FOR OUTPUT AS #14 WHILE NOT EOF(12) LINE INPUT #12, NameOfDAT$ SpecialName$ = QPTrim$(NameOfDAT$) IF SpecialName$ = Names$(2) + ", " + Names$(1) THEN FOR Sixer% = 1 TO 6 IF EOF(12) THEN EXIT FOR LINE INPUT #12, ThrowAway$ NEXT ELSE PRINT #14, NameOfDAT$ END IF WEND last.step: CLOSE #12: CLOSE #14 CALL KillFile(DataNames$) CALL FCopy("tonto.dat", DataNames$, SPACE$(5000), ErrCode%) 'CALL FCopy("tonto.dat", DataMirror$, SPACE$(5000), ErrCode%) CALL KillFile("tonto.dat") NamNDXCount% = 0 NameOfName$ = "" CNDX% = 0 CDAT% = 0 NameOfDAT$ = "" CheckTitle$ = "" FindComma$ = "" GivenName$ = "" Strike$ = "" DATName$ = "" NDXName$ = "" 'ERASE TrueNDX$ WhereWipe% = 0 END SUB SUB Edit (Names$(), MenuNames$, DataNames$, Monitor%) IF Monitor% = 1 THEN C1% = 0: C12% = 112: C15% = 15: C31% = 0 C63% = 11: C75% = 11: C79% = 11 ELSEIF Monitor% = 2 THEN C1% = 1: C12% = 12: C15% = 15: C31% = 31 C63% = 63: C75% = 75: C79% = 79 END IF begin.edit.routine: COLOR C15%, C1%: CLS CALL Message(Monitor%) COLOR 0, 3 CALL Form(Monitor%) bring.in.names: FOR BeginNames% = 1 TO 7 LOCATE BeginNames% + 7, 30 IF Names$(BeginNames%) <> "(Blank Line)" THEN CALL MQPrint(Names$(BeginNames%), C63%) END IF NEXT edit.lines: REDIM Temps$(8) CALL Txt.Edit(Temps$(), 9, 35, 0, Monitor%, ExitCode%) IF ExitCode% = 27 THEN EXIT SUB END IF CALL ClearScr0(20, 1, 26, 80, C31%) CALL PaintBox0(22, 33, 24, 52, 8) CALL ClearScr0(21, 31, 23, 50, C79%) IF Monitor% = 1 THEN CALL Box0(21, 32, 23, 49, 1, 15) ELSEIF Monitor% = 2 THEN CALL Box0(21, 32, 23, 49, 1, 79) END IF LOCATE 22, 34: CALL MQPrint("Correct (Y/N)?", C79%) IF Monitor% = 1 THEN LOCATE 22, 43: CALL MQPrint("Y", 15) LOCATE 22, 45, 0, 0, 0: CALL MQPrint("N", 15) ELSEIF Monitor% = 2 THEN LOCATE 22, 43: CALL MQPrint("Y", 75) LOCATE 22, 45, 0, 0, 0: CALL MQPrint("N", 75) END IF DO DO PoundKey$ = INKEY$ LOOP UNTIL LEN(PoundKey$) > 0 PoundKey% = CVI(PoundKey$ + CHR$(0)) IF PoundKey% = 121 OR PoundKey% = 89 THEN 'y/Y GOTO remove.old.name ELSEIF PoundKey% = 110 OR PoundKey% = 78 THEN 'n/N CALL ClearScr0(20, 1, 26, 80, C31%) CALL Message(Monitor%) GOTO edit.lines 'GOTO begin.edit.routine ELSEIF PoundKey% = 27 THEN 'Esc EXIT SUB END IF LOOP remove.old.name: CountDAT% = LineCount%(DataNames$, SPACE$(5000)) CountNDX% = LineCount%(MenuNames$, SPACE$(5000)) OPEN MenuNames$ FOR INPUT AS #7 OPEN "names.txt" FOR OUTPUT AS #8 FOR CheckNDX% = 1 TO CountNDX% IF EOF(7) THEN EXIT FOR END IF LINE INPUT #7, ReadNDX$ ReadNDX$ = QPTrim$(ReadNDX$) Special$ = Names$(2) + ", " + Names$(1) Special$ = QPTrim$(Special$) IF ReadNDX$ <> Special$ THEN PRINT #8, ReadNDX$ END IF NEXT PRINT #8, Temps$(2) + ", " + Temps$(1) CLOSE #7: CLOSE #8 CALL KillFile(MenuNames$) CALL FCopy("names.txt", MenuNames$, SPACE$(5000), ErrCode%) 'CALL FCopy("names.txt", MenuMirror$, SPACE$(5000), ErrCode%) CALL KillFile("names.txt") sort.edit.str: IF FRE("") < 2048 THEN MemMessage$ = " Not enough memory to sort this file. Press . " CALL Box0(10, 14, 12, 68, 2, C12) LOCATE 11, 15: CALL MQPrint(MemMessage$, C12%) CALL Chime(6) DO: LOOP UNTIL INKEY$ = CHR$(27) CLOSE EXIT SUB END IF Lines% = LineCount%(MenuNames$, SPACE$(4096)) 'count the number of lines REDIM SortA$(Lines%) 'make an array to hold it OPEN MenuNames$ FOR INPUT AS #9 'read the file into an array 'OPEN "names.txt" FOR APPEND AS #32 'OPEN "names.txt" FOR INPUT AS #9 Lines% = 0 WHILE NOT EOF(9) Lines% = Lines% + 1 LINE INPUT #9, SortA$(Lines%) SortA$(Lines%) = QPTrim$(SortA$(Lines%)) WEND Start = 1 'specify sorting the whole array Size% = Lines% Dir% = 0 CALL SortStr2(VARPTR(SortA$(Start)), Size%, Dir%) OPEN "sortndx.txt" FOR OUTPUT AS #10 FOR SortX% = 1 TO Size% OutFile$ = (QPLeft$(SortA$(SortX%), 80)) PRINT #10, OutFile$ NEXT CLOSE #9 CLOSE #10 ERASE SortA$ Lines% = 0 CALL KillFile(MenuNames$) CALL KillFile("names.txt") CALL FCopy("sortndx.txt", MenuNames$, SPACE$(3000), ErrCode%) 'CALL FCopy("sortndx.txt", MenuMirror$, SPACE$(5000), ErrCode%) CALL KillFile("sortndx.txt") CountNDX% = LineCount%(MenuNames$, SPACE$(5000)) CountDAT% = LineCount%(DataNames$, SPACE$(5000)) OPEN MenuNames$ FOR INPUT AS #11 FOR NamNDXCount% = 1 TO CountNDX% IF EOF(11) THEN EXIT FOR END IF LINE INPUT #11, NameOfName$ CNDX% = CNDX% + 1 IF NameOfName$ = Temps$(2) + ", " + Temps$(1) THEN EXIT FOR END IF NEXT CLOSE #11 OPEN DataNames$ FOR INPUT AS #12 OPEN "names2.txt" FOR OUTPUT AS #14 WHILE NOT EOF(12) LINE INPUT #12, NameOfDAT$ SpecialName$ = QPTrim$(NameOfDAT$) IF SpecialName$ = Names$(2) + ", " + Names$(1) THEN FOR Sixer% = 1 TO 6 IF EOF(12) THEN EXIT FOR LINE INPUT #12, ThrowAway$ NEXT ELSE PRINT #14, NameOfDAT$ END IF WEND CLOSE #12: CLOSE #14 OPEN "names2.txt" FOR INPUT AS #12 OPEN "names4.txt" FOR OUTPUT AS #14 WHILE NOT EOF(12) LINE INPUT #12, NameOfDAT$ CheckDaName$ = QPLeft$(NameOfDAT$, 12) CheckDaName$ = QPTrim$(CheckDaName$) IF QPLen%(CheckDaName$) > 0 THEN CDAT% = CDAT% + 1 IF CDAT% = CNDX% THEN ImputNew% = 1 PRINT #14, SPACE$(10) + Temps$(2) + ", " + Temps$(1) FOR Fiver% = 3 TO 7 PRINT #14, SPACE$(20) + Temps$(Fiver%) NEXT PRINT #14, SPACE$(60) END IF END IF PRINT #14, NameOfDAT$ WEND IF ImputNew% = 0 THEN PRINT #14, SPACE$(60) PRINT #14, SPACE$(10) + Temps$(2) + ", " + Temps$(1) FOR Fiver% = 3 TO 7 PRINT #14, SPACE$(20) + Temps$(Fiver%) NEXT PRINT #14, SPACE$(60) END IF ImputNew% = 0 CLOSE #12: CLOSE #14 CALL KillFile(DataNames$) CALL FCopy("names4.txt", DataNames$, SPACE$(5000), ErrCode%) CALL KillFile("names2.txt") CALL KillFile("names4.txt") CountNDX% = 0 CountDAT% = 0 CheckNDX% = 0 ReadNDX$ = "" ERASE Temps$ NamNDXCount% = 0 NameOfName$ = "" CNDX% = 0 CDAT% = 0 NameOfDAT$ = "" CheckTitle$ = "" FindComma$ = "" GivenName$ = "" Strike$ = "" DATName$ = "" NDXName$ = "" ERASE SortA$ END SUB REM $DYNAMIC DEFINT A-Z SUB EditString (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, Trim%, ExitCode%) STATIC ' +---------------------------------------------------------------------+ ' | Explanation of SUB EditString : | ' | ----------------------------- | ' | EdW$ = The string to be edited. | ' | Row% = The row to begin the editing. | ' | Col% = The column to begin the editing. | ' | FCol% = The column of very first character to | ' | be edited. Should be the same as Col%. | ' | LenStr% = Length of the string to edit. | ' | See% = If See% = 0 then existing text will be displayed. | ' | If See% = 1 existing text will be wiped. | ' | TypeOfText$ = For all ASCII characers 32 to 255, TypeOfText = "" | ' | For numbers only, TypeOfText$ = "1234567890" | ' | For numbers with commas and decimals points, | ' | TypeOfText$ = ".,1234567890" | ' | For Yes or No answers, TypeOfText$ = "YNyn" | ' | Whatever is included within the parethesis | ' | is what will be accepted. | ' | Caps% = Capital letters enabled, Caps% =1 | ' | Colr% = Color of text must be one number representing | ' | both foreground and background. | ' | FKey$ = What F keys to enable. To enabled F keys 1, | ' | 5 and 10, FKey$ = "150" ("0" is F10). | ' | ExitCode% = 1 is F1 key | ' | ExitCode% = 2 is F2 key | ' | ExitCode% = 3 is F3 key | ' | ExitCode% = 4 is F4 key | ' | ExitCode% = 5 is F5 key | ' | ExitCode% = 6 is F6 key | ' | ExitCode% = 7 is F7 key | ' | ExitCode% = 8 is F8 key | ' | ExitCode% = 9 is F9 key | ' | ExitCode% = 10 is F10 key | ' | ExitCode% = 13 is ENTER key | ' | ExitCode% = 14 is Right Arrow -> | ' | ExitCode% = 15 is Left Arrow <- | ' | ExitCode% = 16 is Up Arrow | ' | ExitCode% = 17 is Down Arrow | ' | ExitCode% = 18 is TAB key | ' | ExitCode% = 27 is EXIT key | ' | | ' | Please include at the top of the routine DEFINT A-Z | ' +---------------------------------------------------------------------+ ' IF See% = 1 THEN LOCATE Row%, Col%: CALL MQPrint(STRING$(LenStr%, " "), Colr%) END IF BkColr% = (Colr% AND 112) \ 16 ' begin.edit.line: DO LOCATE Row%, Col%, 1, 6, 7 DO EdW$ = INKEY$ LOOP UNTIL LEN(EdW$) > 0 SlamKey% = CVI(EdW$ + CHR$(0)) ' LOCATE Row%, Col%, 1, 6, 7 IF SlamKey% > 31 AND SlamKey% < 256 THEN 'chr$(32) to chr$255) IF TypeOfText$ = "" THEN GOSUB show.char ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, EdW$) > 0 THEN GOSUB show.char END IF END IF ELSEIF SlamKey% = 27 THEN 'Esc Key ExitCode% = 27 GOSUB get.string GOTO leave.sub ELSEIF SlamKey% = 19712 THEN 'Right Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN 'GOSUB get.string 'ExitCode% = 14 Col% = FCol% + 1 'GOTO leave.sub ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN 'Left Arrow Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% 'GOSUB get.string 'ExitCode% = 15 'GOTO leave.sub END IF ELSEIF SlamKey% = 18432 THEN 'Up Arrow GOSUB get.string ExitCode% = 16 GOTO leave.sub ELSEIF SlamKey% = 20480 THEN 'Down Arrow GOSUB get.string: ExitCode% = 17 GOTO leave.sub ELSEIF SlamKey% = 13 THEN 'Enter GOSUB get.string ExitCode% = 13 GOTO leave.sub ELSEIF SlamKey% = 9 THEN 'Tab GOSUB get.string ExitCode% = 18 GOTO leave.sub ELSEIF SlamKey% = 8 THEN 'Back Space Col% = Col% - 1 IF Col% = FCol% OR Col% < FCol% THEN Col% = FCol% END IF LOCATE Row%, Col% CALL MQPrint(" ", Colr%) ELSEIF SlamKey% = 32 THEN 'Space Bar IF Col% = FCol% + LenStr% THEN LOCATE Row%, FCo4l% Col% = FCol% END IF LOCATE Row%, Col% CALL MQPrint(" ", BkColr%) Col% = Col% + 1 ELSEIF SlamKey% = 21248 THEN 'Delete Key LenToSave = ((FCol% + LenStr%) - Col%) - 1 SaveScr$ = SPACE$(LenToSave) CALL ReadScrn0(Row%, Col% + 1, SaveScr$) LOCATE Row%, Col% CALL MQPrint(SaveScr$ + " ", Colr%) ELSEIF SlamKey% = 18176 THEN 'Home Key Col% = FCol% LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 20224 THEN 'End Key GOSUB get.string Col% = FCol% + LEN(EdW$) - 1 LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN 'Ctrl-Y LOCATE Row%, FCol% WipeOut$ = SPACE$(LenStr%) CALL MQPrint(WipeOut$, Colr%) ELSEIF SlamKey% > 1503 OR SlamKey% < 17409 THEN 'F1 - F10 IdentKey$ = STR$(((SlamKey% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 GOTO leave.sub ELSE ExitCode% = VAL(IdentKey$) GOTO leave.sub END IF END IF END IF LOOP show.char: LOCATE Row%, Col% IF Caps% > 0 THEN CALL MQPrint(UCASE$(EdW$), Colr%) ELSEIF Caps% = 0 THEN CALL MQPrint(EdW$, Colr%) END IF Col% = Col% + 1 IF Col% = FCol% + LenStr% THEN Col% = FCol% RETURN END IF RETURN get.string: EditLine$ = SPACE$(LenStr%) CALL ReadScrn0(Row%, FCol%, EditLine$) IF Trim% = 1 THEN EditLine$ = QPTrim$(EditLine$) END IF EdW$ = EditLine$ RETURN leave.sub: END SUB REM $STATIC DEFSNG A-Z SUB FileCrypt (FileName$, PWord$, Oops%) STATIC Oops% = 0 PassWord$ = PWord$ 'don't actually change the password Encrypt PassWord$, "ÄA2ñÞ," 'double encrypt the password copy L = LEN(PassWord$) 'remember the length of PassWord$ FOpen FileName$, Handle% 'open the file for QuickPak binary IF DOSError% THEN EXIT SUB 'it's not there or drive door is open Size& = FileSize&(FileName$) BufSize& = 14000 LinesOfFile% = LineCount%(FileName$, SPACE$(5000)) IF LinesOfFile% > 10000 THEN Oops% = 1 EXIT SUB END IF IF Size& < BufSize& THEN BufSize& = Size& END IF BufSize& = BufSize& - (Size& MOD L) 'BufSize& = BufSize& - (FileSize& MOD L) 'LEN(Buffer$) must be an even ' multiple of LEN(PassWord$) IF BufSize& = 0 THEN 'it's a very small file, use 'BufSize = FileSize& ' FileSize& instead BufSize& = Size& END IF Buffer$ = SPACE$(BufSize&) 'create a buffer to hold the file Done& = 0 'Done& tracks how much we've done DO FGet Handle%, Buffer$ 'get this portion of the file Encrypt Buffer$, PassWord$ 'encrypt it FSeek Handle%, Done& 'seek back to the start of this block FPut Handle%, Buffer$ 'write out the encrypted data Done& = Done& + LEN(Buffer$) 'track what we've already done IF Size& - Done& < LEN(Buffer$) THEN 'IF FileSize& - Done& < LEN(Buffer$) THEN 'less than LEN(Buffer$) remains Buffer$ = "" 'this shouldn't be necessary 'Buffer$ = SPACE$(FileSize& - Done&) 'adjust buffer to what remains Buffer$ = SPACE$(Size& - Done&) END IF LOOP WHILE LEN(Buffer$) AND NOT DOSError% 'loop while there's still more to do ' and no errors have occurred FClose Handle% 'close the file END SUB 'see ya later, oscillator SUB Form (Monitor%) ' '---------------------------------------------------------------------- ' Prints a rectangle with name and address blank form. '---------------------------------------------------------------------- ' IF Monitor% = 1 THEN C63% = 15 ELSEIF Monitor% = 2 THEN C63% = 63 END IF CALL PaintBox0(8, 14, 16, 73, 8) CALL ClearScr0(7, 12, 15, 71, C63%) CALL Box0(7, 13, 15, 70, 2, C63%) LOCATE 8, 16: CALL MQPrint("First Name:", C63%) LOCATE 9, 16: CALL MQPrint("Last Name:", C63%) LOCATE 10, 16: CALL MQPrint("Address:", C63%) LOCATE 11, 16: CALL MQPrint("Telephone:", C63%) LOCATE 12, 16: CALL MQPrint("Comment (1):", C63%) LOCATE 13, 16: CALL MQPrint("Comment (2):", C63%) LOCATE 14, 16: CALL MQPrint("Comment (3):", C63%) END SUB SUB Message (Monitor%) IF Monitor% = 1 THEN C112% = 112: C113% = 112: C75% = 112: C79% = 112 ELSEIF Monitor% = 2 THEN C112% = 112: C113% = 113: C75% = 75: C79% = 79 END IF 'CLS : PRINT 123, Monitor%, C112: END CALL PaintBox0(3, 16, 5, 70, 8) CALL ClearScr0(2, 14, 4, 68, C112%) CALL Box0(2, 15, 4, 67, 1, C112%) LOCATE 3, 18 CALL MQPrint("Press at each line. Press To Abort", C112%) LOCATE 3, 25: CALL MQPrint("Enter", C113%) LOCATE 3, 53: CALL MQPrint("Esc", C113%) CALL PaintBox0(21, 12, 23, 76, 8) CALL ClearScr0(20, 10, 22, 74, C79%) CALL Box0(20, 11, 22, 73, 1, C79%) LOCATE 21, 13 CALL MQPrint("CURSOR KEYS:<" + CHR$(24) + "> <" + CHR$(25) + "> <" + CHR$(27) + "> <" + CHR$(26) + "> Aborts ", C79%) LOCATE 21, 26: CALL MQPrint(CHR$(24), C75%) LOCATE 21, 30: CALL MQPrint(CHR$(25), C75%) LOCATE 21, 34: CALL MQPrint(CHR$(27), C75%) LOCATE 21, 38: CALL MQPrint(CHR$(26), C75%) LOCATE 21, 42: CALL MQPrint("DEL", C75%) LOCATE 21, 48: CALL MQPrint("HOME", C75%) LOCATE 21, 55: CALL MQPrint("END", C75%) LOCATE 21, 61: CALL MQPrint("ESC", C75%) END SUB FUNCTION Rand% (Hi%, Lo%) STATIC Rand% = RND * (Hi% - Lo%) + Lo% END FUNCTION SUB Txt.Edit (Temps$(), FieldRow%, FieldCol%, Flag%, Monitor%, ExitCode%) STATIC ' '---------------------------------------------------------------------- ' makes use of sub EditString '---------------------------------------------------------------------- ' Row% = 7 Num% = 0 DO Num% = Num% + 1 IF Num% > UBOUND(Temps$, 1) THEN EXIT SUB END IF ' IF Num% = 8 THEN FOR DimSeven% = 1 TO 2 '7 'only Temps$(1) and Temps$(2) Temps$(DimSeven%) = QPTrim$(Temps$(DimSeven%)) NEXT EXIT SUB ELSEIF Num% = 1 OR Num% = 2 THEN LenStr% = 20 ELSEIF Num% > 2 AND Num < 8 THEN LenStr% = 40 END IF Row% = Row% + 1 Col% = 30 FCol% = 30 See% = 0 TypeOfText$ = "" Caps% = 0 IF Monitor% = 1 THEN Colr% = 11 ELSEIF Monitor% = 2 THEN Colr% = 63 END IF FKey$ = "": Trim% = 0 GOSUB getthestring LOOP getthestring: DO CALL EditString(Temps$(Num%), Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, Colr%, FKey$, Trim%, ExitCode%) IF ExitCode% = 17 THEN 'DownArrow IF Num% = 8 THEN EXIT SUB END IF RETURN ELSEIF ExitCode% = 16 THEN 'UpArrow Num% = Num% - 2 Row% = Row% - 2 IF Row% <= 7 THEN Row% = 7 END IF IF Num% <= 0 THEN Num% = 0 END IF RETURN ELSEIF ExitCode% = 13 THEN 'Enter IF Num% = 8 THEN EXIT SUB END IF RETURN ELSEIF ExitCode% = 27 THEN 'CALL MainMenu EXIT SUB END IF LOOP RETURN END SUB SUB WordWrap (X$, Wide%, PrnRow%, PrnCol%) Length% = LEN(X$) 'remember the length Pointer% = 1 'start at the beginning of the string 'scan a block of eighty characters backwards, looking for a blank 'stop at the first blank, or if we reached the end of the string DO FOR X% = Pointer% + Wide% TO Pointer% STEP -1 IF MID$(X$, X%, 1) = " " OR X% = Length% + 1 THEN 'LOCATE , LeftMargin 'optional to tab in the left edge ConstRow% = ConstRow% + 1 COLOR 15, 4 LOCATE PrnRow% + ConstRow%, PrnCol% PRINT MID$(X$, Pointer%, X% - Pointer%); 'LPRINT [TAB(LeftMargin)]; MID$(X$, Pointer%, X% - Pointer%) Pointer% = X% + 1 WHILE MID$(X$, Pointer%, 1) = " " Pointer% = Pointer% + 1'swallow extra blanks to the next word WEND IF POS(0) > 1 THEN PRINT 'if the cursor didn't wrap next line EXIT FOR 'done with this block END IF NEXT LOOP WHILE Pointer% < Length% 'loop until done END SUB