138 lines
4.0 KiB
Plaintext
138 lines
4.0 KiB
Plaintext
' Caocipher Example
|
|
' Rosetta Code
|
|
' This code was made in Power Basic 3.5 for DOS
|
|
|
|
CLS
|
|
|
|
' Left Alphabet
|
|
Function AlphaLeft(ct as String, pt as String, CharPos as Integer) as String
|
|
|
|
Dim tStr as String: tStr=ct
|
|
|
|
' 1. Shift the entire left alphabet cyclically so the ciphertext letter
|
|
' just enciphered is positioned at the zenith (i.e., position 1).
|
|
tStr=Right$(ct, Len(ct)-CharPos+1)+Left$(ct, CharPos-1)
|
|
|
|
' 2. Extract the letter found at position zenith+1 (i.e., the letter to
|
|
' the right of the zenith), taking it out of the alphabet, temporarily
|
|
' leaving an unfilled "hole"
|
|
|
|
Dim Hole as String: Hole=Mid$(tStr, 2, 1): Mid$(tStr, 2, 1)=" "
|
|
|
|
' 3. Shift all letters in positions zenith+2 up to, and including, the
|
|
' nadir (zenith+13), moving them one position to the left
|
|
|
|
tStr=Left$(tStr, 1)+Mid$(tStr, 3, 12)+" "+Right$(tStr, 12)
|
|
|
|
' 4. Insert the just-extracted letter into the nadir position
|
|
' (i.e., zenith+13)
|
|
|
|
Mid$(tStr, 14, 1)=Hole
|
|
|
|
AlphaLeft=tStr
|
|
End Function
|
|
|
|
' Right Alphabet
|
|
Function AlphaRight(ct as String, pt as String, CharPos as Integer) as String
|
|
|
|
Dim tStr as String: tStr=pt
|
|
|
|
' 1. Shift the entire right alphabet cyclically so the plaintext letter
|
|
' just enciphered is positioned at the zenith.
|
|
|
|
tStr=Right$(tStr, Len(tStr)-CharPos+1)+Left$(tStr, CharPos-1)
|
|
|
|
' 2. Now shift the entire alphabet one more position to the left (i.e.,
|
|
' the leftmost letter moves cyclically to the far right), moving a new
|
|
' letter into the zenith position.
|
|
|
|
tStr=Right$(tStr, 25)+Left$(tStr, 1)
|
|
|
|
' 3. Extract the letter at position zenith+2, taking it out of the
|
|
' alphabet, temporarily leaving an unfilled "hole".
|
|
|
|
Dim Hole as String: Hole=Mid$(tStr, 3, 1): Mid$(tStr, 3, 1)=" ":
|
|
|
|
' 4. Shift all letters beginning with zenith+3 up to, and including, the
|
|
' nadir (zenith+13), moving them one position to the left.
|
|
|
|
tStr=Left$(tStr, 2)+Mid$(tStr, 4, 11)+" "+Right$(tStr, 12)
|
|
|
|
' 5. Insert the just-extracted letter into the nadir position (zenith+13)
|
|
|
|
Mid$(tStr, 14, 1)=Hole
|
|
|
|
AlphaRight=tStr
|
|
End Function
|
|
|
|
Function Encode(Text as String, ct as String, pt as String) as String
|
|
Dim t as Integer
|
|
Dim tStr as String: tStr=""
|
|
|
|
For t=1 to Len(Text)
|
|
Dim Char as String: Char=Mid$(Text, t, 1)
|
|
Dim CharPos as Integer: CharPos=Instr(pt, Char)
|
|
|
|
ct=AlphaLeft(ct, pt, CharPos)
|
|
pt=AlphaRight(ct, pt, CharPos)
|
|
|
|
tStr=tStr+Left$(ct, 1)
|
|
Next
|
|
|
|
Encode=tStr
|
|
End Function
|
|
|
|
' Deciphering a Chaocipher-encrypted message is identical to the steps used
|
|
' for enciphering. The sole difference is that the decipherer locates the
|
|
' known ciphertext letter in the left (ct) alphabet, with the plaintext
|
|
' letter being the corresponding letter in the right (pt) alphabet
|
|
'
|
|
' Alphabet permuting is identical in enciphering and deciphering
|
|
|
|
Function Decode(Text as String, ct as String, pt as String) as String
|
|
Dim t as Integer
|
|
Dim tStr as String: tStr=""
|
|
|
|
For t=1 to Len(Text)
|
|
Dim Char as String: Char=Mid$(Text, t, 1)
|
|
Dim CharPos as Integer: CharPos=Instr(ct, Char)
|
|
|
|
ct=AlphaLeft(ct, pt, CharPos)
|
|
pt=AlphaRight(ct, pt, CharPos)
|
|
|
|
tStr=tStr+Right$(pt, 1)
|
|
Next
|
|
|
|
Decode=tStr
|
|
End Function
|
|
|
|
' Start of Main Code
|
|
|
|
' LEFT (Cipher Text): HXUCZVAMDSLKPEFJRIGTWOBNYQ
|
|
Dim tLeft as String: tLeft="HXUCZVAMDSLKPEFJRIGTWOBNYQ"
|
|
|
|
' RIGHT (Plain Text): PTLNBQDEOYSFAVZKGJRIHWXUMC
|
|
Dim tRight as String: tRight="PTLNBQDEOYSFAVZKGJRIHWXUMC"
|
|
|
|
' Cipher Message (Used to verify a good encoding)
|
|
Dim cText as String: cText="OAHQHCNYNXTSZJRRHJBYHQKSOUJY"
|
|
|
|
' Plain Text Message
|
|
Dim pText as String: pText="WELLDONEISBETTERTHANWELLSAID"
|
|
Print " Plain Text: "; pText: Print
|
|
|
|
Dim ctLeft as String: ctLeft=tLeft
|
|
Dim ptRight as String: ptRight=tRight
|
|
|
|
' Final Cipher Text
|
|
Dim eText as String: eText=Encode(pText, ctLeft, ptRight)
|
|
Print " Cipher Text: "; eText: Print
|
|
|
|
If eText=cText then Print "Successful" else Print "Failed"
|
|
|
|
ctLeft=tLeft: ptRight=tRight
|
|
Dim dText as String: dText=Decode(eText, ctLeft, ptRight)
|
|
Print: Print " Plain Text: "; dText: Print
|
|
|
|
If dText=pText then Print "Successful" else Print "Failed"
|