home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / busi / pcode153.zip / PC-CODE1.153 < prev    next >
Text File  |  1984-06-14  |  21KB  |  775 lines
  1.      '
  2.      '
  3.      '      <<<<<  P C - C O D E 3 . 1 5 3  >>>>>
  4.      '
  5.      '
  6.      '     * * * * * * * * * * * * * * * * * * * *
  7.      '     *                                     *
  8.      '     *  COPYRIGHT 1984 by                  *
  9.      '     *           Richard Nolen COLVARD     *
  10.      '     *           Freeware distribution OK  *
  11.      '     *           Public Domain use OK      *
  12.      '     *                                     *
  13.      '     *  WARNING: This Program must be      *
  14.      '     *           COMPILED with IBM         *
  15.      '     *           BASCOM/T/O/N              *
  16.      '     *           Donot use BASICA          *
  17.      '     *                                     *
  18.      '     *  Highly recommend 8087 Link Libs    *
  19.      '     *                                     *
  20.      '     * * * * * * * * * * * * * * * * * * * *
  21.      '
  22.      '
  23.      DIM B#(37), C#(99), CONS!(7), CONS#(6)
  24.      DIM ZI$(4), ZO$(4)   ' Dummy dimensions for field stmst ND error
  25.      DIM BCNT%(37), CCNT%(99), CHNO%(256)
  26.      DIM BIT%(1024), CH%(1024), PW2%(8)
  27.      CONS!(1)=8: CONS!(2)=131072! : CONS!(3)=8192: CONS!(4)=128
  28.      CONS!(5)=2: CONS!(6)=32 : CONS!(7)=2048
  29.      CONS#(1)=1: CONS#(2)=128 : CONS#(3)=32768#: CONS#(4)=8388608#
  30.      CONS#(5)=4096 : CONS#(6)=1048576# : ACNT!=0
  31.      M%=7: N%=17: YY# = 999991! : MU# = 16807 : MD# = 2147483647#
  32.      SAME1! = 0 : SAME2! = 0 : TOT! = 0
  33.      YES% = ASC("Y") : NO% = ASC("N")
  34.      WZ$="P C   C o m p u t e r   S e c u r i t y    V1.53   PC-CODE1"
  35.      FOR J%=1 TO 37 : BCNT%(J%)=0 : NEXT J%
  36.      FOR J%=1 TO 99 : CCNT%(J%)=0 : NEXT J%
  37.      FOR J%=1 TO 256: CHNO%(J%)=0 : NEXT J%
  38.      PRINT WZ$ : PRINT : PRINT
  39.      PRINT "Does your Terminal Support IBM Clear (CLS) Screen";
  40.      GOSUB 8300 : IBM% = REPLY%
  41.      PRINT: PRINT
  42.      PRINT "Do you have COLOR installed on your PC";
  43.      GOSUB 8300 : CL% = REPLY%
  44.      IF CL% = 0% THEN 1530
  45.      SCREEN 0,1
  46.      COLOR 15,9,1
  47.      GOSUB 8190
  48. 1530 PRINT: PRINT
  49.      YES% = ASC("B") : NO% = ASC("C")
  50.      PRINT "Do you want Character (C) or Bit (B) Scrambling";
  51.      GOSUB 8300 : XL% = REPLY%
  52.      IF XL% = 0% THEN 1600
  53.      PW2%(1) = 1%
  54.      PW2%(2) = 2%
  55.      PW2%(3) = 4%
  56.      PW2%(4) = 8%
  57.      PW2%(5) = 16%
  58.      PW2%(6) = 32%
  59.      PW2%(7) = 64%
  60.      PW2%(8) = 128%
  61.      JK% = 1%
  62.      FOR J% = 1% TO 128%
  63.      FOR K% = 1% TO 8%
  64.      BIT%(JK%) = PW2%(K%)
  65.      CH%(JK%) = J%
  66.      JK% = JK% + 1%
  67.      NEXT K%
  68.      NEXT J%
  69.      GOTO 1650
  70. 1600 FOR J%=1% TO 128%
  71.      CH%(J%) = 129% - J%
  72.      NEXT J%
  73. 1650 YES% = ASC("Y") : NO% = ASC("N")
  74.      PRINT : PRINT
  75.      PRINT "Do You wish some Instructions/Help";
  76.      GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 6600
  77.      PRINT : PRINT
  78.      YES% = ASC("Y") : NO% = ASC("N")
  79.      PRINT "Do You Wish to Load KEYS from a FILE";
  80.      GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 6800 : GOTO 2740
  81.      GOSUB 8190
  82.      FOR J% = 10 TO 15
  83.      IF CL% = 1% THEN COLOR J%,9,1
  84.      PRINT "P C - C O D E 1 ......SuperEncipherment......"
  85.      NEXT J%
  86.      IF CL% = 1% THEN COLOR 15,9,1
  87.      PRINT: PRINT : PRINT : PRINT : PRINT : PRINT
  88.      YES% = ASC("N") : NO% = ASC("A")
  89.      PRINT " Enter the type of KEY desired"
  90.      PRINT "    Numeric; Number Only key ";
  91.      IF CL% = 1% THEN COLOR 13,0,0: PRINT "N": COLOR 15,9,1
  92.      IF CL% = 0% THEN PRINT "N"
  93.      PRINT "    Alphabetic; alphanumeric ";
  94.      IF CL% = 1% THEN COLOR 13,0,0: PRINT "A" : COLOR 15,9,1
  95.      IF CL% = 0% THEN PRINT "A"
  96.      GOSUB 8300 : TY% = REPLY% : IF REPLY% = 0% THEN 3960
  97.      '
  98.      '
  99.      '
  100.      GOSUB 8190
  101.      YES% = ASC("H"): NO% = ASC("L")
  102.      PRINT " There are two(2) levels of Security HIGH and LOW"
  103.      PRINT " Enter H for HIGH or L for LOW";
  104.      GOSUB 8300 : IF REPLY% = 1% THEN 2170
  105.      '
  106.      '   ----------- LOW level of SECURITY -------------
  107.      '
  108.      PRINT " LOW Level of Security Selected"
  109.      PRINT
  110.      PRINT " You must now enter SEVEN (7) KEY numbers as indicated:"
  111.      PRINT
  112.      GOSUB 4170
  113.      GOTO 2740
  114.      '
  115.      '
  116.      '
  117. 2170 PRINT
  118.      PRINT " You have Selected HIGH security"
  119.      PRINT
  120.      PRINT " You must enter ";1+N%+M%;" key numbers between 1 and 2,147,483,646"
  121. 2210 INPUT " A( 1 ) ? "; A#
  122.      A# = FIX(A#)
  123.      IF A# < 1 OR A# >= MD# THEN GOSUB 2590: GOTO 2210
  124.      PRINT
  125.      '
  126.      '
  127.      FOR J%=1 TO M%
  128. 2280 PRINT " B(";J%;") ";
  129.      INPUT B#(J%)
  130.      B#(J%) = FIX(B#(J%))
  131.      IF B#(J%) < 1 OR B#(J%) >= MD# THEN GOSUB 2590: GOTO 2280
  132.      NEXT J%
  133.      GOSUB 8190
  134.      '
  135.      '
  136.      FOR J%=1 TO N%
  137. 2370 PRINT " C(";J%;") ";
  138.      INPUT C#(J%)
  139.      C#(J%) = FIX(C#(J%))
  140.      IF C#(J%) < 1 OR C#(J%) >= MD# THEN GOSUB 2590: GOTO 2370
  141.      IF J% = 18 THEN GOSUB 8190
  142.      IF J% = 36 THEN GOSUB 8190
  143.      NEXT J%
  144.      '
  145.      GOTO 2740
  146.      '
  147.      '
  148.      '
  149. 2490 PRINT "[";X%;"] ";
  150.      INPUT "Enter a NUMBER between 1 and 9,999,999 "; K2!
  151.      IF K2! < 1 OR K2! > 9999999! THEN GOSUB 2590: GOTO 2490
  152.      Z! = K2!
  153.      GOSUB 2680
  154.      S! = Z!
  155.      RETURN
  156.      '
  157.      '
  158.      '   ---------- ERROR Messages ----------
  159. 2590 IF CL% = 1% THEN COLOR 4+16,0,0
  160.      PRINT " ERROR: Number RANGE must be 1 to 9,999,999"
  161.      IF CL% = 1% THEN COLOR 15,1,9
  162.      RETURN
  163.      '
  164.      '
  165.      '   ------ scaling ---------
  166. 2680 Z! = Z! / 100!
  167.      IF Z! > 1! THEN 2680
  168.      RETURN
  169.      '
  170.      '
  171.      '
  172. 2740 GOSUB 8190
  173.      PRINT : PRINT
  174.      PRINT " Input and Output File may be the same file"
  175.      PRINT " Only Valid files; no use of 'CON:' or 'LPT1:'"
  176.      PRINT : PRINT
  177.      INPUT "Enter Output file name (Full name): "; U$
  178.      OPEN "R",2,U$,512
  179.      INPUT "Enter Input FILE (full name): "; F1$
  180.      OPEN "I",1,F1$
  181.      CLOSE 1
  182.      OPEN "R",1,F1$,512
  183.      FIELD #1,128 AS ZI$(1),128 AS ZI$(2),128 AS ZI$(3),128 AS ZI$(4)
  184.      FIELD #2,128 AS ZO$(1),128 AS ZO$(2),128 AS ZO$(3),128 AS ZO$(4)
  185.      L! = LOF(1) : SIZE% = L! / 128
  186.      IF (SIZE% * 128!) <> L! THEN SIZE% = SIZE% + 1
  187.      SIZ2% = L! / 512
  188.      IF (SIZ2% * 512) <> L! THEN SIZ2% = SIZ2% + 1
  189.      PRINT
  190.      YES% = ASC("E") : NO% = ASC("D")
  191.      PRINT "Encode or Decode";
  192.      GOSUB 8300 : EN% = REPLY%
  193.      GOSUB 8190
  194.      ZER$ = STRING$(128,0)
  195.      IF CL% = 1% THEN COLOR 4+16,0,0
  196.      IF CL% = 0% THEN COLOR 7+16,0
  197.      PRINT " * * * R U N N I N G * * *"
  198.      IF CL% = 1% THEN COLOR 15,9,1
  199.      IF CL% = 0% THEN COLOR 7,0
  200.      PRINT
  201.      LAST%=0
  202.      IF XL% = 1% THEN GOSUB 9100
  203.      FOR Z9% = 1% TO SIZ2%
  204.      GET #1, Z9%
  205.      IF XL% = 0% THEN GOSUB 9100
  206.      IF XL% = 1% AND (Z9% MOD 9%) = 0% THEN GOSUB 9100
  207.      FOR JK% = 1% TO 4%
  208.      IF LAST% >= SIZE% THEN LSET ZO$(JK%) = ZER$ : GOTO 3450
  209.      M$=ZI$(JK%)
  210.      IF Z9% = SIZ2% AND EN% = 0% AND M$ = ZER$ THEN 3430
  211.      IF EN% = 0% THEN GOSUB 9200
  212.      FOR J% = 1% TO 128%
  213.      H%=ASC( MID$(M$,J%,1%) )
  214.      S#=A#
  215.      L=M%
  216.      GOSUB 3530
  217.      A#=S#
  218.      B%=O%
  219.      L=N%
  220.      S#=B#(B%)
  221.      BCNT%(B%) = BCNT%(B%) + 1%
  222.      GOSUB 3530
  223.      B#(B%)=S#
  224.      B%=O%
  225.      S#=C#(B%)
  226.      CCNT%(B%) = CCNT%(B%) + 1%
  227.      L=256
  228.      GOSUB 3530
  229.      C#(B%)=S#
  230.      H% = H% XOR O%
  231.      H% = H% AND 255%
  232.      CHNO%(H%) = CHNO%(H%) + 1%
  233.      MID$(M$,J%,1) = CHR$(H%)
  234.      NEXT J%
  235.      IF EN% = 1% THEN GOSUB 9200
  236. 3430 LSET ZO$(JK%) = M$
  237.      LAST% = LAST% + 1%
  238. 3450 NEXT JK%
  239.      PUT #2, Z9%
  240.      NEXT Z9%
  241.      '
  242.      GOTO 3680
  243.      '
  244.      '
  245.      '   -------- RANDOM NUMBER GENERATOR (1) ------
  246. 3530 S# = S# * MU#
  247.      S# = S# - ( MD# * INT( S# / MD# )  )
  248.      O%=1 + INT(L * (S# / MD#) )
  249.      RETURN
  250.      '
  251.      '
  252.      '   -------- RANDOM NUMBER GENERATOR (2) ------
  253. 3600 S!=(S! + 1.352968) ^ 1.256973
  254.      S!=S! - FIX(S!)
  255.      O%=1 + INT(L * S!)
  256.      RETURN
  257.      '
  258.      '
  259.      '
  260.      ' ------- CLEAR STORAGE & PREPARE TO STOP ---------
  261. 3680 LSET ZO$(4)=ZER$ : LSET ZI$(4)=ZER$
  262.      LSET ZO$(1)=ZER$ : LSET ZI$(1)=ZER$
  263.      LSET ZO$(2)=ZER$ : LSET ZI$(2)=ZER$
  264.      LSET ZO$(3)=ZER$ : LSET ZI$(3)=ZER$
  265.      CLOSE 2
  266.      CLOSE 1
  267.      YES% = ASC("Y") : NO% = ASC("N")
  268.      PRINT "Wish to Save newly Computed Keys to a File";
  269.      GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 7030
  270.      PRINT "Wish to Save Log Statistics for Keys used";
  271.      GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 7630
  272.      Z!=0: A#=0# : M2$=ZER$ : M$=M2$ : S! = 0: S# = 0
  273.      FOR J%=1 TO M%
  274.      B#(J%)=0# : BCNT%(J%)=0%
  275.      NEXT J%
  276.      FOR J%=1 TO N%
  277.      C#(J%)=0# : CCNT%(J%)=0%
  278.      NEXT J%
  279.      FOR J%=1 TO 1024%
  280.      BIT%(J%) = 0% : CH%(J%) = 0%
  281.      NEXT J%
  282.      IF CL% = 1% THEN COLOR 7,0,0
  283.      IF IBM% = 1% THEN CLS
  284.      END              '   S T O P
  285.      '
  286.      '   ----------- ALPHANUMERIC KEYS -----------
  287.      '
  288. 3960 GOSUB 8190
  289.      YES% = ASC("H") : NO% = ASC("L")
  290.      PRINT
  291.      PRINT " There are two(2) levels of Security HIGH and LOW"
  292.      PRINT " Enter H for HIGH or L for LOW ";
  293.      GOSUB 8300 : IF REPLY% = 1% THEN 5270
  294.      '
  295.      '   ----------- LOW level of SECURITY -------------
  296.      '
  297.      PRINT " LOW Level of Security Selected"
  298.      PRINT
  299.      PRINT " You must now enter SEVEN (7) key Alphanumerics as indicated:"
  300.      PRINT
  301.      GOSUB 4170
  302.      GOTO 2740
  303.      '
  304.      '
  305.      '   ---------- KEY 1 ---------
  306. 4170 X%=1% : M% = 11% : N% = 47%
  307.      IF TY% = 0% THEN GOSUB 5410  ' Alpha
  308.      IF TY% = 1% THEN GOSUB 2490  ' Numeric
  309.      GOSUB 3600
  310.      GOSUB 3600
  311.      A#=FIX((1# - S!) * MD#)
  312.      '
  313.      '
  314.      '   ---------- KEY 2 ----------
  315.      X%=2%
  316.      IF TY% = 0% THEN GOSUB 5410  ' Alpha
  317.      IF TY% = 1% THEN GOSUB 2490  ' Numeric
  318.      GOSUB 3600
  319.      L=4
  320.      FOR J%=1 TO M%
  321.      GOSUB 3600
  322.      O2% = O%
  323.      FOR K%=1 TO O2%
  324.      GOSUB 3600
  325.      NEXT K%
  326.      GOSUB 3600
  327.      B#(J%)=FIX((1# - S!) * MD#)
  328.      NEXT J%
  329.      '
  330.      '
  331.      '   ---------- KEY 3 -----------
  332.      X%=3%
  333.      IF TY% = 0% THEN GOSUB 5410  ' Alpha
  334.      IF TY% = 1% THEN GOSUB 2490  ' Numeric
  335.      GOSUB 3600
  336.      L=3
  337.      FOR J%=1 TO N%
  338.      GOSUB 3600
  339.      O2% = O%
  340.      FOR K%=1 TO O2%
  341.      GOSUB 3600
  342.      NEXT K%
  343.      GOSUB 3600
  344.      C#(J%)=FIX((1# - S!) * MD#)
  345.      NEXT J%
  346.      '
  347.      '
  348.      '   ---------- KEY 4 -------------
  349.      X%=4%
  350.      IF TY% = 0% THEN GOSUB 5410   ' Alpha
  351.      IF TY% = 1% THEN GOSUB 2490   ' Numeric
  352.      GOSUB 3600
  353.      L=INT(N%/2)
  354.      GOSUB 3600
  355.      K%=O% + 1
  356.      L=N%
  357.      FOR J%=1 TO K%
  358.      GOSUB 3600
  359.      L%=O%
  360.      GOSUB 3600
  361.      C#(L%)=FIX(S! * MD#)
  362.      NEXT J%
  363.      '
  364.      '
  365.      '   ----------- KEY 5 ---------------
  366.      X%=5%
  367.      IF TY% = 0% THEN GOSUB 5410    ' Alpha
  368.      IF TY% = 1% THEN GOSUB 2490    ' Numeric
  369.      GOSUB 3600
  370.      L=INT(M%/2)
  371.      GOSUB 3600
  372.      K%=O% + 1
  373.      L=M%
  374.      FOR J%=1 TO K%
  375.      GOSUB 3600
  376.      L%=O%
  377.      GOSUB 3600
  378.      B#(L%)=FIX(S! * MD#)
  379.      NEXT J%
  380.      '
  381.      '
  382.      '   ------------ KEY 6 ---------------
  383.      X%=6%
  384.      IF TY% = 0% THEN GOSUB 5410   ' Alpha
  385.      IF TY% = 1% THEN GOSUB 2490   ' Numeric
  386.      GOSUB 3600
  387.      L=M%
  388.      FOR J%=1 TO M%
  389.      GOSUB 3600
  390.      D#=B#(O%)
  391.      B#(O%)=B#(J%)
  392.      B#(J%)=D#
  393.      NEXT J%
  394.      '
  395.      '
  396.      '   ------------- KEY 7 --------------
  397.      X%=7%
  398.      IF TY% = 0% THEN GOSUB 5410    ' Alpha
  399.      IF TY% = 1% THEN GOSUB 2490    ' Numeric
  400.      GOSUB 3600
  401.      L=N%
  402.      FOR J%=1 TO N%
  403.      GOSUB 3600
  404.      D#=C#(O%)
  405.      C#(O%)=C#(J%)
  406.      C#(J%)=D#
  407.      NEXT J%
  408.      '
  409.      GOSUB 7400  ' Display generated Keys
  410.      '
  411.      RETURN
  412.      '
  413.      '   ---------- end of LOW security ------------
  414.      '
  415.      '
  416. 5270 GOSUB 8190
  417.      PRINT " You must enter 3 long PASSWORDS of alphanumeric data"
  418.      X%=1%
  419.      GOSUB 5600
  420.      X%=M%
  421.      GOSUB 5600
  422.      X%=N%
  423.      GOSUB 5600
  424.      GOSUB 7400  ' Display generated keys
  425.      '
  426.      GOTO 2740
  427.      '
  428.      '
  429.      '   --------- alphanumeric password to RND ------------
  430. 5410 PRINT "[";X%;"] Enter Password: ";
  431.      LINE INPUT P$
  432.      L%=LEN(P$)
  433.      IF L% < 6% THEN PRINT "*** Password Too SHORT; not > 5": GOTO 5410
  434.      IF X%=1% THEN K#=0#
  435.      FOR J%=1% TO L%
  436.      C%=ASC( MID$(P$,J%,1) )
  437.      LL%=J%
  438.      IF LL% > 7% THEN LL% = LL% MOD 7% : LL% = LL% + 1%
  439.      K# = K# + (CONS!(LL%) * C%)
  440.      NEXT J%
  441.      Z! = K#
  442.      GOSUB 2680
  443.      K# = K# - ( YY# * INT( K# / YY#))
  444.      S! = Z!
  445.      RETURN
  446.      '
  447.      '
  448.      '   ------- alphanumeric to DECIMAL --------
  449. 5600 X2%=X% * 6%
  450.      X3%=X2% : X4%=0%
  451.      IF X%=1 THEN PRINT " (A) Enter Password of at least (MIN) ";X2%;" Chars"
  452.      IF X%=M% THEN PRINT " (B) Enter Password of at least (MIN) ";X2%;" Chars"
  453.      IF X2% > 60 THEN X3%=60: X4%=X2% - 60: GOSUB 8190
  454.      IF X%=N% THEN PRINT " (C) Enter Password of at least (MIN) ";X2%;" Chars"
  455.      W1$="123456789012345678901234567890123456789012345678901234567890"
  456.      W2$="         1         2         3         4         5         6"
  457.      W3$=".........+.........+.........+.........+.........+.........+"
  458.      W4$="         7         8         9        10        11        12"
  459.      PRINT
  460.      PRINT "         "; LEFT$(W2$,X3%)
  461.      PRINT "         "; LEFT$(W1$,X3%)
  462.      PRINT "         "; LEFT$(W3$,X3%)
  463.      PRINT "Password:";
  464.      LINE INPUT P$
  465.      PRINT
  466.      IF X4% = 0% THEN 5810
  467.      PRINT
  468.      PRINT "         "; LEFT$(W4$,X4%)
  469.      PRINT "         "; LEFT$(W1$,X4%)
  470.      PRINT "         "; LEFT$(W3$,X4%)
  471.      PRINT "Password:";
  472.      LINE INPUT P2$
  473.      P$ = P$ + P2$
  474. 5810 L%=LEN(P$)
  475.      IF L% < X2% THEN PRINT "   *** Password TOO SHORT reenter ": GOTO 5600
  476.      T%=INT(L%/X%)
  477.      K#=0
  478.      FOR K%=1 TO X%
  479.      P2$=LEFT$(P$,T%)
  480.      L%=L%-T%
  481.      IF L% < 1 THEN 5900
  482.      P$=RIGHT$(P$,L%)
  483. 5900 FOR J%=1% TO T%
  484.      LL%=J%
  485.      IF LL% > 6% THEN LL% = LL% MOD 6% : LL% = LL% + 1%
  486.      C% = ASC( MID$(P2$,J%,1) )
  487.      K# = K# + (CONS#(LL%) * C%)
  488.      NEXT J%
  489.      IF X%=1 THEN A#=K#
  490.      IF X%=M% THEN B#(K%) = K#
  491.      IF X%=N% THEN C#(K%) = K#
  492.      K# = K# - (MD# * INT( K# / MD# ))
  493.      NEXT K%
  494.      RETURN
  495.      '
  496.      '
  497.      '   ------ bit TRANSPOSITION -------
  498.      '
  499. 6060 FOR JJ% = 1% TO 1024%
  500.      L=M%
  501.      S#=A#
  502.      GOSUB 3530
  503.      A#=S#
  504.      B%=O%
  505.      L=N%
  506.      S#=B#(B%)
  507.      GOSUB 3530
  508.      B#(B%)=S#
  509.      B%=O%
  510.      S#=C#(B%)
  511.      L=1024
  512.      GOSUB 3530
  513.      C#(B%)=S#
  514.      IS% = BIT%(JJ%)
  515.      BIT%(JJ%) = BIT%(O%)
  516.      BIT%(O%) = IS%
  517.      IS% = CH%(JJ%)
  518.      CH%(JJ%) = CH%(O%)
  519.      CH%(O%) = IS%
  520.      NEXT JJ%
  521.      RETURN
  522.      '
  523.      '
  524.      '
  525. 6340 FOR JJ% = 1% TO 512%
  526.      X1% = CH%(JJ%)
  527.      B1% = BIT%(JJ%)
  528.      IS% = JJ% + 512%
  529.      X2% = CH%(IS%)
  530.      B2% = BIT%(IS%)
  531.      C1% = ASC( MID$(M$,X1%,1) )
  532.      IF X1% = X2% THEN GOSUB 6500 : GOTO 6390
  533.      C2% = ASC( MID$(M$,X2%,1) )
  534.      S1% = B1% AND C1%
  535.      S2% = B2% AND C2%
  536.      IF S1% = 0% AND S2% = 0% THEN 6400
  537.      IF S1% > 0% AND S2% > 0% THEN 6400
  538.      C1% = C1% XOR B1%
  539.      C2% = C2% XOR B2%
  540.      MID$(M$,X2%,1) = CHR$(C2%)
  541. 6390 MID$(M$,X1%,1) = CHR$(C1%)
  542. 6400 NEXT JJ%
  543.      RETURN
  544.      '
  545.      '
  546.      '
  547.      ' ----- SAME CHARACTER different bits ----
  548. 6500 S1% = B1% AND C1%
  549.      S2% = B2% AND C1%
  550.      IF S1% = 0% AND S2% = 0% THEN 6550
  551.      IF S1% > 0% AND S2% > 0% THEN 6550
  552.      C1% = C1% XOR B1%
  553.      C1% = C1% XOR B2%
  554. 6550 RETURN
  555.      '
  556.      '
  557.      '
  558.      '
  559.      ' ------ Help / Instructions -----
  560. 6600 OPEN "I",#3,"PC-CODE1.DOC"
  561. 6620 GOSUB 8190
  562.      JJ%=1
  563. 6650 IF EOF(3) <> 0 THEN 6740
  564.      LINE INPUT #3, M$
  565.      PRINT M$
  566.      JJ%=JJ%+1
  567.      IF JJ% < 18 THEN 6650
  568.      PRINT "=======================": PRINT
  569.      PRINT "Wish More Documentation <CR>=Yes  ";
  570.      NO% = ASC("N") : YES% = 32%
  571.      GOSUB 8300 : IF REPLY% = 1% THEN 6620 ELSE 6750
  572. 6740 GOSUB 7220  '  Pause
  573. 6750 GOSUB 8190
  574.      CLOSE 3
  575.      RETURN
  576.      '
  577.      '
  578.      '
  579. 6800 INPUT "Enter the fully qualified Input Key File Name: "; F$
  580.      OPEN "I", 5, F$
  581.      LINE INPUT #5, P$
  582.      IF LEFT$(P$,1) <> "*" THEN A#=VAL(P$) : GOTO 6870
  583.      INPUT #5, T%, M%, N%
  584. 6850 IF T% <> 1 THEN PRINT "*** ERROR *** Bad Key File": END
  585.      INPUT #5, A#
  586. 6870 A# = ABS( FIX( A# ) )
  587.      IF A# = 0# THEN T% = 99 : GOTO 6850
  588.      T% = M% + N% + 1
  589.      FOR J%=1 TO M% : INPUT #5, B#(J%)
  590.      B#(J%) = ABS( FIX( B#(J%) ) ) : NEXT J%
  591.      FOR J%=1 TO N% : INPUT #5, C#(J%)
  592.      C#(J%) = ABS( FIX( C#(J%) ) ) : NEXT J%
  593.      IF EOF(5) <> 0 THEN PRINT "*** ERROR *** Reading key file": END
  594.      PRINT "*** Loaded "; T% ;" Keys from "; F$; " Successfully"
  595.      GOSUB 7220     ' Pause
  596.      CLOSE 5
  597.      RETURN
  598.      '
  599.      '
  600.      '
  601. 7030 INPUT "Enter the fully qualified Output Key File Name: "; F$
  602.      OPEN "O", 5, F$
  603.      PRINT #5, "* HDR PC-CODE1 saved KEYS "
  604.      WRITE #5, 1, M%, N%
  605.      PRINT #5, A#
  606.      FOR J%=1 TO M% : PRINT #5, B#(J%)
  607.      NEXT J%
  608.      FOR J%=1 TO N% : PRINT #5, C#(J%)
  609.      NEXT J%
  610.      PRINT #5, "* Keys Computed on " + DATE$ + " " + TIME$
  611.      T% = M% + N% + 1
  612.      PRINT "*** Saved "; T% ;" Keys to "; F$; " Successfully"
  613.      GOSUB 7220     ' Pause
  614.      CLOSE 5
  615.      RETURN
  616.      '
  617.      '
  618.      '
  619.      ' -------- Delay Function -------
  620. 7220 PRINT : PRINT
  621.      PRINT " <PAUSE> Press Enter to Continue ";
  622.      LINE INPUT Z$
  623.      RETURN
  624.      '
  625.      '
  626.      '
  627.      ' ----- Generated Key Seeds display ------
  628. 7400 GOSUB 8190
  629.      PRINT "The following Numeric Keys/Seeds were generated:"
  630.      PRINT : PRINT
  631.      P$=SPACE$(16)
  632.      PRINT "     ( A ) :    "; A#
  633.      PRINT
  634.      PRINT "     ( B ) :    ";
  635.      FOR J%=1 TO M%
  636.      PRINT LEFT$(STR$(B#(J%))+P$,16);
  637.      NEXT J%
  638.      PRINT : PRINT
  639.      PRINT "     ( C ) :    ";
  640.      FOR J%=1 TO N%
  641.      PRINT LEFT$(STR$(C#(J%))+P$,16);
  642.      NEXT J%
  643.      PRINT: PRINT
  644.      PRINT " --- To Print this screen depress 'Shift PrtSc' ---"
  645.      GOSUB 7220    ' Pause
  646.      RETURN
  647.      '
  648.      '
  649.      '
  650.      ' ---- Save Log Statistics for Keys used -----
  651. 7630 PRINT "Enter Stat Log File Name or 'LPT1:' or default of blank"
  652.      F$ = " "
  653.      INPUT "Enter Log File Name: "; F$
  654.      IF LEN(F$)=0 OR LEFT$(F$,1)=" " THEN F$="PC-STAT1.LOG"
  655.      OPEN "O", 6, F$
  656.      FOR J%=1 TO M% : ACNT! = ACNT! + BCNT%(J%) : NEXT J%
  657.      PRINT #6, " "
  658.      PRINT #6, " <<<<< PC-CODE1 Statistics for Keys Used >>>>>"
  659.      PRINT #6, " " : PRINT #6, " "
  660.      PRINT #6, " Date and Time Stamp        = "; DATE$ + " " + TIME$
  661.      PRINT #6, " Keys Setup (B) size        = "; M%
  662.      PRINT #6, " Keys Setup (C) size        = "; N%
  663.      PRINT #6, " Total Characters processed = "; ACNT!
  664.      PRINT #6, " "
  665.      PRINT #6, " ----- Key Utilitization/Balance -----"
  666.      PRINT #6, " " : PRINT #6, " "
  667.      PRINT #6, " * For Key Group (B)"
  668.      PRINT #6, " "
  669.      PRINT #6, "    KEY      Count"
  670.      FOR J%=1 TO M%
  671.      PRINT #6, USING "    ###    ####### "; J%, BCNT%(J%)
  672.      NEXT J%
  673.      PRINT #6, " " : PRINT #6, " "
  674.      PRINT #6, " * For Key Group (C)"
  675.      PRINT #6, " "
  676.      PRINT #6, "    KEY      Count"
  677.      FOR J%=1 TO N%
  678.      PRINT #6, USING "    ###    ####### "; J%, CCNT%(J%)
  679.      NEXT J%
  680.      PRINT #6, " " : PRINT #6, " "
  681.      PRINT #6, " * Output Character Set Statistics:"
  682.      PRINT #6, " "
  683.      PRINT #6, "    CHR$    Char     Count"
  684.      PRINT #6, "    Num     ----     Occur"
  685.      FOR J%=0 TO 255
  686.      IF CHNO%(J%)=0 THEN 7980
  687.      IF J% > 31 AND J% < 127 THEN P$=CHR$(J%) ELSE P$=" "
  688.      PRINT #6, USING "    ####      !    ####### "; J%, P$, CHNO%(J%)
  689. 7980 NEXT J%
  690.      PRINT #6, " "
  691.      PRINT #6, " *** END of STATISTICAL LOG ***"
  692.      PRINT " *** Saved Log file to ";F$;" ***"
  693.      CLOSE 6
  694.      RETURN
  695.      '
  696.      '
  697.      '  C L E A R       S C R E E N
  698. 8190 IF IBM% = 0% THEN 8195
  699.      CLS
  700.      GOTO 8200
  701. 8195 PRINT
  702.      PRINT "..........................................................."
  703.      PRINT
  704. 8200 PRINT WZ$ : PRINT : PRINT
  705.      RETURN
  706.      '
  707.      '
  708.      '
  709.      '    Y E S  /   N O     Prompt Subroutine
  710. 8300 IF YES% <> 32% THEN PRINT " (";CHR$(YES%);" or ";CHR$(NO%);") ";
  711.      IF YES% = 32% THEN PRINT " ( ";CHR$(NO%);" or <CR> ) ";
  712.      Z$=" "
  713.      INPUT Z$
  714.      IF Z$ = "" AND YES% = 32 THEN REPLY% = 1% : GOTO 8400
  715.      IF Z$ = "" THEN 8300
  716.      REPLY% = 99%
  717.      ANS% = ASC(Z$)
  718.      IF ANS% > 90% THEN ANS% = ANS% - 32%
  719.      IF ANS% = YES% THEN REPLY% = 1%
  720.      IF ANS% = NO%  THEN REPLY% = 0%
  721.      IF REPLY% <> 99% THEN 8400
  722.      PRINT "    ERROR: Re-enter as follows: ";
  723.      GOTO 8300
  724. 8400 RETURN
  725.      '
  726.      '
  727.      '   ------ character TRANSPOSITION -------
  728.      '
  729. 8600 FOR JJ% = 1% TO 128%
  730.      L=M%
  731.      S#=A#
  732.      GOSUB 3530
  733.      A#=S#
  734.      B%=O%
  735.      L=N%
  736.      S#=B#(B%)
  737.      GOSUB 3530
  738.      B#(B%)=S#
  739.      B%=O%
  740.      S#=C#(B%)
  741.      L=128
  742.      GOSUB 3530
  743.      C#(B%)=S#
  744.      IS% = CH%(JJ%)
  745.      CH%(JJ%) = CH%(O%)
  746.      CH%(O%) = IS%
  747.      NEXT JJ%
  748.      RETURN
  749.      '
  750.      '
  751.      '
  752. 8800 FOR JJ% = 1% TO 64%
  753.      G1%=CH%(JJ%)
  754.      G2%=CH%(JJ% + 64%)
  755.      G1$=MID$(M$,G1%,1)
  756.      G2$=MID$(M$,G2%,1)
  757.      MID$(M$,G1%,1)=G2$
  758.      MID$(M$,G2%,1)=G1$
  759.      NEXT JJ%
  760.      RETURN
  761.      '
  762.      '
  763.      '
  764. 9100 IF XL% = 1% THEN GOSUB 6060 ELSE GOSUB 8600
  765.      RETURN
  766.      '
  767.      '
  768.      '
  769. 9200 IF XL% = 1% THEN GOSUB 6340 ELSE GOSUB 8800
  770.      RETURN
  771.      '
  772.      '
  773.      '
  774.      ' END
  775.