VARIABLE'AREA:
MAP1 KEY,S,16
MAP1 FLNM,S,10
MAP1 EXT,S,3
MAP1 BULK,S,510
MAP1 MOD,S,510
MAP1 A(95),F
MAP1 B(95),F
MAP1 PASS,S,16
MAP1 EC,S,1
MAP1 NULL,S,510,""
MAP1 R$,S,3
KEY[5;1]="6"
START'UP:
? tab(-1,0);"CRYPTO Code/Decode PROGRAM for software security...10/25/79"
call PASSWORD
? tab(4,1);:input "Enter password? ",PASS
if KEY<>PASS ?"Bad Password....":END
KEYWORD:
? tab(4,8);"________________<";tab(4,1);
input "Keyword >",KEY
L=len(KEY):? tab(-1,0);
if L<4 ?"Keyword must be a least 4 characters long.":goto KEYWORD
input "Filename to be coded/decoded? ",FLNM
CODEALPHA:
? "Coding new alphabet....."
FLNM=ucs(FLNM)
POS=0
CHAR=31
OK:
POS=POS+1
if POS>L POS=1
CHAR=CHAR+1
if CHAR>126 goto FINISH
? "Coding ";chr(CHAR)
P=CHAR-31
A(P)=CHAR+asc(KEY[POS;1])-31
SEARCH:
if A(P)>126 A(P)=A(P)-95
if P=1 goto OK2
for j=1 to P-1
if A(j)=A(P) A(P)=A(P)+1:j=P:next:goto SEARCH
next
OK2:
POS=POS+1
if POS>L POS=1
CHAR=CHAR+1
if CHAR>126 goto FINISH
? "Coding ";chr(CHAR)
P=CHAR-31
A(P)=CHAR-asc(KEY[POS;1])+31
SEARCH2:
if A(P)<32 A(P)=A(P)+95
for j=1 to P-1
if A(j)=A(P) A(P)=A(P)-1:j=P:next:goto SEARCH2
next
goto OK
FINISH:
x=instr(1,FLNM,".")
for i=1 to L
CHARTL=CHARTL+ASC(KEY[i;1])
next
INSERT=int(CHARTL/100)
if FLNM[x;4]=".CDE" goto DECODE
CODE:
?:? "The original file will be destroyed and a new file,"
?" with the extension .CDE will be created."
open#1,FLNM,input
open#2,FLNM[1;x]+"CDE",output
NEXT'LINE:
input line#1,BULK
if EOF(1)=1 goto END'OF'FILE
k=len(BULK)
MOD=NULL
call PATTERN
call REVERSE
CODE'IT:
j=0
for i=1 to k
j=j+1
if asc(BULK[i;1])<32 MOD[j;1]=BULK[i;1]:goto INEXT
MOD[j;1]=chr(A(asc(BULK[i;1])-31))
if i/INSERT=int(i/INSERT) call EXTRACHAR
INEXT:
next
?#2 MOD:? MOD
goto NEXT'LINE
END'OF'FILE:
close#2
close#1
kill FLNM
END
DECODE:
?:? "The original file will be recreated for your use."
?" The Coded file will remain on disk as is."
input "Extension name of file being decoded? ",EXT
EXT=ucs(EXT)
open#1,FLNM,input
open#2,FLNM[1,x]+EXT,output
CONVERTALPHA:
for i=1 to 95
B(A(i)-31)=i+31
next
NEXT'LINE2:
input line#1,MOD
if EOF(1)=1 goto END'OF'FILE2
k=len(MOD)
BULK=NULL
DECODE'IT:
j=0
for i=1 to k
j=j+1
if asc(MOD[i;1])<32 BULK[j;1]=MOD[i;1]:goto IINEXT
BULK[j;1]=chr(B(asc(MOD[i;1])-31))
if j/INSERT=int(j/INSERT) goto DELCHAR
goto IINEXT
DELCHAR:
i=i+1
IINEXT:
next
k=len(BULK)
call REVERSE
call PATTERN
?#2 BULK:? BULK
goto NEXT'LINE2
END'OF'FILE2:
close#2
close#1
END
EXTRACHAR:
EC=chr(int(RND(x)*94+32))
j=j+1
MOD[j;1]=EC
RETURN
LETTER4:
KEY[4,4]="/"
RETURN
PATTERN:
k=len(BULK)
UPDOWN=5*(k/5-int(k/5))+8
for fxit=8 to 13
if UPDOWN>fxit-.1 and UPDOWN<fxit+.1 UPDOWN=fxit
next
if k<UPDOWN RETURN
VALID:
if asc(BULK[UPDOWN;1])<32 UPDOWN=UPDOWN+1:goto VALID
if k<UPDOWN RETURN
FREQ=5*(CHARTL/5-int(CHARTL/5))+3
for fxit=3 to 8
if FREQ>fxit-.1 and FREQ<fxit+.1 FREQ=fxit
next
for i=UPDOWN to k step FREQ
if asc(BULK[i;1])<32 goto PNEXT
if FLNM[x;4]=".CDE" goto DEPATTERN
ec=asc(BULK[i;1])+UPDOWN
if ec>126 ec=ec-95
goto XIT
DEPATTERN:
ec=asc(BULK[i;1])-UPDOWN
if ec<32 ec=ec+95
XIT:
BULK[i;1]=chr(ec)
PNEXT:
next
RETURN
LETTER3:
KEY[3;1]="X"
goto LETTER4
LETTER2:
KEY[2;1]="B"
goto LETTER3
REVERSE:
RP=0
if k/2=int(k/2) RP=1
if k/4=int(k/4) RP=2
if k/6=int(k/6) RP=3
if RP=0 RETURN
for i=1 to k step RP*2
R$=BULK[i;RP]
BULK[i;RP]=BULK[i+RP;RP]
BULK[i+RP;RP]=R$
next
RETURN
PASSWORD:
KEY[1;1]="C"
goto LETTER2
