'Copyright 2000 The American Cryptogram Association (ACA) '3613 Piedmont Drive, Plano TX 75075-6234 'All rights reserved. 'VFamDiag.Bas Sep/Oct 2001 'Code for Function Dec$() is in the 'Jul/Aug 1999 Column. DiAvg() and 'DiSum() are in May/Jun 2001. 'These routines are included in this 'complete version. 'Demo ct is AC639 Beaufort Autokey ct$= "OYJZQMLNJHLLHUKWFXEPKALDAIOA" ct$=ct$+"LEOBPIMEEUNRAQOMKYAOQTWPAKO" ct$=ct$+"XNZVGTTGAGANNSWIOZHDAVJPQAU" ct$=ct$+"AKIPELYSFCDGSPLZPMYGVDSAWSHD" DEFINT A-Z 'Variables are ints 'Set high and low periods to try BeginPer=3 : EndPer=12 If Len(Ct$) mod 2 <> 0 then Print "Odd number of characters." Print "Skipping Slidefair tests." BeginTyp=2 Else BeginTyp=0 End If V$="Vigenere" : A$="Variant" B$="Beaufort" : P$="Porta" S$="Slidefair": Ak$="Autokey" VA$=V$+"/"+A$ : Sp$=" " 'Main program loop. Do each type. For Typ= BeginTyp to 8 Slf=0 : Auk=0 'Slidef. autok flags Select Case Typ Case 0: Typ$=VA$+" "+S$ :Slf=1 Case 1: Typ$=B$+" " +S$ :Slf=1 Case 2: Typ$=VA$ +Sp$ Case 3: Typ$=B$ +Sp$ Case 4: Typ$=P$ +Sp$ Case 5: Typ$=V$+" "+Ak$ : Ak=1 Case 6: Typ$=A$+" "+Ak$ : Ak=1 case 7: Typ$=B$+" "+Ak$ : Ak=1 case 8: Typ$=P$+" "+Ak$+Sp$: Ak=1 End Select Print Typ$,"Periods","Scores" For Per=BeginPer to EndPer Sum=0 : T$ = Mid$(Typ$,1,1) If Typ=6 Then T$="A" 'Variant type For C=1 to per 'Score each column If Slf=1 then 'Score slidefair Sum= Sum+ BestSlfr(Ct$,C,Per,T$) Else 'Score nonSlidefair Sum= Sum+ BestV(Ct$,C,Per,T$,Ak) End If Next C Avg=Sum\Per : Print ,,Per, Avg If Avg > BestAvg then 'Save best BestAvg=Avg 'decrypt info Best$=Typ$+" Period="+Str$(Per) Best$=Best$+" Score="+Str$(Avg) End If Next Per 'Do next period Next Typ 'Do next cipher type Print "Best scoring type: ";Best$ End 'Tries all keys on column number Col 'in period Per for Viggy type Type$ 'with Ak=1 for Autokey decryption. 'Returns best decrypt digraph value. Function BestV(Ct$,Col,Per,Type$,Ak) CLen=Len(Ct$) : Rows=CLen\Per Clen=Clen-1 : Best=0 For KL=Asc("A") to Asc("Z") KL$=Chr$(KL) 'KL$ = Left key letter For KR=ASC("A") to Asc("Z") KR$=Chr$(KR) : Dg$="" :RowB=Col For R=1 to Rows LC$=Mid$(Ct$,RowB,1) RC$=Mid$(Ct$,RowB+1,1) LP$=Dec$(LC$,KL$,Type$) RP$=Dec$(RC$,KR$,Type$) Dg$=Dg$+LP$+RP$'PlnTxt digraphs If Ak=1 then kl$=lp$ : kr$=rp$ RowB=RowB+Per If RowB > Clen then exit for Next R 'Decrypt next row in cols D=DiAvg(Dg$,0) 'Score PlnTxt col If D > Best then Best=D Next KR 'next Right key letter Next KL 'next Left key letter BestV=Best'Best scoring decrypted col End Function 'BestV 'Does trial decryption of Slidefair. 'Trys each key letter and returns 'best score for the digraph column. Function BestSlfr(Ct$,Col,Per,Type$) CLen=Len(Ct$) : Rows=CLen\(Per*2) CLen=CLen-1 : Best=0 RowB = 2*Col-1 For K=Asc("A") to Asc("Z") K$=Chr$(K) : Dgs$="" For Row=1 to Rows Posn=(Row-1)*Per*2+RowB Dg$=Mid$(Ct$,Posn,2) Dgs$=Dgs$+DecSlf$(Dg$,K$,Type$) If RowB > Clen then exit for Next Row D=DiAvg(Dgs$,0) 'Score plntxt col If D > Best then Best=D Next K BestSlfr=Best End Function 'Returns decrypted digraph given 'Ct digraph, Key, and type = 'V/B/A (Vig/Beau/Var) slidefair. FUNCTION DecSlf$(CtD$,KLtr$,Type$) K=ASC(Kltr$)-65 LCt$= Mid$(Ctd$,1,1) RCt$= Mid$(Ctd$,2,1) LCt = ASC(Lct$)-65 RCt = ASC(Rct$)-65 Select Case Type$ Case "B" LPt = (K-RCt+26) mod 26 RPt = (K-LCt+26) mod 26 Case Else ' Vig or Variant LPt = (RCt-K+26) mod 26 RPt = (LCt+K+26) mod 26 End Select DecSlf$ = Chr$(Lpt+65)+Chr$(RPt+65) END FUNCTION 'DecSlf$ 'Returns pt ltr given Ct Ltr, Key & 'type = V/B/A/P = Vig/Beau/Var/Porta FUNCTION Dec$(CLtr$,KLtr$,Type$) C=ASC(CLtr$)-65 : K=ASC(KLtr$)-65 Select Case TYPE$ Case "V" : D = (C-K+26) mod 26 Case "B" : D = (K-C+26) mod 26 Case "A" : D = (C+K) mod 26 Case Else' Any other case=Porta K = K\2 : D = C If D < 13 Then D=D+K : If D<13 Then D=D+13 Else D=D-K : If D>12 Then D=D-13 End If End Select Dec$ = CHR$(D+65) END FUNCTION 'Dec$ 'Corrected Nov/Dec 2001 Function DiAvg(S$,A) DLen%= Len(S$) - 1 If A<>1 then Dlen%=((Dlen%-1)\2)+1 DiAvg = Int(100*(DiSum(S$,A)/Dlen%)) End Function 'DiAvg Function DiSum(S$,A) Static IF Init%=0 Then DIM Di%(26,26) d$=d$+"47874675736879373989676574742" d$=d$+"08111630721710653712060825273" d$=d$+"28727621822647613040765686558" d$=d$+"43665753677656062978887667458" d$=d$+"79775998577673745376447226538" d$=d$+"40757624050755475577326557527" d$=d$+"66635051854494348315548426576" d$=d$+"25050758777744258797647884735" d$=d$+"05500040003000005000006000005" d$=d$+"43274246224365313653040508557" d$=d$+"85448258548524666550718643842" d$=d$+"47104647613656140608678869684" d$=d$+"66568535896563626677686663678" d$=d$+"97729789684537333732672173276" d$=d$+"07666030400000000000000000000" d$=d$+"06000008667966583666686368865" d$=d$+"60718676865784666687458974706" d$=d$+"28665865983366596278874707266" d$=d$+"76646462377856088833434361008" d$=d$+"00070000050001021003073347328" d$=d$+"72244673055521403141424203510" d$=d$+"11035012520223066666655633565" d$=d$+"86357643624240005000300200300" d$=d$+"010200044" For I%=0 to 675 'Build Di% Table C$=Mid$(D$,I%+1,1): V% = Val(C$) Di%((I%\26)+1,(I% mod 26)+1)=V% Next I% d$="" : Init%=1 'Initialization done End If TLen%=Len(S$)-1 : Sum%=0 :Stp%=2 If A=1 Then Stp%=1 For I%=1 to TLen% Step Stp% R%=Asc(Mid$(S$,I%,1))-64 C%=Asc(Mid$(S$,I%+1,1))-64 Sum%=Sum%+Di%(R%,C%) Next I% DiSum = Sum% End Function 'DiSum