/*REXX*/
/*--- Kryptos.REX - PCREXX/PREXX/OOREXX/Regina/SPF4/5/Roo/R4-WinXP/7/8/10-Linux(Wine) - 20191112 - Mark & Richard McDonald --------
  Problem: Can REXX be used to encode text/files using a passphrase? Yes. Shows use of REXX Functions with local vars (PROCEDURE)
  and global variables. PARSE added to ARG keyword prevents passed arguments from being forced to upper case.  ; in REXX means end
  of statement and is not required unless you are stacking multiple statements on a line.  Program written using SPFPCv5
  --------------------------------------------------------------------------------------------------------------------------------*/
  parse version name level date1 date2 date3; parse source TOS ZED                              ;/*Det REXX Info*/
  IF TRANSLATE(LEFT(TOS,3)) == "WIN" THEN SL = "\";ELSE SL = "/"                                ;/*Det Path Delimiter*/
  T = WORD(ZED,2); LP = LASTPOS(SL,T); PTH = LEFT(T,LP)                                         ;/*Set File Paths*/
  CALL BTABLE                                                                                   ;/*Build SB Global TSB, ML, L.*/
  PP = ""; PP = "NSARocksinColorado!"; PPP = 0                                                  ;/*Passphrase*/
  DCF = 0;SAY "Use TUI (Y/N/Q)";PULL TT;IF TRANSLATE(TT) = "Y" THEN DCF = 1                     ;/*Use Text User Interface (TUI)*/
  IF DCF = 1 THEN DO                                                                            ;/*DCF = 1 then Disp TUI*/
    CALL ACLS;CALL ASAY 0,0,0,"";CALL ASAY 1,1,15,CENTER("Mark's Krypto REXX",80)               ;/*Reset Console-Disp Text*/
    CALL APOS 3,1;SAY "This program demostrates various REXX language abilites."                ;/*Explain Test 1*/
    CALL ASAY 5,1,31,"Press ENTER to run String Test";PULL Z;CALL TEST1                         ;/*Run Test 1*/
    CALL ASAY 6,1,12,PTO;CALL ASAY 7,1,15,ET;CALL ASAY 8,1,9,OP                                 ;/*Explaint Test 2*/
    CALL ASAY 10,1,31,"Encoding sequential file KT";CALL TEST2                                  ;/*Run Test 2*/
    CALL ASAY 17,1,15,"Files ZZ1.TXT (Encode Text) and ZZD.TXT (Decoded text) created"
    CALL ASAY 19,1,10,"Encoding sequential file KT to Binary";CALL TEST3                        ;/*Run Test 3*/
    CALL ASAY 20,1,7,"Files ZZ2.TXT (Binary Encode) and ZZZ.TXT (Binary Decode) created";
    END
  IF DCF = 0 THEN DO; CALL TEST1; CALL TEST2; CALL TEST3; SAY "Files Created"; END
  SAY; SAY "Press ENTER to exit program";PULL Z;EXIT
TEST1:                                                                                          ;/*Encode String Test Code*/
  PTO = ""; PTO = "the quick brown fox jumps over the lazy dog."                                ;/*Plain Text*/
  PPP = 0;SB = 0;ET = "";ET = ENCODE(TRANSLATE(PTO,D2C(232),D2C(32)));IF DCF = 0 THEN SAY ET    ;/*Encode Plain Text*/
  PPP = 0;SB = 0;OP = "";OP = TRANSLATE(DECODE(ET),D2C(32),D2C(232));IF DCF = 0 THEN SAY OP     ;/*Decode Encoded Text*/
RETURN
TEST2:                                                                                          ;/*Encode Squential File Test Code*/
  SB = 3;PPP = 0;T = FSENCODE(PTH||"KT.REX",PTH||"ZZ1.TXT")                                     ;/*PlainText/Encoded Files*/
  SB = 3;PPP = 0;T = FSDECODE(PTH||"ZZ1.TXT",PTH||"ZZD.TXT")                                    ;/*Encoded/Plain Text Files*/
RETURN
TEST3:                                                                                          ;/*Encode Binary File Test Code*/
  PPP = 0; SB = 1; FIN = PTH||"KT.REX";  FOUT = PTH||"ZZ2.TXT"; TR = FBENCODE(FIN,FOUT)         ;/*Encode Test File*/
  PPP = 0; SB = 1; FIN = PTH||"ZZ2.TXT"; FOUT = PTH||"ZZZ.TXT"; TR = FBDECODE(FIN,FOUT)         ;/*Decode Binary File*/
