home *** CD-ROM | disk | FTP | other *** search
- '
- '
- ' <<<<< P C - C O D E 3 . 1 5 3 >>>>>
- '
- '
- ' * * * * * * * * * * * * * * * * * * * *
- ' * *
- ' * COPYRIGHT 1984 by *
- ' * Richard Nolen COLVARD *
- ' * Freeware distribution OK *
- ' * Public Domain use OK *
- ' * *
- ' * WARNING: This Program must be *
- ' * COMPILED with IBM *
- ' * BASCOM/T/O/N *
- ' * Donot use BASICA *
- ' * *
- ' * Highly recommend 8087 Link Libs *
- ' * *
- ' * * * * * * * * * * * * * * * * * * * *
- '
- '
- DIM B#(37), C#(99), CONS!(7), CONS#(6)
- DIM ZI$(4), ZO$(4) ' Dummy dimensions for field stmst ND error
- DIM BCNT%(37), CCNT%(99), CHNO%(256)
- DIM BIT%(1024), CH%(1024), PW2%(8)
- CONS!(1)=8: CONS!(2)=131072! : CONS!(3)=8192: CONS!(4)=128
- CONS!(5)=2: CONS!(6)=32 : CONS!(7)=2048
- CONS#(1)=1: CONS#(2)=128 : CONS#(3)=32768#: CONS#(4)=8388608#
- CONS#(5)=4096 : CONS#(6)=1048576# : ACNT!=0
- M%=7: N%=17: YY# = 999991! : MU# = 16807 : MD# = 2147483647#
- SAME1! = 0 : SAME2! = 0 : TOT! = 0
- YES% = ASC("Y") : NO% = ASC("N")
- WZ$="P C C o m p u t e r S e c u r i t y V1.53 PC-CODE1"
- FOR J%=1 TO 37 : BCNT%(J%)=0 : NEXT J%
- FOR J%=1 TO 99 : CCNT%(J%)=0 : NEXT J%
- FOR J%=1 TO 256: CHNO%(J%)=0 : NEXT J%
- PRINT WZ$ : PRINT : PRINT
- PRINT "Does your Terminal Support IBM Clear (CLS) Screen";
- GOSUB 8300 : IBM% = REPLY%
- PRINT: PRINT
- PRINT "Do you have COLOR installed on your PC";
- GOSUB 8300 : CL% = REPLY%
- IF CL% = 0% THEN 1530
- SCREEN 0,1
- COLOR 15,9,1
- GOSUB 8190
- 1530 PRINT: PRINT
- YES% = ASC("B") : NO% = ASC("C")
- PRINT "Do you want Character (C) or Bit (B) Scrambling";
- GOSUB 8300 : XL% = REPLY%
- IF XL% = 0% THEN 1600
- PW2%(1) = 1%
- PW2%(2) = 2%
- PW2%(3) = 4%
- PW2%(4) = 8%
- PW2%(5) = 16%
- PW2%(6) = 32%
- PW2%(7) = 64%
- PW2%(8) = 128%
- JK% = 1%
- FOR J% = 1% TO 128%
- FOR K% = 1% TO 8%
- BIT%(JK%) = PW2%(K%)
- CH%(JK%) = J%
- JK% = JK% + 1%
- NEXT K%
- NEXT J%
- GOTO 1650
- 1600 FOR J%=1% TO 128%
- CH%(J%) = 129% - J%
- NEXT J%
- 1650 YES% = ASC("Y") : NO% = ASC("N")
- PRINT : PRINT
- PRINT "Do You wish some Instructions/Help";
- GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 6600
- PRINT : PRINT
- YES% = ASC("Y") : NO% = ASC("N")
- PRINT "Do You Wish to Load KEYS from a FILE";
- GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 6800 : GOTO 2740
- GOSUB 8190
- FOR J% = 10 TO 15
- IF CL% = 1% THEN COLOR J%,9,1
- PRINT "P C - C O D E 1 ......SuperEncipherment......"
- NEXT J%
- IF CL% = 1% THEN COLOR 15,9,1
- PRINT: PRINT : PRINT : PRINT : PRINT : PRINT
- YES% = ASC("N") : NO% = ASC("A")
- PRINT " Enter the type of KEY desired"
- PRINT " Numeric; Number Only key ";
- IF CL% = 1% THEN COLOR 13,0,0: PRINT "N": COLOR 15,9,1
- IF CL% = 0% THEN PRINT "N"
- PRINT " Alphabetic; alphanumeric ";
- IF CL% = 1% THEN COLOR 13,0,0: PRINT "A" : COLOR 15,9,1
- IF CL% = 0% THEN PRINT "A"
- GOSUB 8300 : TY% = REPLY% : IF REPLY% = 0% THEN 3960
- '
- '
- '
- GOSUB 8190
- YES% = ASC("H"): NO% = ASC("L")
- PRINT " There are two(2) levels of Security HIGH and LOW"
- PRINT " Enter H for HIGH or L for LOW";
- GOSUB 8300 : IF REPLY% = 1% THEN 2170
- '
- ' ----------- LOW level of SECURITY -------------
- '
- PRINT " LOW Level of Security Selected"
- PRINT
- PRINT " You must now enter SEVEN (7) KEY numbers as indicated:"
- PRINT
- GOSUB 4170
- GOTO 2740
- '
- '
- '
- 2170 PRINT
- PRINT " You have Selected HIGH security"
- PRINT
- PRINT " You must enter ";1+N%+M%;" key numbers between 1 and 2,147,483,646"
- 2210 INPUT " A( 1 ) ? "; A#
- A# = FIX(A#)
- IF A# < 1 OR A# >= MD# THEN GOSUB 2590: GOTO 2210
- PRINT
- '
- '
- FOR J%=1 TO M%
- 2280 PRINT " B(";J%;") ";
- INPUT B#(J%)
- B#(J%) = FIX(B#(J%))
- IF B#(J%) < 1 OR B#(J%) >= MD# THEN GOSUB 2590: GOTO 2280
- NEXT J%
- GOSUB 8190
- '
- '
- FOR J%=1 TO N%
- 2370 PRINT " C(";J%;") ";
- INPUT C#(J%)
- C#(J%) = FIX(C#(J%))
- IF C#(J%) < 1 OR C#(J%) >= MD# THEN GOSUB 2590: GOTO 2370
- IF J% = 18 THEN GOSUB 8190
- IF J% = 36 THEN GOSUB 8190
- NEXT J%
- '
- GOTO 2740
- '
- '
- '
- 2490 PRINT "[";X%;"] ";
- INPUT "Enter a NUMBER between 1 and 9,999,999 "; K2!
- IF K2! < 1 OR K2! > 9999999! THEN GOSUB 2590: GOTO 2490
- Z! = K2!
- GOSUB 2680
- S! = Z!
- RETURN
- '
- '
- ' ---------- ERROR Messages ----------
- 2590 IF CL% = 1% THEN COLOR 4+16,0,0
- PRINT " ERROR: Number RANGE must be 1 to 9,999,999"
- IF CL% = 1% THEN COLOR 15,1,9
- RETURN
- '
- '
- ' ------ scaling ---------
- 2680 Z! = Z! / 100!
- IF Z! > 1! THEN 2680
- RETURN
- '
- '
- '
- 2740 GOSUB 8190
- PRINT : PRINT
- PRINT " Input and Output File may be the same file"
- PRINT " Only Valid files; no use of 'CON:' or 'LPT1:'"
- PRINT : PRINT
- INPUT "Enter Output file name (Full name): "; U$
- OPEN "R",2,U$,512
- INPUT "Enter Input FILE (full name): "; F1$
- OPEN "I",1,F1$
- CLOSE 1
- OPEN "R",1,F1$,512
- FIELD #1,128 AS ZI$(1),128 AS ZI$(2),128 AS ZI$(3),128 AS ZI$(4)
- FIELD #2,128 AS ZO$(1),128 AS ZO$(2),128 AS ZO$(3),128 AS ZO$(4)
- L! = LOF(1) : SIZE% = L! / 128
- IF (SIZE% * 128!) <> L! THEN SIZE% = SIZE% + 1
- SIZ2% = L! / 512
- IF (SIZ2% * 512) <> L! THEN SIZ2% = SIZ2% + 1
- PRINT
- YES% = ASC("E") : NO% = ASC("D")
- PRINT "Encode or Decode";
- GOSUB 8300 : EN% = REPLY%
- GOSUB 8190
- ZER$ = STRING$(128,0)
- IF CL% = 1% THEN COLOR 4+16,0,0
- IF CL% = 0% THEN COLOR 7+16,0
- PRINT " * * * R U N N I N G * * *"
- IF CL% = 1% THEN COLOR 15,9,1
- IF CL% = 0% THEN COLOR 7,0
- PRINT
- LAST%=0
- IF XL% = 1% THEN GOSUB 9100
- FOR Z9% = 1% TO SIZ2%
- GET #1, Z9%
- IF XL% = 0% THEN GOSUB 9100
- IF XL% = 1% AND (Z9% MOD 9%) = 0% THEN GOSUB 9100
- FOR JK% = 1% TO 4%
- IF LAST% >= SIZE% THEN LSET ZO$(JK%) = ZER$ : GOTO 3450
- M$=ZI$(JK%)
- IF Z9% = SIZ2% AND EN% = 0% AND M$ = ZER$ THEN 3430
- IF EN% = 0% THEN GOSUB 9200
- FOR J% = 1% TO 128%
- H%=ASC( MID$(M$,J%,1%) )
- S#=A#
- L=M%
- GOSUB 3530
- A#=S#
- B%=O%
- L=N%
- S#=B#(B%)
- BCNT%(B%) = BCNT%(B%) + 1%
- GOSUB 3530
- B#(B%)=S#
- B%=O%
- S#=C#(B%)
- CCNT%(B%) = CCNT%(B%) + 1%
- L=256
- GOSUB 3530
- C#(B%)=S#
- H% = H% XOR O%
- H% = H% AND 255%
- CHNO%(H%) = CHNO%(H%) + 1%
- MID$(M$,J%,1) = CHR$(H%)
- NEXT J%
- IF EN% = 1% THEN GOSUB 9200
- 3430 LSET ZO$(JK%) = M$
- LAST% = LAST% + 1%
- 3450 NEXT JK%
- PUT #2, Z9%
- NEXT Z9%
- '
- GOTO 3680
- '
- '
- ' -------- RANDOM NUMBER GENERATOR (1) ------
- 3530 S# = S# * MU#
- S# = S# - ( MD# * INT( S# / MD# ) )
- O%=1 + INT(L * (S# / MD#) )
- RETURN
- '
- '
- ' -------- RANDOM NUMBER GENERATOR (2) ------
- 3600 S!=(S! + 1.352968) ^ 1.256973
- S!=S! - FIX(S!)
- O%=1 + INT(L * S!)
- RETURN
- '
- '
- '
- ' ------- CLEAR STORAGE & PREPARE TO STOP ---------
- 3680 LSET ZO$(4)=ZER$ : LSET ZI$(4)=ZER$
- LSET ZO$(1)=ZER$ : LSET ZI$(1)=ZER$
- LSET ZO$(2)=ZER$ : LSET ZI$(2)=ZER$
- LSET ZO$(3)=ZER$ : LSET ZI$(3)=ZER$
- CLOSE 2
- CLOSE 1
- YES% = ASC("Y") : NO% = ASC("N")
- PRINT "Wish to Save newly Computed Keys to a File";
- GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 7030
- PRINT "Wish to Save Log Statistics for Keys used";
- GOSUB 8300 : IF REPLY% = 1% THEN GOSUB 7630
- Z!=0: A#=0# : M2$=ZER$ : M$=M2$ : S! = 0: S# = 0
- FOR J%=1 TO M%
- B#(J%)=0# : BCNT%(J%)=0%
- NEXT J%
- FOR J%=1 TO N%
- C#(J%)=0# : CCNT%(J%)=0%
- NEXT J%
- FOR J%=1 TO 1024%
- BIT%(J%) = 0% : CH%(J%) = 0%
- NEXT J%
- IF CL% = 1% THEN COLOR 7,0,0
- IF IBM% = 1% THEN CLS
- END ' S T O P
- '
- ' ----------- ALPHANUMERIC KEYS -----------
- '
- 3960 GOSUB 8190
- YES% = ASC("H") : NO% = ASC("L")
- PRINT
- PRINT " There are two(2) levels of Security HIGH and LOW"
- PRINT " Enter H for HIGH or L for LOW ";
- GOSUB 8300 : IF REPLY% = 1% THEN 5270
- '
- ' ----------- LOW level of SECURITY -------------
- '
- PRINT " LOW Level of Security Selected"
- PRINT
- PRINT " You must now enter SEVEN (7) key Alphanumerics as indicated:"
- PRINT
- GOSUB 4170
- GOTO 2740
- '
- '
- ' ---------- KEY 1 ---------
- 4170 X%=1% : M% = 11% : N% = 47%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- GOSUB 3600
- A#=FIX((1# - S!) * MD#)
- '
- '
- ' ---------- KEY 2 ----------
- X%=2%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- L=4
- FOR J%=1 TO M%
- GOSUB 3600
- O2% = O%
- FOR K%=1 TO O2%
- GOSUB 3600
- NEXT K%
- GOSUB 3600
- B#(J%)=FIX((1# - S!) * MD#)
- NEXT J%
- '
- '
- ' ---------- KEY 3 -----------
- X%=3%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- L=3
- FOR J%=1 TO N%
- GOSUB 3600
- O2% = O%
- FOR K%=1 TO O2%
- GOSUB 3600
- NEXT K%
- GOSUB 3600
- C#(J%)=FIX((1# - S!) * MD#)
- NEXT J%
- '
- '
- ' ---------- KEY 4 -------------
- X%=4%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- L=INT(N%/2)
- GOSUB 3600
- K%=O% + 1
- L=N%
- FOR J%=1 TO K%
- GOSUB 3600
- L%=O%
- GOSUB 3600
- C#(L%)=FIX(S! * MD#)
- NEXT J%
- '
- '
- ' ----------- KEY 5 ---------------
- X%=5%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- L=INT(M%/2)
- GOSUB 3600
- K%=O% + 1
- L=M%
- FOR J%=1 TO K%
- GOSUB 3600
- L%=O%
- GOSUB 3600
- B#(L%)=FIX(S! * MD#)
- NEXT J%
- '
- '
- ' ------------ KEY 6 ---------------
- X%=6%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- L=M%
- FOR J%=1 TO M%
- GOSUB 3600
- D#=B#(O%)
- B#(O%)=B#(J%)
- B#(J%)=D#
- NEXT J%
- '
- '
- ' ------------- KEY 7 --------------
- X%=7%
- IF TY% = 0% THEN GOSUB 5410 ' Alpha
- IF TY% = 1% THEN GOSUB 2490 ' Numeric
- GOSUB 3600
- L=N%
- FOR J%=1 TO N%
- GOSUB 3600
- D#=C#(O%)
- C#(O%)=C#(J%)
- C#(J%)=D#
- NEXT J%
- '
- GOSUB 7400 ' Display generated Keys
- '
- RETURN
- '
- ' ---------- end of LOW security ------------
- '
- '
- 5270 GOSUB 8190
- PRINT " You must enter 3 long PASSWORDS of alphanumeric data"
- X%=1%
- GOSUB 5600
- X%=M%
- GOSUB 5600
- X%=N%
- GOSUB 5600
- GOSUB 7400 ' Display generated keys
- '
- GOTO 2740
- '
- '
- ' --------- alphanumeric password to RND ------------
- 5410 PRINT "[";X%;"] Enter Password: ";
- LINE INPUT P$
- L%=LEN(P$)
- IF L% < 6% THEN PRINT "*** Password Too SHORT; not > 5": GOTO 5410
- IF X%=1% THEN K#=0#
- FOR J%=1% TO L%
- C%=ASC( MID$(P$,J%,1) )
- LL%=J%
- IF LL% > 7% THEN LL% = LL% MOD 7% : LL% = LL% + 1%
- K# = K# + (CONS!(LL%) * C%)
- NEXT J%
- Z! = K#
- GOSUB 2680
- K# = K# - ( YY# * INT( K# / YY#))
- S! = Z!
- RETURN
- '
- '
- ' ------- alphanumeric to DECIMAL --------
- 5600 X2%=X% * 6%
- X3%=X2% : X4%=0%
- IF X%=1 THEN PRINT " (A) Enter Password of at least (MIN) ";X2%;" Chars"
- IF X%=M% THEN PRINT " (B) Enter Password of at least (MIN) ";X2%;" Chars"
- IF X2% > 60 THEN X3%=60: X4%=X2% - 60: GOSUB 8190
- IF X%=N% THEN PRINT " (C) Enter Password of at least (MIN) ";X2%;" Chars"
- W1$="123456789012345678901234567890123456789012345678901234567890"
- W2$=" 1 2 3 4 5 6"
- W3$=".........+.........+.........+.........+.........+.........+"
- W4$=" 7 8 9 10 11 12"
- PRINT
- PRINT " "; LEFT$(W2$,X3%)
- PRINT " "; LEFT$(W1$,X3%)
- PRINT " "; LEFT$(W3$,X3%)
- PRINT "Password:";
- LINE INPUT P$
- PRINT
- IF X4% = 0% THEN 5810
- PRINT
- PRINT " "; LEFT$(W4$,X4%)
- PRINT " "; LEFT$(W1$,X4%)
- PRINT " "; LEFT$(W3$,X4%)
- PRINT "Password:";
- LINE INPUT P2$
- P$ = P$ + P2$
- 5810 L%=LEN(P$)
- IF L% < X2% THEN PRINT " *** Password TOO SHORT reenter ": GOTO 5600
- T%=INT(L%/X%)
- K#=0
- FOR K%=1 TO X%
- P2$=LEFT$(P$,T%)
- L%=L%-T%
- IF L% < 1 THEN 5900
- P$=RIGHT$(P$,L%)
- 5900 FOR J%=1% TO T%
- LL%=J%
- IF LL% > 6% THEN LL% = LL% MOD 6% : LL% = LL% + 1%
- C% = ASC( MID$(P2$,J%,1) )
- K# = K# + (CONS#(LL%) * C%)
- NEXT J%
- IF X%=1 THEN A#=K#
- IF X%=M% THEN B#(K%) = K#
- IF X%=N% THEN C#(K%) = K#
- K# = K# - (MD# * INT( K# / MD# ))
- NEXT K%
- RETURN
- '
- '
- ' ------ bit TRANSPOSITION -------
- '
- 6060 FOR JJ% = 1% TO 1024%
- L=M%
- S#=A#
- GOSUB 3530
- A#=S#
- B%=O%
- L=N%
- S#=B#(B%)
- GOSUB 3530
- B#(B%)=S#
- B%=O%
- S#=C#(B%)
- L=1024
- GOSUB 3530
- C#(B%)=S#
- IS% = BIT%(JJ%)
- BIT%(JJ%) = BIT%(O%)
- BIT%(O%) = IS%
- IS% = CH%(JJ%)
- CH%(JJ%) = CH%(O%)
- CH%(O%) = IS%
- NEXT JJ%
- RETURN
- '
- '
- '
- 6340 FOR JJ% = 1% TO 512%
- X1% = CH%(JJ%)
- B1% = BIT%(JJ%)
- IS% = JJ% + 512%
- X2% = CH%(IS%)
- B2% = BIT%(IS%)
- C1% = ASC( MID$(M$,X1%,1) )
- IF X1% = X2% THEN GOSUB 6500 : GOTO 6390
- C2% = ASC( MID$(M$,X2%,1) )
- S1% = B1% AND C1%
- S2% = B2% AND C2%
- IF S1% = 0% AND S2% = 0% THEN 6400
- IF S1% > 0% AND S2% > 0% THEN 6400
- C1% = C1% XOR B1%
- C2% = C2% XOR B2%
- MID$(M$,X2%,1) = CHR$(C2%)
- 6390 MID$(M$,X1%,1) = CHR$(C1%)
- 6400 NEXT JJ%
- RETURN
- '
- '
- '
- ' ----- SAME CHARACTER different bits ----
- 6500 S1% = B1% AND C1%
- S2% = B2% AND C1%
- IF S1% = 0% AND S2% = 0% THEN 6550
- IF S1% > 0% AND S2% > 0% THEN 6550
- C1% = C1% XOR B1%
- C1% = C1% XOR B2%
- 6550 RETURN
- '
- '
- '
- '
- ' ------ Help / Instructions -----
- 6600 OPEN "I",#3,"PC-CODE1.DOC"
- 6620 GOSUB 8190
- JJ%=1
- 6650 IF EOF(3) <> 0 THEN 6740
- LINE INPUT #3, M$
- PRINT M$
- JJ%=JJ%+1
- IF JJ% < 18 THEN 6650
- PRINT "=======================": PRINT
- PRINT "Wish More Documentation <CR>=Yes ";
- NO% = ASC("N") : YES% = 32%
- GOSUB 8300 : IF REPLY% = 1% THEN 6620 ELSE 6750
- 6740 GOSUB 7220 ' Pause
- 6750 GOSUB 8190
- CLOSE 3
- RETURN
- '
- '
- '
- 6800 INPUT "Enter the fully qualified Input Key File Name: "; F$
- OPEN "I", 5, F$
- LINE INPUT #5, P$
- IF LEFT$(P$,1) <> "*" THEN A#=VAL(P$) : GOTO 6870
- INPUT #5, T%, M%, N%
- 6850 IF T% <> 1 THEN PRINT "*** ERROR *** Bad Key File": END
- INPUT #5, A#
- 6870 A# = ABS( FIX( A# ) )
- IF A# = 0# THEN T% = 99 : GOTO 6850
- T% = M% + N% + 1
- FOR J%=1 TO M% : INPUT #5, B#(J%)
- B#(J%) = ABS( FIX( B#(J%) ) ) : NEXT J%
- FOR J%=1 TO N% : INPUT #5, C#(J%)
- C#(J%) = ABS( FIX( C#(J%) ) ) : NEXT J%
- IF EOF(5) <> 0 THEN PRINT "*** ERROR *** Reading key file": END
- PRINT "*** Loaded "; T% ;" Keys from "; F$; " Successfully"
- GOSUB 7220 ' Pause
- CLOSE 5
- RETURN
- '
- '
- '
- 7030 INPUT "Enter the fully qualified Output Key File Name: "; F$
- OPEN "O", 5, F$
- PRINT #5, "* HDR PC-CODE1 saved KEYS "
- WRITE #5, 1, M%, N%
- PRINT #5, A#
- FOR J%=1 TO M% : PRINT #5, B#(J%)
- NEXT J%
- FOR J%=1 TO N% : PRINT #5, C#(J%)
- NEXT J%
- PRINT #5, "* Keys Computed on " + DATE$ + " " + TIME$
- T% = M% + N% + 1
- PRINT "*** Saved "; T% ;" Keys to "; F$; " Successfully"
- GOSUB 7220 ' Pause
- CLOSE 5
- RETURN
- '
- '
- '
- ' -------- Delay Function -------
- 7220 PRINT : PRINT
- PRINT " <PAUSE> Press Enter to Continue ";
- LINE INPUT Z$
- RETURN
- '
- '
- '
- ' ----- Generated Key Seeds display ------
- 7400 GOSUB 8190
- PRINT "The following Numeric Keys/Seeds were generated:"
- PRINT : PRINT
- P$=SPACE$(16)
- PRINT " ( A ) : "; A#
- PRINT
- PRINT " ( B ) : ";
- FOR J%=1 TO M%
- PRINT LEFT$(STR$(B#(J%))+P$,16);
- NEXT J%
- PRINT : PRINT
- PRINT " ( C ) : ";
- FOR J%=1 TO N%
- PRINT LEFT$(STR$(C#(J%))+P$,16);
- NEXT J%
- PRINT: PRINT
- PRINT " --- To Print this screen depress 'Shift PrtSc' ---"
- GOSUB 7220 ' Pause
- RETURN
- '
- '
- '
- ' ---- Save Log Statistics for Keys used -----
- 7630 PRINT "Enter Stat Log File Name or 'LPT1:' or default of blank"
- F$ = " "
- INPUT "Enter Log File Name: "; F$
- IF LEN(F$)=0 OR LEFT$(F$,1)=" " THEN F$="PC-STAT1.LOG"
- OPEN "O", 6, F$
- FOR J%=1 TO M% : ACNT! = ACNT! + BCNT%(J%) : NEXT J%
- PRINT #6, " "
- PRINT #6, " <<<<< PC-CODE1 Statistics for Keys Used >>>>>"
- PRINT #6, " " : PRINT #6, " "
- PRINT #6, " Date and Time Stamp = "; DATE$ + " " + TIME$
- PRINT #6, " Keys Setup (B) size = "; M%
- PRINT #6, " Keys Setup (C) size = "; N%
- PRINT #6, " Total Characters processed = "; ACNT!
- PRINT #6, " "
- PRINT #6, " ----- Key Utilitization/Balance -----"
- PRINT #6, " " : PRINT #6, " "
- PRINT #6, " * For Key Group (B)"
- PRINT #6, " "
- PRINT #6, " KEY Count"
- FOR J%=1 TO M%
- PRINT #6, USING " ### ####### "; J%, BCNT%(J%)
- NEXT J%
- PRINT #6, " " : PRINT #6, " "
- PRINT #6, " * For Key Group (C)"
- PRINT #6, " "
- PRINT #6, " KEY Count"
- FOR J%=1 TO N%
- PRINT #6, USING " ### ####### "; J%, CCNT%(J%)
- NEXT J%
- PRINT #6, " " : PRINT #6, " "
- PRINT #6, " * Output Character Set Statistics:"
- PRINT #6, " "
- PRINT #6, " CHR$ Char Count"
- PRINT #6, " Num ---- Occur"
- FOR J%=0 TO 255
- IF CHNO%(J%)=0 THEN 7980
- IF J% > 31 AND J% < 127 THEN P$=CHR$(J%) ELSE P$=" "
- PRINT #6, USING " #### ! ####### "; J%, P$, CHNO%(J%)
- 7980 NEXT J%
- PRINT #6, " "
- PRINT #6, " *** END of STATISTICAL LOG ***"
- PRINT " *** Saved Log file to ";F$;" ***"
- CLOSE 6
- RETURN
- '
- '
- ' C L E A R S C R E E N
- 8190 IF IBM% = 0% THEN 8195
- CLS
- GOTO 8200
- 8195 PRINT
- PRINT "..........................................................."
- PRINT
- 8200 PRINT WZ$ : PRINT : PRINT
- RETURN
- '
- '
- '
- ' Y E S / N O Prompt Subroutine
- 8300 IF YES% <> 32% THEN PRINT " (";CHR$(YES%);" or ";CHR$(NO%);") ";
- IF YES% = 32% THEN PRINT " ( ";CHR$(NO%);" or <CR> ) ";
- Z$=" "
- INPUT Z$
- IF Z$ = "" AND YES% = 32 THEN REPLY% = 1% : GOTO 8400
- IF Z$ = "" THEN 8300
- REPLY% = 99%
- ANS% = ASC(Z$)
- IF ANS% > 90% THEN ANS% = ANS% - 32%
- IF ANS% = YES% THEN REPLY% = 1%
- IF ANS% = NO% THEN REPLY% = 0%
- IF REPLY% <> 99% THEN 8400
- PRINT " ERROR: Re-enter as follows: ";
- GOTO 8300
- 8400 RETURN
- '
- '
- ' ------ character TRANSPOSITION -------
- '
- 8600 FOR JJ% = 1% TO 128%
- L=M%
- S#=A#
- GOSUB 3530
- A#=S#
- B%=O%
- L=N%
- S#=B#(B%)
- GOSUB 3530
- B#(B%)=S#
- B%=O%
- S#=C#(B%)
- L=128
- GOSUB 3530
- C#(B%)=S#
- IS% = CH%(JJ%)
- CH%(JJ%) = CH%(O%)
- CH%(O%) = IS%
- NEXT JJ%
- RETURN
- '
- '
- '
- 8800 FOR JJ% = 1% TO 64%
- G1%=CH%(JJ%)
- G2%=CH%(JJ% + 64%)
- G1$=MID$(M$,G1%,1)
- G2$=MID$(M$,G2%,1)
- MID$(M$,G1%,1)=G2$
- MID$(M$,G2%,1)=G1$
- NEXT JJ%
- RETURN
- '
- '
- '
- 9100 IF XL% = 1% THEN GOSUB 6060 ELSE GOSUB 8600
- RETURN
- '
- '
- '
- 9200 IF XL% = 1% THEN GOSUB 6340 ELSE GOSUB 8800
- RETURN
- '
- '
- '
- ' END