20 '          CIPHER PROGRAM
22 '
24 '              PROGRAM TO ENCODE OR DECODE ASCII FILES.  INCLUDES
26 '              THE FACILITY TO ENCRYPT FILES.  FOLDS ALL CHARACTERS
28 '              INTO THE PRINTABLE ASCII SET.  ALLOWS "WORD PROCESSING"
29 '              FILES TO BE TRANSMITTED BY ELECTRONIC MAIL SYSTEMS.
30 '    
32 '                 A.I. ZYGIELBAUM              APRIL 7, 1984
33 '
40 '              (SUGGESTED BY AN ARTICLE BY THEODORE C. HINES
50 '              IN BYTE MAGAZINE, SEPT ISSUE, 1983)
60 '    
62 '
65 '   DECIDE WHETHER TO ENCODE OR DECODE
70 INPUT "DO YOU WANT TO ENCODE, OR DECODE? (E OR D) ",A$
71 '   NOTE: FLG IS SET TO 1 FOR ENCODE OR DECODE AND 0 FOR JUST FOLDING
72 GOSUB 5000
75 ED$=LEFT$(A$,1)
80 IF ED$="D" OR ED$="E" THEN 100 ELSE 70
95 '
97 ' IDENTIFY THE FILES
98 '
100 INPUT "FILE TO READ FROM? ",A$
105 GOSUB 5000				'MAKE NAME UPPERCASE 
107 GOSUB 6000				'MAKE SURE THAT THE FILE EXISTS
108 IF XFLG=0 THEN PRINT "FILE DOES NOT EXIST, TRY AGAIN",:GOTO 100
110 OPEN "R",1,A$,128
120 FIELD 1,128 AS IN$
122 INPUT "FILE TO WRITE TO? ",A$
124 GOSUB 5000
126 GOSUB 6000				'TEST FOR OVERWRITING A FILE
128 IF XFLG=0 THEN 140			'XFLG=0 MEANS THAT THE FILE DOES NOT EXIST
130 XT$=A$:INPUT "FILE EXISTS, OVERWRITE (Y/N)? ",A$
132 GOSUB 5000
134 IF LEFT$(A$,1)="Y" THEN A$=XT$:GOTO 140 ELSE 122
140 OPEN "R",2,A$,128
150 FIELD 2,128 AS OT$
155 '   GO TO THE GET THE KEY WORD ROUTINE 
160 GOSUB 910
162 IF FLG=1 THEN RANDOMIZE C                    'CREATE THE RANDOM LIST
166 IF ED$="E" THEN 170 ELSE 500
169 '
170 '
171 ' ENCODE ROUTINE
172 OB$="":OCNT=0:CRCT=0                         'INITIALIZE COUNTERS,BUFFER
175 '   WRITE "|[" TO THE OUTPUT FILE TO INDICATE "START OF FILE"
180 B$="|["
190 SFLG=0             'SFLG HAS THE SAME MEANING AS FLG.  0 HERE MEANS STORE AS IS, DON'T ENCRYPT
192 GOSUB 2000
195 '   NOW GET THE FIRST RECORD FROM THE INPUT FILE
200 GET 1
210 A$=IN$
220 PRINT A$
222 '   NOW GO THROUGH CHARACTER BY CHARACTER AND FOLD ALL INTO
223 '     THE PRINTABLE SET AND, IF REQUESTED, ENCODE
224 '   OB$ IS THE OUTPUT STRING, OCNT THE OUTPUT COUNT, CRCT THE CARRIAGE
225 '     RETURN COUNT
230 FOR I=1 TO LEN(A$)
250 D=ASC(MID$(A$,I,1))
275 '   FOLD ALL CHARACTERS INTO THE PRINTABLE SET
276 '     DO THIS BY RESCALING UNPRINTABLE CHARACTERS INTO THE PRINTABLE SET
277 '     AND MARK THEM BY PRECEEDING THE RESCALED CHARACTER WITH \,}, OR ~
280 IF D<32 THEN B$="|"+CHR$(D+32):GOTO 370      '| indicates char<32
285 IF D<124 THEN B$=CHR$(D):GOTO 370            '  normal prinatable char
340 IF D>191 THEN B$="}"+CHR$(D-160):GOTO 370    '}  means char was >191
350 'IF YOU GOT THIS FAR, 123<D<192
360 B$="~"+CHR$(D-92)                            '~  means 123<char<192
365 '   CALL THE OUTPUT ROUTINE
370 SFLG=FLG
375 GOSUB 2000
400 NEXT I
430 IF NOT EOF(1) GOTO 200
432 '   THE FILE IS EMPTY IF YOU GET HERE
434 B$="|]"                                      '  END OF FILE MARKER
442 SFLG=FLG
444 GOSUB 2000                                   '  STORE IN OUTPUT LIST
446 IF OCNT>0 THEN LSET OT$=OB$:PUT 2            'OUTPUT REMNANT--THE SUBROUTINE AT 2000 STORES IN
447						 '    128 BYTE CHUNKS.  MAKE SURE THAT ANY REMNANT BEYOND 128 IS OUPUT.
460 CLOSE:PRINT "CLOSED!":END
462 '
464 '
500 ' DECODE ROUTINE
553 '
555 OB$=""				  'INITIALIZE OUTPUT BUFFER 
558 '   GET FIRST RECORD
585 '   GET CHARACTERS AND SEE IF THEY ARE "|["---IE FIND THE BEGINNING OF THE FILE
586 OCNT=0:GET 1:A$=IN$:ICNT=128          'ICNT IS THE NUMBER OF CHARACTERS IN THE INPUT BUFFER
588 SFLG=0:GOSUB 4000
600 IF A=-1 THEN PRINT "NOTHING FOUND":END       '-1 MEANS END OF FILE WAS FOUND
602 IF A<>-2 THEN GOTO 588                       '-2 MEANS START OF FILE; IF NOT FOUND, TRY AGAIN
605 SFLG=FLG:GOSUB 4000                          'GET A CHARACTER
610 IF A=-1 GOTO 700                             'END OF FILE FOUND, FINISH UP
620 GOSUB 4700                                   'WRITE CHARACTER TO OUTPUT
630 GOTO 605                                     ' LOOP UNTIL END OF FILE IS FOUND
700 IF OCNT>0 THEN LSET OT$=OB$:PUT 2            'WRITE REMNANT OF BUFFER
900 CLOSE:PRINT "CLOSED!":END
905 '
910 'KEYWORD SUBROUTINE
920 LINE INPUT "KEYWORD? (JUST RETURN FOR NO ENCRYPTION) ",A$
925 IF LEN(A$)=0 THEN FLG=0:RETURN ELSE FLG=1           'SET THE FLG: 0-NO ENCRYPTION,1-ENCRYPTION
930 FOR I=1 TO LEN(A$)
940 A=ASC(MID$(A$,I,1))
950 C=C+A
960 NEXT I
970 RETURN
2000 '   SUBROUTINE TO PUT THINGS IN THE OUTPUT FILE FOR ENCODE AND FOLD
2365 '   ADD INTO THE OUTPUT BUFFER, WRITE IF NECESSARY
2366 '       THE ROUTINE STORES 128 BYTES AT A TIME TO THE DISC FILE
2367 '       A CARRIAGE RETURN IS INSERTED EVERY 65 CHARACTERS
2368 '          OCNT KEEPS TRACK OF THE NUMBER OF CHARACTERS IN THE BUFFER
2369 '          CRCT KEEPS TRACK OF THE NUMBER OF CHARACTERS SINCE THE LAST CARRIAGE RETURN
2370 FOR K=1 TO LEN(B$)
2373 D=ASC(MID$(B$,K,1))
2374 IF SFLG=1 THEN D=D+INT(RND(.5)*94):IF D>126 THEN D=D-95   'ADD RANDOM NUMBER
2375 '   MAKE SURE THAT THE NEW CHARACTER IS <126 ELSE SCALE IT
2377 '   ADD THE CHARACTER TO THE OUTPUT STRING
2378 OB$=OB$+CHR$(D)
2380 OCNT=OCNT+1
2382 CRCT=CRCT+1
2383 '   IF THE COUNT IS 128 THEN WRITE TO THE OUTPUT BUFFER
2384 IF OCNT<128 GOTO 2392
2385 PRINT OB$
2386 LSET OT$=OB$:OB$=""
2388 PUT 2
2390 OCNT=0
2391 '   IF 65 CHARACTERS ARE IN THE BUFFER, STICK IN A CARRIAGE RETURN
2392 IF CRCT<65 GOTO 2398
2394 OB$=OB$+CHR$(13):CRCT=0
2396 GOTO 2380
2398 NEXT K
2400 RETURN
4000 '   INPUT CHARACTERS AND UNFOLD OR DECODE THEM
4100 GOSUB 4500					 'GETS THE CHARACTER
4102 IF A=-1 THEN RETURN			 '-1 INDICATES END OF FILE
4125 IF A<32 GOTO 4100                           'IGNORE CONTROL CHARACTERS
4130 IF A<124 GOTO 4195                          'NORMAL PRINTABLE CHARACTER
4135 IF A>126 THEN PRINT "UH OH >126":END        'CHARACTER OUT OF BOUNDS
4137 '
4138 '  NON PRINTABLE CHARACTERS ARE SCALED AND PRECEEDED BY ONE OF THE MARKER CHARACERS: |,}, OR ~.
4139 '  THE NEXT SET OF STATEMENTS RECONSTITUTES THE ORIGINAL CHARACTER
4140 '   IF YOU GOT HERE, 123<A<127              'MARKER CHAR:|}~
4145 A1=A                                        'SAVE MARKER
4150 GOSUB 4500                                  'GET THE NEXT CHARACTER
4152 IF EOF(1) THEN RETURN
4160 IF A1=124 AND A=91 THEN A=-2:RETURN
4162 IF A1=124 AND A=93 THEN A=-1:RETURN         'A=-1 IS A FLAG: END OF INPUT FILE
4165 IF A1=124 THEN A=A-32:GOTO 4195            'A IS A CONTROL CHARACTER
4175 IF A1=125 THEN A=A+160:GOTO 4195            'A IS A PARITY SET CHAR
4180 'IF YOU GOT HERE THEN A1=126
4190 A=A+92                                  'A IS A PARITY SET CHAR OR 124-127
4195 RETURN
4500 '   INPUT CHARACTERS
4502 IF ICNT<>0 GOTO 4515			'IF THERE ARE NO CHARACTERS IN THE INPUT BUFFER
4504 IF EOF(1) THEN A=-1:RETURN			'READ MORE FROM THE DISC FILE; UNLESS END OF FILE IS ENCOUNTERED
4506 GET 1:A$=IN$:ICNT=128
4515 A=ASC(MID$(A$,129-ICNT,1))                   'PULL OUT THE NEXT CHARACTER
4520 ICNT=ICNT-1
4522 IF A<32 GOTO 4502                   'IF CONTROL CHARACTER, SKIP--SHOULDN'T BE IN THE FILE ANYWAY
4523 IF A>126 GOTO 4502                  'IF PARITY-SET CHAR, SKIP--SHOULDN'T BE IN THE FILE ANYWAY
4525 IF SFLG=1 THEN A=A-INT(RND(.5)*94):IF A<32 THEN A=A+95  'TAKE AWAY RANDOM
4526                                           'FOLD BACK IF TOO SMALL
4527 RETURN
4700 '   OUTPUT ROUTINE FOR DECODE (UNFOLD)
4701 '		OUTPUTS IN 128 BYTE BLOCKS TO THE OUTPUT DISC FILE
4710 OB$=OB$+CHR$(A)
4720 OCNT=OCNT+1
4730 IF OCNT=128 THEN PRINT OB$;:LSET OT$=OB$:PUT 2:OB$="":OCNT=0
4740 RETURN
5000 '
5010 '  SUBROUTINE TO MAKE THE FILENAMES ALL UPPERCASE
5020 '
5030 TA$=""
5040 FOR K=1 TO LEN(A$)
5050 US$=MID$(A$,K,1)
5060 X=ASC(US$)
5070 IF X<123 AND X>96 THEN TA$=TA$+CHR$(X-32) ELSE TA$=TA$+US$
5080 NEXT K
5090 A$=TA$
5100 RETURN
6000 '
6010 'ROUTINE TO TEST FOR FILE EXISTENCE
6020 '
6030 ON ERROR GOTO 6100
6040 NAME A$ AS A$
6050 PRINT "UH OH, SHOULDN'T BE HERE"
6060 STOP
6100 '
6110 'ERROR PICK UP ROUTINE FOR FILE EXISTENCE TEST
6120 IF ERR=58 AND ERL=6040 THEN XFLG=1:RESUME 6200		'FILE EXISTS
6130 IF ERR=53 AND ERL=6040 THEN XFLG=0:RESUME 6200		'FILE DOES NOT EXIST
6140 ON ERROR GOTO 0
6150 STOP
6200 ON ERROR GOTO 0
6210 RETURN
10000 END