'Copyright 2003 The American Cryptogram Association (ACA)
'3613 Piedmont Drive, Plano TX 75075-6234
'All rights reserved.
'Bifid Crib Placer
CLS : DEFINT A-Z
PRINT "Bifid Crib Placer"
DIM PA(300): DIM BA(300)
DIM Crib(150): DIM Label(26, 2)
GOSUB GetCipher
TL = LEN(Ct$): K = 1
FOR I = 1 TO TL
J = ASC(UCASE$(MID$(Ct$, I, 1)))
IF J > 64 AND J < 91 THEN
BA(K) = J - 64: K = K + 1
END IF
NEXT I
TL = K - 1 :PRINT TL;"Text letters"
GOSUB GetCrib
CL = LEN(Cb$)
FOR I = 1 TO CL
J = ASC(UCASE$(MID$(Cb$, I, 1)))
Crib(I) = J - 64
NEXT I
FOR period = 4 TO 12
PRINT "Period"; period; "OK at ";
FOR Cpos = 1 TO TL - CL + 1
GOSUB GetLabels
GOSUB IsPositionPossible
NEXT Cpos
PRINT
NEXT period
END
'subroutines
GetCipher:
Ct$ = ""
INPUT "Name of ciphertext file"; Fil$
OPEN Fil$ FOR INPUT AS #1
WHILE NOT EOF(1)
INPUT #1, c$
Ct$ = Ct$ + c$
WEND
CLOSE #1
PRINT "Ciphertext is "; Ct$
RETURN
GetCrib:
INPUT "Enter Crib (NO BLANKS)"; Cb$
RETURN
GetLabels:
' reset label array to -1 (empty)
FOR I = 1 TO 26: FOR J = 1 TO 2
Label(I, J) = -1
NEXT J, I
' TL = text length. Reset PA array
FOR I = 1 TO TL: PA(I) = -1: NEXT I
' CL = crib length, Cpos = crib start
FOR I = 1 TO CL
PA(Cpos - 1 + I) = Crib(I)
NEXT I
'BA ciphertext array, PA crib array
N = period: NxtL = 0: BS = 1
DO 'crib index CP goes from 1 to TL
'BI = 1 for row and 2 for Column
Cnt = 0: BI = 1: CI = 1
BP = BS: CP = BS
WHILE Cnt < 2 * N
c = PA(CP) 'c is crib entry
b = BA(BP) 'b is cipher letter
IF c <> -1 THEN 'c is real letter
nb = Label(b, BI)
nc = Label(c, CI)
IF nb = -1 AND nc = -1 THEN
Label(b, BI) = NxtL
Label(c, CI) = NxtL
NxtL = NxtL + 1
ELSEIF nc = -1 THEN
Label(c, CI) = nb
ELSEIF nb = -1 THEN
Label(b, BI) = nc
ELSE 'merge labels
FOR I = 1 TO 26: FOR J = 1 TO 2
IF Label(I, J) = nc THEN
Label(I, J) = nb
END IF
NEXT J, I
END IF
END IF ' c <> -1
Cnt = Cnt + 1
CP = CP + 1
IF (Cnt MOD N) = 0 THEN
CI = CI + 1 'switch to columns
CP = BS 'back to group's start
END IF
IF BI = 1 THEN
BI = 2
ELSE
BI = 1
BP = BP + 1 'next cipher let
END IF
WEND 'loop through this group
BS = BS + period
IF BS + period > TL THEN
N = TL - BS + 1
ELSE
N = period
END IF
LOOP UNTIL BS > TL
RETURN
IsPositionPossible:
FOR J = 1 TO NxtL - 1
FOR K = 1 TO 2
N = 0
FOR I = 1 TO 26
IF Label(I, K) = J THEN
N = N + 1 'letter count
IF N > 5 THEN 'too many!
RETURN
END IF
END IF
NEXT I, K, J
FOR J = 1 TO 25
L1 = Label(J, 1): L2 = Label(J, 2)
IF L1 > -1 AND L2 > -1 THEN
FOR K = J + 1 TO 26
L3 = Label(K, 1): L4 = Label(K, 2)
IF L1 = L3 AND L2 = L4 THEN
RETURN 'two in same cell
END IF
NEXT K
END IF
NEXT J
PRINT " "; Cpos;
RETURN