"): IF Z = LPB THEN GOTO TITLE ' Z = INSTR(X$, "

CLS : 'COLOR 1, 7 SCREEN 0 PRINT " PTO Class index viewer" PRINT " Program ----- CLASVIEW.BAS" PRINT PRINT " By Bruce Ross, himself" PRINT " Bruce the Science Moose" PRINT " Specialist, science toys" PRINT " Manufacturing Engineer" PRINT " Product Design Engineer" PRINT " Just what an attorney is not!" PRINT PRINT " NEW: November, 1996" PRINT " REV: December, 1996; May 16, 1997; June 25, 1997; August 7, 1997" PRINT " Sept 10, 1997, Jan 21, 1998" PRINT "" PRINT " SEVERAL OPTIONS: " PRINT " * Searches and views classification files from PTO." PRINT " * Converts HTML code to ASCII for reading with listers and word processors." PRINT " * Removes double LF and double CR. (Typically from Web download anomolies.)" PRINT " * Adds CR to isolated LF, and adds LF to isolated CR, making up a proper CRLF." PRINT " * Removes extraneous non-printable codes and other strings, " PRINT " especially the psudo EOF marks that mess up some files." PRINT " Particularly combined and appended files which often cannot" PRINT " be fully accessed by subsequent application." PRINT PRINT " CLASVIEW.BAS is a public domain program" PRINT : BEEP: PRINT " --- PRESS ANY KEY TO CONTINUE ---"; INKY: IF INKEY$ = "" THEN GOTO INKY ' '----------------- revisions ---------- ' Aug 7, 1997 added HP printer control codes. ' Sept 10, 1997 fixed bug ' Dec 14, 1998 added level printer (code 3) ' June 20, 1999 fixed find and replace to use chr$(xx) ' June 30, 1999 fixed conversion to take spaces is <> . ' ----------- BUGS AND IMPROVEMENTS TO FIX OR MAKE ----------- ' ' '---------------------------------------------------- SETUP: ' set-up PRINT PRINT "Press any printable key to stop program during search." PRINT " May require several presses to catch stop command." PRINT PRINT " TO return to DOS, press X or Q at any inquiry" PRINT PRINT " < > pointy brackets mark default entry for set-up questions." PRINT ' ' '------------- CONSTANTS AND SET-UP ------------- DEFINT A-Z ' all integers ' BLANKEY$ = STRING$(80, " ") ' blank line WHEEL$(0) = "\" ' Progress wheel indicator WHEEL$(1) = "/" WHEEL$(2) = "-" SERCHSTRING$ = "" LNS = 20 ' lines to print DIM CLINES$(LNS) ' lines to print biffer LX = 0 ' LAST PRINT LINE 1-lns-1 SOURCEFILE$ = "" ' PTO class data file OUTFILE$ = "" ' To Save PTO Class search. CRLF$ = CHR$(13) + CHR$(10) ' CR+LF BUILD$ = "" ' html conversion assembly space PREFLAG = 0 ' PREFORMATTED HTML FLAG ZOOP$ = "N" ' BROWSE MODE CHOICE = 1 ' MODE # IFLAG = 0 ' 0 = INPUT FILE NAME, 1=OUTPUT FILE NAME REPLACER$ = "^" ' New pritable character to be inserted. (MODE 5) ' printer control codes BOLDMARK$ = CHR$(27) + "E" ' epson UNBOLDMARK$ = CHR$(27) + "F" ' epson PITCH12$ = CHR$(27) + "M" ' 12 PITCH EPSON PITCH10$ = CHR$(27) + "P" ' 10 PITCH EPSON BOLDMARK$ = CHR$(27) + "(s3B" ' HP (Bold) EXTRABLACK$ = CHR$(27) + "(s7B" ' HP (Extra Black) UNBOLDMARK$ = CHR$(27) + "(s0B" ' HP (Normal stroke weight) PITCH12$ = CHR$(27) + "(s12H" ' 12 pitch HP PITCH10$ = CHR$(27) + "(10H" ' 10 PITCH HP ' BOLDMARK$ = EXTRABLACK$ ON ERROR GOTO 7910 ' ERROR TRAP '--------------------------------------------------------- ' ' ' CHOOSER: PRINT BLANKEY$; PRINT "1 = REVIEW OR FIND CLASSIFICATION" PRINT "2 = DISPLAY CLASSIFICATION FILE UNEDITED" PRINT "3 = DISPLAY EDITED BY NUMBER OF INDENTING DOTS." PRINT "4 = CONVERT HTML FILE ASCII FILE" PRINT "5 = REMOVE STRAY CR AND UNPRINTABLES FROM NET DOWNLOADS," PRINT " and PECULIAR CHARACTERS USED AS SYNTHETIC EOF MARKS," PRINT " and OTHER ARITIFACTS FROM SOME WORD PROCESSORS," PRINT " and CONVERTS ISOLATED CR or LF to CRLF." PRINT "6 = END, BACK TO DOS OR WINDERS" PRINT PRINT "CHOICE <"; CHOICE; : INPUT ">"; QCHOICE IF QCHOICE = 0 THEN QCHOICE = CHOICE CHOICE = QCHOICE IF CHOICE = 1 THEN GOTO FINDWHAT IF CHOICE = 2 THEN GOTO FINDWHAT IF CHOICE = 3 THEN GOTO FINDWHAT IF CHOICE = 4 THEN GOTO MODE IF CHOICE = 5 THEN GOTO MODE IF CHOICE = 6 THEN END CHOICE = 1 BEEP: PRINT : GOTO CHOOSER FINDWHAT: PRINT "FILE TO BE DISPLAYED -- "; Q$ = SOURCEFILE$ GOSUB 6700 ' name input file SOURCEFILE$ = Q$ CLOSE : PRINT IF CHOICE = 3 THEN GOTO MODE PRINT "OPTION TO FIND and MARK WORDS OR PHRASES." FW1: PRINT "SEARCH STRING? <"; SERCHSTRING$; INPUT ">"; Q$: GOSUB 6640 IF Q$ = "" THEN Q$ = SERCHSTRING$ SERCHSTRING$ = Q$ ' PRINT "SEARCH STRING = "; SERCHSTRING$ GOTO M1 '----------------------------------------- ' MODE: PRINT "FILE TO BE EDITED -- "; Q$ = SOURCEFILE$ GOSUB 6700 ' name input file SOURCEFILE$ = Q$ CLOSE : PRINT '------------ real work starts here ----------- M1: IF CHOICE = 1 THEN GOTO EDITANDDISPLAY IF CHOICE = 2 THEN GOTO LISTIT IF CHOICE = 3 THEN GOTO REDACTIT IF CHOICE = 4 THEN GOTO HTMLCONV IF CHOICE = 5 THEN GOTO EDITCR '====================================================== EDITANDDISPLAY: '------------ EDIT AND DISPLAY, CHOICE = 1 ------------ GOSUB RERUN GOTO CLASSTUFF: RERUN: '[---- open file for edit or display --------] CLS : CLOSE WRONGFILE$ = SOURCEFILE$ OPEN SOURCEFILE$ FOR INPUT AS #1 FOR N = 0 TO LNS: CLINES$(N) = BLANKEY$: NEXT N ' CLS : PRINT "TRAVERSING DETAILS NOT PART OF INDEX" HDRSTUFF: IF EOF(1) THEN GOTO CLS1 LINE INPUT #1, A$: ' PRINT A$ IF INSTR(A$, "000.00") = 0 THEN GOTO HDRSTUFF: CLINES$(0) = A$: LX = 0: GOSUB ONSCREEN RETURN '------] ' CLASSTUFF: GOSUB WHADYAWANT IF SERCHSTRING$ <> "" THEN GOTO CLS1 ' automatic search ' ' manual browsing LOCATE 24, 1: PRINT BLANKEY$; LOCATE 25, 1: PRINT BLANKEY$; : LOCATE 24, 1 COLOR 15, 0: PRINT " N"; : COLOR 7, 0: PRINT " = Next line. "; COLOR 15, 0: PRINT " . "; : COLOR 7, 0 PRINT " to find next one dot Group. E to excape. P to print."; ZOOPO$ = ZOOP$ LOCATE 25, 1: PRINT "<"; ZOOP$; INPUT "> "; Q$: GOSUB 6640 ' PAUSE IF Q$ = "" THEN Q$ = ZOOP$ ZOOP$ = Q$ IF ZOOP$ = "N" THEN GOTO CLS1 IF ZOOP$ = "E" THEN GOTO BACK IF ZOOP$ = "." THEN GOTO CLS0 IF ZOOP$ = "F" THEN GOSUB PRINTSAVE IF ZOOP$ = "P" THEN GOSUB PRINTSAVE ZOOP$ = ZOOPO$ ' restore mode GOTO CLS1 PRINTSAVE: '[----- PRINT FIND TO PRINTER OR FILE -----] IF ZOOP$ = "P" THEN WIDTH "LPT1:", 96: LPRINT PITCH12$; : GOTO NXPL2 PRINT "APPEND DISPLAY TO FILE -- <"; OUTFILE$; : INPUT "> "; FOUT$ IF FOUT$ = "" THEN FOUT$ = OUTFILE$ OUTFILE$ = FOUT$ IF OUTFILE$ = "" THEN BEEP: PRINT "NOTHING TO DO!!": GOTO NXPL3 NXPL2: CLS : FOR N = 0 TO LNS IF LTRIM$(CLINES$(N)) = "" THEN GOTO NXPL IF ZOOP$ = "P" THEN LPRINT CLINES$(N): GOTO NXPL1: ' to printer OPEN OUTFILE$ FOR APPEND AS #2: PRINT #2, CLINES$(N): CLOSE 2: ' to file NXPL1: PRINT CLINES$(N): ' Refresh screen NXPL: NEXT N: IF ZOOP$ = "P" THEN LPRINT "--------": LPRINT NXPL3: TIMERX& = TIMER NXPL4: IF TIMER - TIMERX& < 1.2 THEN GOTO NXPL4 ' DOOLAY RETURN ' -----------] CLS0: IF EOF(1) THEN GOTO BACK ' find one dot lines LINE INPUT #1, A$: ' pRINT "<"; A$; ">" IF INSTR(A$, " . . ") THEN GOTO CLS0 ' looking for one . line IF INSTR(A$, " . ") = 0 THEN GOTO CLS0 ' Not a one dot ZOOP$ = "N" ' Exit one dot mode GOTO CLS2 CLS1: IF EOF(1) THEN GOTO BACK LINE INPUT #1, A$: ' PRINT A$ CLS2: IF INSTR(A$, " . . . . . . . . . . . . . ") THEN CLINES$(13) = A$: LX = 13: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . . . . . . . ") THEN CLINES$(12) = A$: LX = 12: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . . . . . . ") THEN CLINES$(11) = A$: LX = 11: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . . . . . ") THEN CLINES$(10) = A$: LX = 10: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . . . . ") THEN CLINES$(9) = A$: LX = 9: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . . . ") THEN CLINES$(8) = A$: LX = 8: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . . ") THEN CLINES$(7) = A$: LX = 7: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . . ") THEN CLINES$(6) = A$: LX = 6: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . . ") THEN CLINES$(5) = A$: LX = 5: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . . ") THEN CLINES$(4) = A$: LX = 4: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . . ") THEN CLINES$(3) = A$: LX = 3: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . . ") THEN CLINES$(2) = A$: LX = 2: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, " . ") THEN CLINES$(1) = A$: LX = 1: GOSUB ONSCREEN: GOTO CLASSTUFF IF INSTR(A$, "000.00") THEN CLINES$(0) = A$: LX = 0: GOSUB ONSCREEN: GOTO CLASSTUFF CLINES$(LX) = CLINES$(LX) + A$: GOSUB ONSCREEN: GOTO CLASSTUFF GOTO CLASSTUFF BACK: GOSUB BEEEP: PRINT " CR = BACK TO BEGINNING, or X or Q = QUIT CR / X / Q"; : INPUT Q$: GOSUB 6640 GOTO CHOOSER '[------ PRINT TO SCREEN ------ FOR CHOICE 1 -------] ONSCREEN: FOR N = LX + 1 TO LNS: CLINES$(N) = BLANKEY$: NEXT N ' clear unused FOR N = 0 TO LNS: ' edit html artifact IF INSTR(CLINES$(N), "[*]") THEN CLINES$(N) = RIGHT$(CLINES$(N), LEN(CLINES$(N)) - 3): NEXT N HFLAG = 0 ' init set search string found flag CLS LOCATE 1, 1 FOR N = 0 TO LNS: ' print it A$ = CLINES$(N) ' Does not wrap overlength lines at word break ONS: IF SERCHSTRING$ = "" THEN GOTO ONS1 Z = INSTR(UCASE$(A$), SERCHSTRING$) IF Z = 0 THEN GOTO ONS1: PRINT LEFT$(A$, Z - 1); : COLOR 15, 0: PRINT SERCHSTRING$; : COLOR 7, 0: ' bright PRINT RIGHT$(A$, LEN(A$) - Z - LEN(SERCHSTRING$) + 1) HFLAG = 1 ' set search string found flag GOTO ONS2 ONS1: PRINT A$ ONS2: NEXT N ZOOPO$ = ZOOP$ IF SERCHSTRING$ = "" THEN GOTO ONS3 IF HFLAG = 0 THEN GOTO ONS3 PRINT "E to end. P to print. F save to file. N or CR to continue:" PRINT "SEARCHSTRING = <"; SERCHSTRING$; : INPUT ">"; QS$: Q$ = QS$: GOSUB 6640 IF Q$ = "" THEN Q$ = "N" IF Q$ = "E" THEN GOTO BACK IF Q$ = "N" THEN GOTO ONS3 ZOOP$ = Q$ IF Q$ = "P" THEN GOSUB PRINTSAVE: GOTO ONS3 IF Q$ = "F" THEN GOSUB PRINTSAVE: GOTO ONS3 SERCHSTRING$ = Q$ ONS3: ZOOP$ = ZOOPO$ RETURN '-------------] '======================================= '--------- LISTER, CHOICE = 2 -------- LISTIT: CLS : CLOSE WRONGFILE$ = SOURCEFILE$ OPEN SOURCEFILE$ FOR INPUT AS #1 ' NXTPGE: FOR N = 1 TO 20: IF EOF(1) THEN GOTO CHOOSER LINE INPUT #1, A$: IF INSTR(A$, "[*]") THEN A$ = RIGHT$(A$, LEN(A$) - 3): IF SERCHSTRING$ = "" THEN GOTO PIT Z = INSTR(UCASE$(A$), SERCHSTRING$) IF Z = 0 THEN GOTO PIT: FOUNDFLAG = 1 PRINT LEFT$(A$, Z - 1); : COLOR 15, 0: PRINT SERCHSTRING$; : COLOR 7, 0: ' bright PRINT RIGHT$(A$, LEN(A$) - Z - LEN(SERCHSTRING$) + 1) GOTO PIT1 PIT: PRINT A$ PIT1: IF FOUNDFLAG = 0 THEN GOSUB WHADYAWANT NEXT N R = CSRLIN DEF SEG = 0: POKE 1050, PEEK(1052): ' clear keyboard ' LOCATE 25, 1: ' PX: IF FOUNDFLAG = 0 THEN GOTO PIT3 DEF SEG = 0: POKE 1050, PEEK(1052): ' clear keyboard SOUND 1000, 10: BEEP: PRINT "ANY KEY TO CONTINUE "; ' halt at found string PIT2Q: IF INKEY$ <> "" THEN GOTO PIT2Q DEF SEG = 0: POKE 1050, PEEK(1052): ' clear keyboard PIT2: IF INKEY$ = "" THEN GOTO PIT2 FOUNDFLAG = 0 PIT3: IF INKEY$ <> "" THEN GOTO PIT3 ' page break INPUT "CR / X / Q / P "; Q$: GOSUB 6640 IF Q$ = "P" THEN GOSUB PRSCREEN GOTO NXTPGE PRSCREEN: '[---- PRINT THE SCREEN ----] WIDTH "LPT1:", 96: LPRINT PITCH12$; FOR N = 1 TO 24 Q$ = "" FOR M = 1 TO 80 Q$ = Q$ + CHR$(SCREEN(N, M)) NEXT M LPRINT Q$ NEXT N RETURN '--------] '============================================= '------------ CHOPS OFF SUB LEVELS ----------- REDACTIT: PRINT "HIDES SUBLEVELS AS DIRECTED" PRINT PRINT "This option removes all sub levels below the specified dots." INPUT "Number of dots for dot level sorting. <1>"; dotlevel IF dotlevel = 0 THEN dotlevel = 1 LNS = 1 GOSUB RERUN ' open files. R1: IF EOF(1) THEN GOTO BACK ' find one dot lines LINE INPUT #1, A$: IF A$ = "" THEN GOTO R1 Z = INSTR(A$, " . ") DL = 0 IF Z = 0 THEN GOTO R1 R2: Q = INSTR(Z, A$, " .") IF Q = Z THEN Z = Q + 2: DL = DL + 1: GOTO R2 'PRINT q; z; dl; "<"; a$ IF DL > dotlevel THEN GOTO R1 IF DL = 1 THEN INPUT " cr "; Q$ PRINT A$ GOTO R1 '============================================= '--------- HTML CONVERTER, CHOICE 4 ---------- HTMLCONV: PRINT " REMOVES HTML MARKINGS FROM XXX.MOZ and XXX.HTM FILES" PRINT PRINT "NAME OF CONVERTED FILE -- " Q$ = SOURCEFILE$ Z = INSTR(Q$, ".") ' Find extension IF Z THEN Q$ = LEFT$(Q$, Z - 1) ' snip off extension Q$ = Q$ + ".ASC" ' add default extension IFLAG = 1: GOSUB 6700: ' name objectfile$ OBJECTFILE$ = Q$ CRFLAG = 0 CRLF$ = CHR$(13) + CHR$(10) PRINT " This converter excises some HTML codes syntactically, but " PRINT " there are too many to specificially identify them all." PRINT " Furthermore, a large family of codes are not syntactically" PRINT " defineable. The program senses these as text within < >," PRINT " and arbitrarily removes the <> and enclosed text. Replacing" PRINT " it with a ^. Unless another marker is chosen." PRINT " The Replacement Marks can be removed after conversion with " PRINT " a word processor." PRINT 2770 : PRINT " Y = inhibit line wrapping within

 sections"
       PRINT " N = line wrap everything to 79 characters"
    
     INPUT " Are you converting a PTO Classification file?  Y/N "; CF$
     CF$ = UCASE$(CF$)
     IF CF$ = "" THEN CF$ = "N"
     IF CF$ = "N" THEN GOTO 2860
     IF CF$ = "Y" THEN SPACER$ = "": BOLDARAMA$ = "N": GOTO 2920
     BEEP: GOTO 2770