RETURN
/*=== Subroutines ================================================================================================================*/
FBDECODE: PROCEDURE EXPOSE DCF PP PPP SB TSB ML L. ; PARSE ARG FIN,FOUT                         ;/*Decode Binary File*/
  FL = CHARS(FIN); TR = CHARIN(FIN,1,0); TR = CHAROUT(FOUT,,1)                                  ;/*Det Chars/File Ensure Start Pos*/
  DO CNT = 1 TO FL                                                                              ;/*Loop Thru File*/
     ET = ""; ET = CHARIN(FIN,CNT,1)                                                            ;/*Read 1 Char*/
     PT = ""; PT = DECODE(ET)                                                                   ;/*Decode Char*/
     XR = ""; XR = TRANSLATE(PT,X2C(20)X2C(0D)X2C(0A)X2C(20),D2C(232)D2C(213)D2C(210)D2C(226))  ;/*Cvrt BK T0 Space CR LF*/
     TR = CHAROUT(FOUT,XR);                          IF DCF = 1 THEN DO;CALL ASAY 19,60,9,XR;END;/*Write Char to Out File*/
  END CNT; TR = LINEOUT(FIN); TR = LINEOUT(FOUT)                                                ;/*Close Files*/
RETURN 1
FBENCODE: PROCEDURE EXPOSE DCF PP PPP SB TSB ML L. ; PARSE ARG FIN,FOUT                         ;/*Encode Binary File*/
  FL = CHARS(FIN); TR = CHARIN(FIN,1,0); TR = CHAROUT(FOUT,,1)                                  ;/*Det Chars/File Ensure Strt Pos*/
  DO FL                                                                                         ;/*Loop Thru File*/
     PT = ""; PT = CHARIN(FIN,,1)                                                               ;/*Get Char*/
     XR = ""; XR = TRANSLATE(PT,D2C(232)D2C(213)D2C(210)D2C(226),X2C(20)X2C(0D)X2C(0A)X2C(1A))  ;/*Cvrt Space LF CR*/
     ET = ""; ET = ENCODE(XR);IF DCF = 1 THEN DO;CALL ASAY 19,56,12,PT;CALL ASAY 19,58,15,ET;END;/*Encode x Times*/
     TR = CHAROUT(FOUT,ET)                                                                      ;/*Write Char to File*/
  END; TR = LINEOUT(FIN); TR = LINEOUT(FOUT)                                                    ;/*Close Files*/
RETURN 1
FSENCODE: PROCEDURE EXPOSE DCF PP PPP SB TSB ML L. ; PARSE ARG FIN,FOUT                         ;/*Encode Sequential File*/
   DO WHILE LINES(FIN) > 0                                                                      ;/*Loop Thru File Lines*/
      PT = ""; PT = TRANSLATE(LINEIN(FIN),D2C(232),D2C(32));IF LEFT(PT,1) == D2C(26) THEN LEAVE ;/*Get File Line Cnvrt Spaces*/
      ET = ""; ET = ENCODE(PT);IF DCF = 1 THEN DO;CALL ASAY 11,1,12,PT;CALL ASAY 13,1,15,ET;END ;/*Encode Line*/
      TR = LINEOUT(FOUT,ET)                                                                     ;/*Write Line to File*/
   END; TR = LINEOUT(FIN); TR = LINEOUT(FOUT)                                                   ;/*Close Files*/
RETURN 1
FSDECODE: PROCEDURE EXPOSE DCF PP PPP SB TSB ML L. ; PARSE ARG FIN,FOUT                         ;/*Deccode Sequential File*/
  DO WHILE LINES(FIN) > 0                                                                       ;/*Loop Thru File*/
     ET = ""; ET= LINEIN(FIN)                                                                   ;/*Get Line From Filre*/
     OP = ""; OP = DECODE(ET)                                                                   ;/*Decode*/
     PT = ""; PT = TRANSLATE(OP,D2C(32),D2C(232))                                               ;/*Restore Spaces*/
     TR = LINEOUT(FOUT,PT);                           IF DCF = 1 THEN DO;CALL ASAY 15,1,9,PT;END;/*Write to Line*/
  END; TR = LINEOUT(FIN); TR = LINEOUT(FOUT)                                                    ;/*Close Files*/
RETURN 1
ENCODE: PROCEDURE EXPOSE PP PPP SB TSB ML L. ; PARSE ARG PT                                     ;/*Encodes PT (Plain Text)*/
  LPT = LENGTH(PT); LPP = LENGTH(PP); ET = ""                                                   ;/*Init Function Vars*/
  DO CNT = 1 TO LPT                                                                             ;/*Loop Thru Plain Text*/
     P = 0; Q = 0; C = 0; N = 0                                                                 ;/*Init Loop Vars*/
     SB = INCSB(SB,TSB)                                                                         ;/*Increment SB*/
     P = FINDP(SUBSTR(PT,CNT,1),SB)                                                             ;/*Det # of Letter in Plain Txt*/
     PPP = INCPP(PPP,LPP)                                                                       ;/*Increment Position in Password*/
     Q = FINDP(SUBSTR(PP,PPP,1),SB)                                                             ;/*Det # of Letter in Password*/
     C = P + Q; IF C >=ML THEN C = C -ML                                                        ;/*Calc Modulo*/
     N = C + 1                                                                                  ;/*Det Encode Char*/
     ET = ET || WORD(L.N,1)                                                                     ;/*Appd Encode Char to Rtrn String*/
  END CNT
  RETURN (ET)
