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 UPDOWNfxit-.1 and FREQ126 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