2860 : PRINT "Choose    ^, Space, None, or key in anything else."
     INPUT "^/S/N/    Enter the preferred marker. "; SPACER$
     IF SPACER$ = "" THEN SPACER$ = "S"
     SPACER$ = UCASE$(SPACER$)
     IF SPACER$ = "S" THEN SPACER$ = " "
     IF SPACER$ = "N" THEN SPACER$ = ""
     '

2870 : PRINT "Want to convert  BOLD or STRONG CODES into the appropriate"
     INPUT "printer control codes?  Y/N "; BOLDARAMA$
     IF BOLDARAMA$ = "" THEN BOLDARAMA$ = "N"
     BOLDARAMA$ = UCASE$(BOLDARAMA$):

    
2920 : WRONGFILE$ = SOURCEFILE$
     OPEN SOURCEFILE$ FOR INPUT AS #1
     WRONGFILE$ = OBJECTFILE$
     OPEN OBJECTFILE$ FOR OUTPUT AS #2
    
     ENDO = 0: PREFLAG = 0
    
    
     '---- WORK STARTS HERE -----
LOOP1:
      BUILD$ = "": X$ = "": A$ = "": Q$ = "": L$ = "": R$ = ""
      EOLFLAG = 0:
      IF REMINANT$ <> "" THEN A$ = REMINANT$: REMINANT$ = "": GOTO LOOP3: ' continue with fragment after CR