DECODE: PROCEDURE EXPOSE PP PPP SB TSB ML L. ; PARSE ARG ET                                     ;/*Decodes Encoded Text*/
  LET = LENGTH(ET); LPP = LENGTH(PP); OP = ""                                                   ;/*Init Function Vars*/
  DO CNT = 1 TO LET                                                                             ;/*Loop Thru Ecoded Text*/
     C = 0; K = 0; M = 0                                                                        ;/*Init Loop Vars*/
     SB = INCSB(SB,TSB)                                                                         ;/*Increment SB*/
     C = FINDL(SUBSTR(ET,CNT,1))                                                                ;/*Det Number of Key Letter*/
     PPP = INCPP(PPP,LPP)                                                                       ;/*Increment Position in Password*/
     K = FINDP(SUBSTR(PP,PPP,1,),SB)                                                            ;/*Det Number of Plain Text Letter*/
     M = C - K; IF M < 0 THEN DO; M = SUBSTR(M,2); M = ML - M; END                              ;/*Calc Modulo*/
     A = FINDA(M,SB)                                                                            ;/*Det Plain Text Letter*/
     OP = OP || A                                                                               ;/*Append Letter to Return String*/
   END CNT
RETURN (OP)
INCPP: PROCEDURE; PARSE ARG PPP,LPP; PPP = PPP + 1; IF PPP > LPP THEN PPP = 1; RETURN (PPP)
INCSB: PROCEDURE; PARSE ARG SB,TSB; SB = SB + 1; IF SB > TSB THEN SB = 1; RETURN (SB)
FINDP: PARSE ARG PC,SB; DO PCNT = 1 TO ML; W = WORD(L.PCNT,(SB+1)); IF LEFT(W,1) == PC THEN RETURN SUBSTR(W,3); END; RETURN (999999)
FINDC: PARSE ARG N; RETURN WORD(L.N,1)
FINDL: PARSE ARG L; T = ""; DO LCNT = 1 TO ML; IF L == WORD(L.LCNT,1) THEN T = SUBSTR(WORD(L.LCNT,2),3); END; RETURN (T)
FINDA: PARSE ARG M,SB; DO ACNT = 1 TO ML; N = SUBSTR(WORD(L.ACNT,SB+1),3); IF N == M THEN RETURN (LEFT(WORD(L.ACNT,SB+1),1)); END; RETURN ("ZZZ")
BTABLE:
  SBS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890!@#$%^&*()_-+={[}]|\:;<,>.?/~`abcdefghijklmnopqrstuvwxyz"||D2C(232)||X2C(27)||X2C(22)||D2C(210)||D2C(213)||D2C(226)
  ABC = "ZYXWVUTSRQPONMLKJIHGFEDCBA0123456789zyxwvutsrqponmlkjihgfedcba!@#$%^&*()_-+={[}]|\:;<,>.?/`~"||X2C(22)||X2C(27)||D2C(232)||D2C(213)||D2C(210)||D2C(226)
  ML = LENGTH(ABC); TSB = ML;/* ML=26 */
  DO CNT = 1 TO ML; L.CNT = SUBSTR(ABC,CNT,1)" "SUBSTR(SBS,CNT,1)"="SUBSTR((CNT-1),1,2," "); END
  DO SB = 2 TO ML
     N = WORDS(L.1); TL = ML + 1; L.TL = L.1" " LEFT(WORD(L.1,N),1)"="SUBSTR((ML-1),1,2," ")
     DO CNT = 1 TO ML; TN = CNT + 1; L.CNT = L.CNT" "LEFT(WORD(L.TN,N),1)"="SUBSTR((CNT-1),1,2," "); END
  END
RETURN
ACLS: PROCEDURE; T = CHAROUT('','1b'x||'[2J');RETURN                                            ;/*ANSI Reset/Clear Screen*/
APOS: PROCEDURE; ARG ROW,COL; T = CHAROUT('','1b'x||"["||ROW||";"||COL||"H");RETURN             ;/*Position Cursor*/
ASAY: PROCEDURE; PARSE ARG ROW,COL,ATTR,TSTR                                                    ;/*Pos Csr Set Color Disp Text*/
  AF = "30 34 32 36 31 35 33 37 1;30 1;34 1;32 1;36 1;31 1;35 1;33 1;37"                        ;/*ANSI Foreground Colors*/
  AB = "40m 44m 42m 46m 41m 45m 43m 47m 5;40m 5;44m 5;42m 5;46m 5;41m 5;45m 5;43m 5;47m"        ;/*Ansi Background Colors*/
  ESC = "1b"x||"["; CF = (ATTR // 16); CB = (((ATTR - CF) / 16) // 128)                         ;/*Set ESC Calc Fore/Back  Color*/
  FC = WORD(AF,(CF+1)); BC = WORD(AB,(CB+1))                                                    ;/*Det ANSI Color*/
  IF ROW = 0 THEN TSTR = ESC||"2J"                                                              ;/*Clear Screen?*/
  IF ROW <> 0 THEN TSTR = TSTR||ESC||"0m"                                                       ;/*Lock ANSI Code*/
  TC = ESC||FC||";"||BC; SP = ESC||ROW||";"||COL||"H"; T = CHAROUT('',SP||TC||TSTR)             ;/*Set ANSI Position Send to Scrn*/
RETURN