LOOP2:  '  read a new line
3020 :   GOSUB WHADYAWANT
     IF EOF(1) THEN CLOSE 1: ENDO = 1: GOTO CLEANUP    ' ENDLINE
     LINE INPUT #1, A$:    '  PRINT "["; A$; "]"
     LOCATE 25, 75: PRINT WHEEL$(WHZ%): LOCATE 24, 1   ' progress wheel
     WHZ% = WHZ% + 1: IF WHZ% > 3 THEN WHZ% = 0
     A$ = RTRIM$(A$)
    
     A$ = RTRIM$(A$) + " "
     X$ = UCASE$(A$)
     IF PREFLAG = 0 THEN IF X$ = "" THEN GOTO LOOP2    ' ignore blank line
     IF PREFLAG = 1 THEN IF CF$ = "Y" THEN GOTO LOOP3  ' Cut <> under      IF PREFLAG = 1 THEN IF INSTR(X$, "") = 0 THEN GOTO WRAPPER
     IF PREFLAG = 1 THEN IF INSTR(X$, "

") THEN GOTO EEROARMESSAGE: GOTO LOOP3 EEROARMESSAGE: BEEP: SOUND 2000, 15 PRINT " FOUND A WITHOUT A CORRESPONDING
" INPUT "CONTINUE ANYWAY? Y/N "; Q$: Q$ = UCASE$(Q$) IF Q$ = "" THEN Q$ = "Y" IF Q$ = "Y" THEN GOTO LOOP3 IF Q$ = "N" THEN STOP GOTO EEROARMESSAGE: LOOP3: 'PRINT a$ 'PRINT : PRINT : PRINT LEN(a$); "<<<<<<<<<<" 'IF LEN(a$) > 10000 THEN STOP A$ = RTRIM$(A$) + " " REMPBK: ' remove spaces within < > pointy brackets NPB = 0 REMPBK1: LPB = INSTR(NPB + 1, A$, "<") ' PRINT A$ RPB = INSTR(NPB + 1, A$, ">") IF LPB = 0 THEN GOTO CONTINUE IF RPB - LPB < 2 THEN GOTO CONTINUE NPB = RPB X$ = MID$(A$, LPB, RPB - LPB + 1) REMPBK2: Z = INSTR(X$, " ") ' remove spaces IF Z THEN X$ = LEFT$(X$, Z - 1) + RIGHT$(X$, LEN(X$) - Z): GOTO REMPBK2 A$ = LEFT$(A$, LPB - 1) + X$ + RIGHT$(A$, LEN(A$) - RPB) GOTO REMPBK1 CONTINUE: X$ = UCASE$(A$) ' CONTINUE L$ = "": R$ = "": Z$ = "" LPB = INSTR(A$, "<"): ' left pointy bracket RPB = 0 IF LPB THEN RPB = INSTR(LPB, A$, ">") ' right pointy bracket IF RPB = 0 THEN GOTO LOOP4 IF RPB > LPB THEN GOTO LOOP4 PRINT "MISSING OR OUT OF PLACE POINTY BRACKETS" PRINT "/"; A$; "?" INPUT "CR TO CONTINUE"; Q$ LOOP4: '----- insertions Z = INSTR(X$, """): IF Z THEN Y = 6: Z$ = CHR$(34): GOTO INSERTER ' QUOTIE Z = INSTR(X$, "®"): IF Z THEN Y = 5: Z$ = "(C)": GOTO INSERTER ' (C) Z = INSTR(X$, "©"): IF Z THEN Y = 6: Z$ = "(C)": GOTO INSERTER ' (C) Z = INSTR(X$, "&"): IF Z THEN Y = 5: Z$ = "&": GOTO INSERTER ' & Z = INSTR(X$, "&NBSP;"): IF Z THEN Y = 6: Z$ = " ": GOTO INSERTER ' unknown CR Z = INSTR(X$, "&IACUTE;"): IF Z THEN Y = 8: Z$ = "'": GOTO INSERTER ' apostrophe Z = INSTR(X$, "&NTILDE;"): IF Z THEN Y = 8: Z$ = "~": GOTO INSERTER ' tilde ~ Z = INSTR(X$, "&SECT;"): IF Z THEN Y = 6: Z$ = CHR$(21): GOTO INSERTER ' dubble S Z = INSTR(X$, "&SHY;"): IF Z THEN Y = 4: Z$ = "": GOTO INSERTER ' word break hyphen Z = INSTR(X$, "&DEG;"): IF Z THEN Y = 5: Z$ = CHR$(248): GOTO INSERTER ' degree symbol Z = INSTR(X$, "
"): IF Z THEN IF Z = LPB THEN Y = 4: Z$ = " ": GOTO INSERTER ' two spaces Z = INSTR(X$, "&#"): IF Z THEN GOTO CHARINSERTER ' ascii character Z = INSTR(X$, CHR$(10)): IF Z THEN Y = 1: Z$ = " ": GOTO INSERTER ' remove LF Z = INSTR(X$, CHR$(13)): IF Z THEN Y = 1: Z$ = " ": GOTO INSERTER ' remove CR Z = INSTR(X$, CHR$(9)): IF Z THEN Y = 1: GOTO TABBX ' tab Z = INSTR(X$, "&"): IF Z THEN GOTO AMPERSANDCHECKER ' unknown &; codes. LOOP5: IF LPB = 0 THEN GOTO ALLCON IF EOLFLAG THEN GOTO ALLCON ' cr in middle of line '------ misc codes Z = INSTR(X$, ""): IF Z = LPB THEN Y = 3: GOTO BOLD ' START BOLD Z = INSTR(X$, ""): IF Z = LPB THEN Y = 4: GOTO BOLD ' END BOLD Z = INSTR(X$, ""): IF Z = LPB THEN Y = 8: GOTO BOLD ' START BOLD Z = INSTR(X$, ""): IF Z = LPB THEN Y = 9: GOTO BOLD ' END BOLD Z = INSTR(X$, ""): IF Z = LPB THEN Y = 3: GOTO EXCISER: ' Z = INSTR(X$, ""): IF Z = LPB THEN Y = 4: GOTO EXCISER: ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO DRAWLINE: ' horiz. line Z = INSTR(X$, ""): IF Z = LPB THEN Y = 5: GOTO DRAWLINE: ' " " Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO EXCISER: ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 5: GOTO EXCISER: ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO EXCISER: ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 5: GOTO EXCISER: ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO EXCISER: ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 5: GOTO EXCISER: ' Z = INSTR(X$, ""): IF Z = LPB THEN Y = 5: GOTO EXCISER: ' junk? Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 5: GOTO EXCISER: ' " Z = INSTR(X$, ""): IF Z = LPB THEN Y = 5: GOTO EXCISER: ' " Z = INSTR(X$, ""): IF Z = LPB THEN Y = 8: GOTO EXCISER ' CENTERING Z = INSTR(X$, ""): IF Z = LPB THEN Y = 6: GOTO EXCISER Z = INSTR(X$, ""): IF Z = LPB THEN GOTO TITLE ' Z = INSTR(X$, ""): IF Z = LPB THEN GOTO ENDTITLE ' '------ end of line codes Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO ENDOFLINE ' insert CRLF Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 3: GOTO ENDOFLINE ' CRLF+CRLF Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 5: GOTO ENDOFLINE ' insert CRLF Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO ENDOFLINE ' CRLF+CRLF Z = INSTR(X$, "/BR"): IF Z = LPB THEN Y = 3: GOTO ENDOFLINE ' insert CRLF Z = INSTR(X$, "/P"): IF Z = LPB THEN Y = 2: GOTO ENDOFLINE ' CRLF+CRLF Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO ENDOFLINE ' new line Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 4: GOTO ENDOFLINE ' new line Z = INSTR(X$, ""): IF Z = LPB THEN Y = 5: GOTO EXCISER: GOTO ENDOFLINE ' CRLF for tables Z = INSTR(X$, ""): IF Z = LPB THEN Y = 5: GOTO ENDOFLINE ' CRLF for tables Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 9: GOTO ENDOFLINE ' CRLF after centering Z = INSTR(X$, ""): IF Z = LPB THEN Y = 7: GOTO ENDOFLINE ' CRLF at end of docment '------ modes Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 5: PREFLAG = 1: GOTO PREFORMATTED ' Z = INSTR(X$, "
"): IF Z = LPB THEN Y = 6: PREFLAG = 0: GOTO ENDOFLINE L2: RPB = INSTR(LPB, A$, ">"): IF RPB = 0 THEN GOTO ALLCON: ' cut out undefined <> Q$ = LEFT$(A$, LPB - 1) REM$ = RIGHT$(A$, LEN(A$) - RPB) A$ = Q$ + SPACER$ + REM$ ' PRINT LPB; RPB; "/"; A$; "/" GOTO LOOP3 ALLCON: ' ALL IDENTIFIED CODES HAVE BEEN CONVERTED BUILD$ = BUILD$ + A$ IF PREFLAG = 1 THEN GOTO CL1: ' prints A$ line by line IF EOLFLAG THEN GOTO CL1 ' finish and print GOTO LOOP2 ' get another segment CL1: ' ---- NOW CUT OUT STUFF AND PRINT LINE A$ = BUILD$ CL2: LPB = INSTR(A$, "<"): IF LPB = 0 THEN GOTO WRAPPER RPB = INSTR(LPB, A$, ">"): IF RPB = 0 THEN GOTO WRAPPER Q$ = LEFT$(A$, LPB - 1) REM$ = RIGHT$(A$, LEN(A$) - RPB) A$ = Q$ + SPACER$ + REM$ GOTO CL2 WRAPPER: ' TO PRINTER STUFF ' : PRINT "<"; A$; ">"; EOLFLAG: ' STOP GOSUB WRAPPER1 EOLFLAG = EOLFLAG - 1 IF EOLFLAG > 0 THEN A$ = " ": GOSUB WRAPPER1 EOLFLAG = 0 GOTO LOOP1 ' start a new line EXCISER: GOSUB EXCISER1 GOTO LOOP3 ' REPROCESS EXCISER1: ' [---- remove found code ----] L$ = LEFT$(A$, Z - 1) ' SPLIT LINE AT Z R$ = RIGHT$(A$, LEN(A$) - Y - Z + 1) ' KNOCK OUT FIND A$ = L$ + R$ 'PRINT "<"; A$; "><"; L$; "><"; R$; ">" RETURN '----------] AMPERSANDCHECKER: Q = INSTR(Z, X$, ";") Y = Q - Z + 1 IF Q = 0 THEN GOTO LOOP5 IF Y < 1 THEN GOTO LOOP5 IF Y > 6 THEN GOTO LOOP5 Z$ = "" ' GOTO AMP1 BEEP: PRINT : PRINT MID$(X$, Z, Y): PRINT LEFT$(X$, Z - 1); COLOR 3, 0: PRINT MID$(X$, Z, Y); : COLOR 7, 0 PRINT RIGHT$(X$, LEN(X$) - Q): STOP AMP1: GOTO INSERTER ' REMOVES STRAY & CODES CHARINSERTER: ' INSERT ASCII CHARACTER Q = INSTR(Z, X$, ";") Y = Q - Z + 1 IF Q = 0 THEN GOTO LOOP5 ' ignores find IF Y < 1 THEN GOTO LOOP5 IF Y > 6 THEN GOTO LOOP5 VALOO% = (VAL(MID$(X$, Z + 2, Y - 3))) IF VALOO% = 147 THEN VALOO% = 34 ' QUOTIES. IF VALOO% = 148 THEN VALOO% = 34 Z$ = CHR$(VALOO%) PRINT "<"; Z$; ">" GOTO INSERTER ' WITH A CHARACTER INSERTER: ' INSERT Z$ AT Z L$ = LEFT$(A$, Z - 1) ' SPLIT LINE AT Z R$ = RIGHT$(A$, LEN(A$) - Y - Z + 1) ' KNOCK OUT FIND INS1: A$ = L$ + Z$ + R$ ' INSERT GOTO LOOP3 ' RECHECK TABBX: ' TAB CODE FOUND TABBY = 8 ' TAB SPACING T = Z MOD 8 Z$ = STRING$(T, " ") GOTO INSERTER DRAWLINE: IF INSTR(X$, "") THEN GOSUB EXCISER: A$ = A$ + "
": IF INSTR(X$, "
") THEN GOSUB EXCISER1: A$ = A$ + "
" + STRING$(50, "-") + "
": GOTO LOOP3 ENDOFLINE: ' ------- get line ready to print EOLFLAG = 1 IF INSTR(X$, "
") THEN EOLFLAG = 2 L$ = "": R$ = "": L$ = LEFT$(A$, Z + Y - 1) REMINANT$ = "" REMINANT$ = RIGHT$(A$, LEN(A$) - Z - Y + 1) ' Fragment after CR A$ = L$ ' PRINT : PRINT "//"; A$; "//"; REMINANT$; "//": STOP GOTO EXCISER PREFORMATTED: ' INSERT CRLF AT END OF LINE ' NO EDITING GOTO EXCISER TITLE: MID$(A$, Z, 7) = "TITLE= ": GOTO LOOP3 ' MARK THE TITLE LINE ENDTITLE: MID$(A$, Z, 8) = "
": GOTO LOOP3 ' END TITLE LINE BOLD: ' SEE constants for bold control codes. IF BOLDARAMA$ = "N" THEN GOTO EXCISER ' Boldarama$ is "Y" IF INSTR(X$, ""; Q$: Q$ = UCASE$(Q$) IF Q$ = "N" THEN END SHELL "LIST " + OBJECTFILE$ PRINT : PRINT "----- DONE, BYE -----": BEEP END '================================================================== '-------- REMOVE EXTRA CARRIAGE RETURNS, CHOICE 5 ------- ' ---- AND OTHER EDITS ---- EDITCR: PRINT "HTML AND OTHER FILES DOWNLOADED FROM THE NET AND WORDPROCESSORS" PRINT " SOMETIMES HAVE EXTRA CR, AND SOMETIMES LONE LF, SOMETIMES A CR" PRINT " WITHOUT A LF. " PRINT "SOME WORD PROCESSORS USE CHR$(26), " + CHR$(26) + " AS A FILLER OR" PRINT " EOF MARKER. THESE MESS UP OTHER PROGRAMS AND NEED TO BE REMOVED." PRINT PRINT "THIS PROGRAM DOES:" PRINT "REMOVES EXTRA CARRIAGE RETURNS. IE CR CR CR LF --> CR LF" PRINT "INSERTS CR TO GO WITH LONE LF. LF --> CR LF and CR --> CR LF" PRINT ' Only if outfile is not sourcefile PRINT "REMOVES AND REPLACES CHARACTER STRINGS" PRINT " Must be same length string if outfile is also sourcefile" PRINT SAMEO = 0 ' flag indicating outputfile$ <> sourcefile$ OUTFILE$ = SOURCEFILE$ 4730 : PRINT "NAME OF CONVERTED FILE --" Q$ = SOURCEFILE$ Z = INSTR(Q$, "."): ' Find extension IF Z THEN Q$ = LEFT$(Q$, Z - 1) ' snip off extension Q$ = Q$ + ".EDT" ' add default extension IFLAG = 1: GOSUB 6700: ' name objectfile$ OUTFILE$ = Q$ IF OUTFILE$ = SOURCEFILE$ THEN SAMEO = 1 IF SAMEO = 0 THEN GOTO 4880 IF SAMEO THEN INPUT "OK to overwrite Y/N "; Q$: Q$ = UCASE$(Q$) IF Q$ = "" THEN Q$ = "Y" IF Q$ = "Y" THEN GOTO 4880 GOTO 4730 4880 : ' custom stuff and odd unprintables not available through keyboard PRINT "UNPRINTABLE CHARACTERS CAN BE ENTERED AS DECIMAL NUMBERS" PRINT " 1 - 255. BY HOLDING DOWN THE ALT KEY AND ENTERING THE" PRINT " NUMBER DECIMAL EQUIVILANT OF THE CHARACTER IN THE 10-KEY PAD. " PRINT " CHARACTER IS ENTERED WHEN THE ALT KEY IS RELEASED." PRINT "FIND AND CONVERT CHARACTER:" PRINT "Nul = "; : COLOR 15, 0: PRINT "00": COLOR 7, 0: PRINT "Nul = "; : COLOR 15, 0: PRINT "127": COLOR 7, 0: PRINT "Nul = "; : COLOR 15, 0: PRINT "255": COLOR 7, 0: PRINT "Tab = "; : COLOR 15, 0: PRINT "09": COLOR 7, 0: ' PRINT : PRINT CHR$(34); ; CHR$(20); "++++ testaroony" PRINT "corner mark "; CHR$(28); " = "; : COLOR 15, 0: PRINT "28": COLOR 7, 0 PRINT "false EOF "; : COLOR 15, 0: PRINT CHR$(26); : COLOR 7, 0: PRINT " = "; : COLOR 15, 0: PRINT "26": COLOR 7, 0 ' CS$ = CHR$(27) + CHR$(27): ' DUBBLE EXCAPE ' CS$ = CHR$(27) + " ": REPLACER$ = " " + CHR$(27) ' MOVE EXCAPE OVER ' CS$ = CHR$(26) + CHR$(26) + CHR$(26): REPLACER$ = "^^^" ' CS$ = "^" + CHR$(26) + CHR$(26): REPLACER$ = "^^^" PRINT "Choose <"; : COLOR 15, 0: PRINT CHR$(26); : COLOR 7, 0: INPUT ">"; Q$: Q$ = UCASE$(Q$): IF Q$ = "" THEN Q$ = "26" IF VAL(Q$) = 0 THEN CS$ = CHR$(0): GOTO 4090 IF VAL(Q$) = 9 THEN CS$ = CHR$(9): GOTO 4090 IF VAL(Q$) = 255 THEN CS$ = CHR$(255): GOTO 4090 IF VAL(Q$) = 125 THEN CS$ = CHR$(125): GOTO 4090 IF VAL(Q$) = 26 THEN CS$ = CHR$(26) IF VAL(Q$) = 28 THEN CS$ = CHR$(28) 4090 : PRINT "CHARACTER STRING TO CONVERT <"; CS$; ">" PRINT "REPLACEMENT CHARACTER STRING <"; REPLACER$; INPUT ">"; Q$ IF Q$ = "" THEN Q$ = REPLACER$ REPLACER$ = Q$ PRINT "<"; CS$; "><"; REPLACER$; ">" IF SAMEO = 1 THEN IF LEN(CS$) <> LEN(REPLACER$) THEN BEEP: PRINT " MUST BE SAME LENGTH ": GOTO 4880 WRONGFILE$ = SOURCEFILE$ OPEN SOURCEFILE$ FOR INPUT AS #1: CLOSE ' CHECKING IF FILE EXISTS. ' BINARY LIKE RANDOM WILL MAKE A FILE IF NONE EXISTS. IF SAMEO = 0 THEN GOTO DIFFERENTFILES ' edit and replace file SAMEO=1 PRINT SOURCEFILE$ + " ---> convert ---> " + SOURCEFILE$ GOTO 5118 DIFFERENTFILES: ' edit to a different file SAMEO=0 PRINT SOURCEFILE$ + " ---> convert ---> " + OUTFILE$ OPEN OUTFILE$ FOR OUTPUT AS #2 GOTO 5118 5118 GOSUB SERCH ' OPEN AND SET UP INPUT FILE, BINARY MODE 5120 : SX = 1 ' SEARCH POINTER FOUND1 = 0: FOUND2 = 0: BUMP = 0 ' FLAGS PX$ = CHR$(13) + CHR$(13) + REPLACER$: GOSUB SERCH2 ' READ A BLOCK, DUMMY PX$ LBX = LEN(BUFFER$): IF LBX = 0 THEN GOTO CLEANUP4 PATTERNLENGTH = 0 ' EDIT OUT DUBBLE LF, DUBBLE CR, ADD CR TO LONE LF, ADD LF TO LONE CR. 5640 : ' --- FIND AND ELIMINATE DUBBLE LF. LEAVES ONE LF. SX = 1: BUMP = -1: PX$ = CHR$(10) + CHR$(10) 5660 : STRINGPOS = INSTR(SX, BUFFER$, PX$): IF STRINGPOS = 0 THEN 6070 MID$(BUFFER$, STRINGPOS, 2) = " " + CHR$(10): SX = STRINGPOS + 1 GOTO 5660 6070 ' --- FIND AND ELIMINATE DUBBLE CR, LEAVES 1 CR SX = 1: BUMP = -1: PX$ = CHR$(13) + CHR$(13) 6073 : STRINGPOS = INSTR(SX, BUFFER$, PX$): IF STRINGPOS = 0 THEN 5900 MID$(BUFFER$, STRINGPOS, 2) = " " + CHR$(13): X = STRINGPOS + 1 GOTO 6073 5900 : ' --- FIND AND FIX LONE LF. SX = 1: BUMP = 1: PX$ = CHR$(10) ' look for LF 5910 : ' INSERT CR AT LONE LF STRINGPOS = INSTR(SX, BUFFER$, PX$): IF STRINGPOS = 0 THEN 5930 ' no change IF STRINGPOS = 1 THEN 5920 ' cannot make insertion IF MID$(BUFFER$, STRINGPOS - 1, 1) = CHR$(13) THEN GOTO 5920 ' CR with LF as CRLF IF MID$(BUFFER$, STRINGPOS - 1, 1) = " " THEN MID$(BUFFER$, STRINGPOS - 1, 1) = CHR$(13): GOTO 5920 IF SAMEO = 1 THEN GOTO 5920 ' no space for CR Z$ = LEFT$(BUFFER$, STRINGPOS - 1) ZZ$ = RIGHT$(BUFFER$, LEN(BUFFER$) - STRINGPOS + 1) BUFFER$ = Z$ + CHR$(13) + ZZ$ 5920 : ' found a CR LF or made one up SX = STRINGPOS + 1 GOTO 5910 ' find next 5930 : ' --- FIND AND FIX LONE CR. SX = 1: BUMP = 1: PX$ = CHR$(13) ' look for CF 5940 : ' INSERT LF AT LONE CR STRINGPOS = INSTR(SX, BUFFER$, PX$): IF STRINGPOS = 0 THEN 5950 ' no change IF MID$(BUFFER$, STRINGPOS + 1, 1) = CHR$(10) THEN GOTO 5945 ' CR with LF as CRLF IF MID$(BUFFER$, STRINGPOS + 1, 1) = " " THEN MID$(BUFFER$, STRINGPOS + 1, 1) = CHR$(10): GOTO 5945 IF SAMEO = 1 THEN GOTO 5945 ' no space for LF Z$ = LEFT$(BUFFER$, STRINGPOS) ZZ$ = RIGHT$(BUFFER$, LEN(BUFFER$) - STRINGPOS) BUFFER$ = Z$ + CHR$(10) + ZZ$ 5945 : ' found a CR LF or made one up SX = STRINGPOS + 1 GOTO 5940 ' find next 5950 : ' REPLACE STRINGS. IF LEN(CS$) <> LEN(REPLACER$) THEN 5970 ' IF LEN(CS$) <> 1 THEN 5970 SX = 1: PX$ = CS$ ' look for STRING same length as REPLACER$ BUMP = LEN(REPLACER$) 5955 STRINGPOS = INSTR(SX, BUFFER$, PX$) IF STRINGPOS = 0 THEN 5970 ' no change MID$(BUFFER$, STRINGPOS, BUMP) = REPLACER$: PRINT REPLACER$; SOUND 900, 1: SOUND 32767, 1 PRINT "replacing <"; CS$; "> with <"; REPLACER$; "> at "; SX; STRINGPOS SX = STRINGPOS + 1 GOTO 5955 ' find next 5970 : ' Next block FILEOFFSET& = SEEK(1) SEEK #1, QQQ& GOSUB 6080 ' write to outfile FILEOFFSET& = FILEOFFSET& - PATTERNLENGTH ' BACK UP SOME. QQQ& = FILEOFFSET& ' PRINT "<><>"; FILEOFFSET&, QQQ& IF LEN(BUFFER$) < PACKETSIZE THEN GOTO CLEANUP4 GOTO 5120 '------------- 5980 : ' --- FIND AND REPLACE UNPRINTABLE CHARACTER CS$ GOSUB SERCH ' OPEN AND SET UP INPUT FILE 5420 : SX = 1 ' SEARCH POINTER PX$ = CS$: ' find and replace unprintable GOSUB SERCH2 ' READ A BLOCK LBX = LEN(BUFFER$) BUMP = LEN(REPLACER$) - LEN(CS$) IF BUMP THEN GOTO 5530 5490 : ' SAME LENGTH STRINGPOS = INSTR(SX, BUFFER$, PX$): IF STRINGPOS THEN MID$(BUFFER$, STRINGPOS, PATTERNLENGTH) = REPLACER$: SX = STRINGPOS + 1: FOUND2 = 1: PRINT REPLACER$; : GOTO 5490 ' REPLACE STRING GOTO 5640 5530 : ' DIFFERENT LENGTHS STRINGPOS = INSTR(SX, BUFFER$, PX$): IF STRINGPOS = 0 THEN GOTO 5640 IF BUMP THEN BUFFER$ = BUFFER$ + STRING$(BUMP, " ") PRINT SX; STRINGPOS; BUMP; MID$(BUFFER$, STRINGPOS - 3, 15), MID$(BUFFER$, STRINGPOS, LEN(BUFFER$) - STRINGPOS) = REPLACER$ + RIGHT$(BUFFER$, LEN(BUFFER$) - STRINGPOS - LEN(CS$) + 1) PRINT MID$(BUFFER$, STRINGPOS - 3, 13) SX = STRINGPOS + 1 GOTO 5530 ' find next 6080 : '[----- PRINT EDITED FILE TO NEW FILE. (OUTFILE$) -----] GOSUB WHADYAWANT PRINT : PRINT "SENDING BLOCK TO "; OUTFILE$; " NOW. "; QQQ&; " TO "; FILEOFFSET&, SAMEO GOSUB WHADYAWANT IF SAMEO = 0 THEN PRINT #2, BUFFER$; : GOTO 6085 6081 : IF SAMEO = 1 THEN PUT #1, , BUFFER$: 6085 : GOSUB WHADYAWANT IF LBX < PACKETSIZE THEN GOTO CLEANUP4 ' partial block signals last block RETURN ' NEXT BLOCK '------------] CLEANUP4: IF SAMEO = 0 THEN PRINT #2, " " CLOSE PRINT "WANT TO SEE REVISED FILE NOW? " INPUT "ESC key to exit display. Choose: Y/N "; Q$: Q$ = UCASE$(Q$) IF Q$ <> "N" THEN SHELL "LIST " + OUTFILE$ CLOSE BEEP: PRINT : PRINT "--- DONE ---" END '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- END ' of linear code ' ====================== subroutines ============================== BEEEP: '[----- BEEP -----] SOUND 1000, 10: SOUND 800, 5: SOUND 1000, 10 RETURN ' --------------- GENERAL SUBROUTINES -------------- ' '[--------- all capitals --------]" IF Q$ = "" THEN 6550 GOTO 6640: ' Q$ = UCASE$(Q$) 6550 RETURN '-------------] WHADYAWANT: ' [---- KEYBOARD INTERRUPT ---- whadya want? ------] IF INKEY$ = "" THEN RETURN DEF SEG = 0: POKE 1050, PEEK(1052): ' clear keyboard PRINT "WHADYA WANT? (X CReturn, ^SCR LOCK, or maybe ^Pause) = return to DOS, " INPUT "CReturn to continue X or Q to quit."; Q$ 6640 Q$ = UCASE$(Q$) IF Q$ = "X" THEN SYSTEM IF Q$ = "Q" THEN SYSTEM RETURN '------------] 6700 '[------ file naming -------] ' input: q$ = default name ' iflag =0 for sourcefile name ' iflag = 1 for destination file name ' output: q$ = file name PRINT " -- DIR X: for directory. DEL X: for delete " ' Q$ = "d:\pto\classes\class-40" QQ$ = Q$ A$ = Q$: PRINT "NAME <"; Q$; ">"; ' print default in <> INPUT Q$: Q$ = UCASE$(Q$) IF Q$ = "" THEN Q$ = A$ ' insert default IF Q$ = "DIR" THEN FILES: PRINT : GOTO 6700 IF Q$ = "DIR " THEN FILES: PRINT : GOTO 6700 IF INSTR(Q$, "DIR ") > 0 THEN Q$ = RIGHT$(Q$, LEN(Q$) - 4): FILES Q$: PRINT : GOTO 6700 IF INSTR(Q$, "DEL ") > 0 THEN 6840 GOTO 6880 ' to test file and return 6840 QQ$ = RIGHT$(Q$, LEN(Q$) - 4): PRINT "delete "; Q$; : INPUT " Are you sure? "; Q$ Q$ = LTRIM$(RTRIM$(Q$)): IF Q$ = "Y" THEN KILL QQ$: PRINT QQ$; " has been deleted" PRINT GOTO 6888 6880 ON ERROR GOTO 6884 OPEN Q$ FOR INPUT AS #1 ' test for existance of file CLOSE 1 IF IFLAG = 0 THEN GOTO 6888 ' file exists 6884 : ' FROM 6880,[-- error handler, file not found CLOSE 1 IF IFLAG = 1 THEN RESUME 6888 ' destination file name is ok. QQ$ = Q$ PRINT Q$; " NOT FOUND.": BEEP RESUME 6700 ' rename it 6888 ON ERROR GOTO 7910 ' reset error trap IFLAG = 0 RETURN: ' return with file name in Q$ '----------------] ' [========== search for file PN ===========] SERCH: ' [---- file searcher using "binary" file mode ----] WHEEL$(0) = "/" ' progress marker wheel WHEEL$(1) = "\" WHEEL$(2) = "-" L00P = 0 SERCH1: CLOSE 1 OPEN SOURCEFILE$ FOR BINARY AS #1: ' restart from beginning each time. FILELENGTH& = LOF(1) FOUNDIT = 0 ' reset found flag FILEOFFSET& = 1 ' first byte of packet to fetch PACKETSIZE = 10000: ' search buffer size SX = 1 ' reset buffer search pointer PATTERNLENGTH = LEN(PX$) ' search pattern length BEGN& = 0 ' beginning of found file QQQ& = FILEOFFSET& Q& = FRE(Q$) RETURN '--------] SERCH2: ' re-entry point OLD NOTES, NOT EXACTLY AS USED HERE FOUNDIT = 0 ' hit flag STRINGPOS = 0 ' in case bytesleft& <= patternlength, last record, nothing to search PATTERNLENGTH = LEN(PX$) ' Keep searching as long as there are enough bytes left in ' the file to contain the pattern you're searching for: NXTBLK: ' process several buffers full to EOF ' Read either 10,000 bytes or the number of bytes left in the file, ' whichever is smaller, then store them in Buffer$. (If the number ' of bytes left is less than PACKETSIZE, the following statement ' still reads just the remaining bytes, since binary I/O doesn't ' give "read past end" errors): SEEK #1, FILEOFFSET& ' seek statement sets put/get pointer BUFFER$ = "" BUFFER$ = INPUT$(PACKETSIZE, #1) ' Find every first of the pattern in Buffer$: START = SX ' start search at SX WH = WH% + 1: IF WH% > 2 THEN WH% = 0 LOCATE 25, 80: PRINT WHEEL$(WH%); ' progress marker STRINGPOS = INSTR(START, BUFFER$, PX$): ' find code pattern RETURN '-------] SERCH3: IF STRINGPOS = 0 THEN GOTO ENDBUFF ' code pattern not found ' Found the pattern, so print the byte position in the file where the pattern starts: ' start = STRINGPOS + 1 FOUNDIT = 1: GOTO RETRO ' found flag -1=eof, 0= not found 1= found ENDBUFF: ' stringpos is 0, search failed thus far IF LEN(BUFFER$) < PACKETSIZE THEN GOTO DOON: ' end of file ' Find the byte position where the next I/O operation would take place, ' then back up the file pointer a distance equal to the length of the ' pattern (in case the pattern straddles a 10,000-byte boundary): FILEOFFSET& = SEEK(1) ' NEXT BLOCK STARTS HERE. seek function like LOC(#) FILEOFFSET& = FILEOFFSET& - PATTERNLENGTH ' BACK UP SOME. SX = 1 ' reset buffer search pointer GOTO NXTBLK ' search another block of file DOON: ' go around to look at the complete file FOUNDIT = -1 ' end of file flag L00P = L00P + 1 IF L00P > 1 THEN GOTO RETRO GOSUB SERCH1 ' reset to front of file GOTO SERCH2 RETRO: BEGN& = STRINGPOS + FILEOFFSET& - 1: ' beginning of found file RETURN '--------] GETREC: '[------ get patent record from buffer and send to #2 ------] ' GET AT QQQ& BP = 0: LENFOUND = 0: ' big patent flag BUFFER$ = "" FILEOFFSET& = QQQ& SEEK 1, QQQ& ' set file pointer to beg of patent GR: BUFFER$ = INPUT$(PACKETSIZE, #1) IF PATTERNLENGTH = 0 THEN PATTERNLENGTH = 17: STOP NPN& = INSTR(PATTERNLENGTH, BUFFER$, PNMK$) NNPN& = INSTR(PATTERNLENGTH, BUFFER$, DPNMK$) FIX0: IF NPN& = 0 THEN NPN& = NNPN& IF NNPN& = 0 THEN NNPN& = NPN& IF NPN& + NNPN& = 0 THEN GOTO BIGPATENT IF NNPN& < NPN& THEN NPN& = NNPN&: ' use next nearest pn,# mark LENFOUND = (NPN& - SCD - 1) + LENFOUND: ' patent record length L00P = 0 RETURN ' found file = left$(buffer$,lenfound) BIGPATENT: '-- last patent or patent is bigger than buffer -- IF LEN(BUFFER$) <= PACKETSIZE - SCD - 1 THEN NPN& = LEN(BUFFER$) + SCD + 1: GOTO FIX0 BP = BP + 1 PRINT PX$; " IS BIGGER THAN BUFFER." LENFOUND = PACKETSIZE * BP SEEK #1, QQQ& + LENFOUND - PATTERNLENGTH GOTO GR '-------] 7910 ' [------- error handler -------] ' WRONGFILE$ = FOO$ ' File where error occured, maybe? BEEP: PRINT PRINT "Error # "; ERR; " at or after line "; ERL; ". Device error # "; ERDEV; " "; ERDEV$ PRINT " Error is -- "; IF ERR = 1 THEN PRINT "Next without For coding error" IF ERR = 2 THEN PRINT "Coding Syntax error" IF ERR = 3 THEN PRINT "Return without Gosub" IF ERR = 4 THEN PRINT "Out of DATA" IF ERR = 5 THEN PRINT "Illegal function call" IF ERR = 6 THEN PRINT "Overflow" IF ERR = 7 THEN PRINT "out of memory" IF ERR = 8 THEN PRINT "Undefined line number coding error" IF ERR = 9 THEN PRINT "SUBSCRIPT OUT OF RANGE "; N IF ERR = 10 THEN PRINT "Duplicate definition coding error" IF ERR = 11 THEN PRINT "Division by Zero" IF ERR = 14 THEN PRINT "Out of string space" IF ERR = 15 THEN PRINT "String too long. 255 max" IF ERR = 23 THEN PRINT "Line buffer overflow" IF ERR = 24 THEN PRINT "Device Time-out" IF ERR = 25 THEN PRINT "device fault" IF ERR = 27 THEN PRINT "Out of paper" IF ERR = 50 THEN PRINT "FIELD overflow." IF ERR = 51 THEN PRINT "Internal error" IF ERR = 52 THEN 8410 ' " = DISK ERRORS" IF ERR = 53 THEN 8410 IF ERR = 54 THEN 8410 IF ERR = 55 THEN 8410 IF ERR = 56 THEN PRINT "Field Statement active" IF ERR = 57 THEN PRINT "device I/O error" IF ERDEV = 10 THEN PRINT " Printer off line?" IF ERR = 58 THEN 8410 IF ERR = 59 THEN 8410 IF ERR = 61 THEN 8410 IF ERR = 62 THEN 8410 IF ERR = 63 THEN 8410 IF ERR = 64 THEN GOTO 8410: ' fileerr IF ERR = 67 THEN 8410 IF ERR = 68 THEN PRINT "Device unavailable. Is there a D: directory for the temporary stuff?" IF ERR = 69 THEN PRINT "Comm buffer overflow." IF ERR = 70 THEN GOTO 8410 IF ERR = 71 THEN GOTO 8410: ' "Disk ERRORS IF ERR = 72 THEN GOTO 8410: IF ERR = 73 THEN PRINT "Advanced feature unavailable." IF ERR = 74 THEN PRINT "Rename across disks. see programming manual." IF ERR = 75 THEN GOTO 8410: IF ERR = 76 THEN GOTO 8410: GOTO 8710 8410 ' fileerr: PRINT "File Related Error # "; ERR; " at or after line "; ERL; "." PRINT " Error is -- "; SHELL "cat" PRINT "File Related Error # "; ERR; " at or after line "; ERL; "." PRINT " Error is -- "; IF ERR = 52 THEN PRINT "Bad file name or number." IF ERR = 53 THEN PRINT "FILE NOT FOUND. -- "; WRONGFILE$ IF ERR = 54 THEN PRINT "Bad File Mode. -- "; WRONGFILE$ IF ERR = 55 THEN PRINT "file already open. -- "; WRONGFILE$ IF ERR = 58 THEN PRINT "File already exists. -- "; WRONGFILE$ IF ERR = 59 THEN PRINT "Bad record length." IF ERR = 61 THEN PRINT "Disk Full." IF ERR = 62 THEN PRINT "Input past end of file." IF ERR = 63 THEN PRINT "Bad record number." IF ERR = 64 THEN PRINT "Bad file name. Check format." IF ERR = 67 THEN PRINT "Too many files." IF ERR = 71 THEN PRINT "Disk Not Ready." IF ERR = 70 THEN PRINT "Permission denied. Read only file? Disk Write protected?" IF ERR = 72 THEN PRINT "Disk Media Error." IF ERR = 75 THEN PRINT "path / file access error. -- "; WRONGFILE$ IF ERR = 76 THEN PRINT "Path not found." PRINT "File troubles usually are path or file name errors." PRINT " Do you need a \ or c:\ in the path?" PRINT " Does the disk directory exist, especially ramdisks. D:?" PRINT " Is the file on another directory?" PRINT "TROUBLE is most likely in NAME or PATH of "; WRONGFILE$ GOTO 8710 8710 INPUT "Fix Problem. Then CR to continue X or Q to quit. "; Q$: Q$ = UCASE$(Q$) IF Q$ = "X" THEN SYSTEM IF Q$ = "Q" THEN SYSTEM RESUME ' back to line from whence the error occured '------] ENDSONG: '[-------- end song --------] RANDOMIZE TIMER FOR Q = 1 TO 25: SOUND INT(2500 - 200) * RND + 200, 4: NEXT Q SOUND 32000, 15 SOUND 2000, 1: SOUND 32000, 2: SOUND 2000, 3: SOUND 32000, 2 SOUND 2000, 1: SOUND 32000, 2: SOUND 2000, 3: SOUND 32000, 2 SOUND 2000, 1: SOUND 32000, 2 ' .-.-. LOCATE 24, 1: PRINT "--- DONE ---" Q& = TIMER + 1: DOOLAY: IF TIMER < Q& THEN GOTO DOOLAY ' -------------- end of it all --------------