RosettaCodeData/Task/ADFGVX-cipher/FreeBASIC/adfgvx-cipher.basic

Const ADFGVX As String = "ADFGVX"
Const ALPHABET As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

Function InitialisePolybiusSquare() As String
    Dim As Integer i, j
    Dim As String letters(35)
    For i = 0 To 35
        letters(i) = Mid(ALPHABET, i + 1, 1)
    Next
    Randomize Timer
    For i = 0 To 35
        j = Int(Rnd * 36)
        Swap letters(i), letters(j)
    Next

    Dim As Integer row, column
    Dim As String result = ""
    For row = 0 To 5
        For column = 0 To 5
            result &= letters(6 * row + column)
        Next
    Next

    Return result
End Function

Function CreateKey(size As Integer) As String
    If size < 7 Or size > 12 Then
        Print "Key should contain between 7 and 12 letters, both inclusive."
        Exit Function
    End If

    Dim As Integer i, j
    Dim As String word, candidates()
    Dim As Integer ff = Freefile

    Open "i:\unixdict.txt" For Input As #ff
    While Not Eof(ff)
        Line Input #ff, word

        Dim As String uniqueWord = ""
        For i = 1 To Len(word)
            If Instr(uniqueWord, Mid(word, i, 1)) = 0 Then
                uniqueWord &= Mid(word, i, 1)
            End If
        Next

        If Len(word) = size And Len(word) = Len(uniqueWord) Then
            word = Ucase(word)

            Dim isAlphanum As Boolean = TRue
            For i = 1 To Len(word)
                If Not (Mid(word, i, 1) >= "A" And Mid(word, i, 1) <= "Z") And Not (Mid(word, i, 1) >= "0" And Mid(word, i, 1) <= "9") Then
                    isAlphanum = False
                    Exit For
                End If
            Next

            If isAlphanum Then
                Redim Preserve candidates(Ubound(candidates) + 1)
                candidates(Ubound(candidates)) = word
            End If
        End If
    Wend
    Close #ff

    Randomize Timer
    For i = 0 To Ubound(candidates)
        j = Int(Rnd * (Ubound(candidates) + 1))
        Swap candidates(i), candidates(j)
    Next

    Return candidates(0)
End Function

Function Encrypt(plainText As String, polybius As String, key As String) As String
    Dim As Integer i, j, row, column
    Dim As String code, ch, encrypted

    code = ""
    For i = 1 To Len(plainText)
        ch = Mid(plainText, i, 1)
        For row = 0 To 5
            For column = 0 To 5
                If Mid(polybius, row * 6 + column + 1, 1) = ch Then
                    code &= Mid(ADFGVX, row + 1, 1)
                    code &= Mid(ADFGVX, column + 1, 1)
                End If
            Next
        Next
    Next

    encrypted = ""
    For i = 1 To Len(key)
        ch = Mid(key, i, 1)
        For j = Instr(key, ch) - 1 To Len(code) - 1 Step Len(key)
            encrypted &= Mid(code, j + 1, 1)
        Next
        encrypted &= " "
    Next

    Return encrypted
End Function

Function Decrypt(encryptedText As String, polybius As String, key As String) As String
    Dim As Integer i, j, row, column, spaceCount, codeSize
    Dim As String result, stream, word, code, plainText
    Dim As String blocks()

    result = ""
    i = 1
    While i <= Len(encryptedText)
        If Mid(encryptedText, i, 1) = " " Then
            i += 1
        Else
            result += Mid(encryptedText, i, 1)
            i += 1
        End If
    Wend
    spaceCount = Len(encryptedText) - Len(result)
    codeSize = Len(encryptedText) - spaceCount

    stream = encryptedText
    While Len(stream) > 0
        word = Left(stream, Instr(stream, " ") - 1)
        Redim Preserve blocks(Ubound(blocks) + 1)
        blocks(Ubound(blocks)) = word
        stream = Mid(stream, Instr(stream, " ") + 1)
    Wend

    code = ""
    For i = 0 To codeSize - 1
        For j = 0 To Ubound(blocks)
            If Len(code) < codeSize Then code &= Mid(blocks(j), i + 1, 1)
        Next
    Next

    plainText = ""
    For i = 1 To codeSize - 1 Step 2
        row = Instr(ADFGVX, Mid(code, i, 1)) - 1
        column = Instr(ADFGVX, Mid(code, i + 1, 1)) - 1
        plainText &= Mid(polybius, row * 6 + column + 1, 1)
    Next

    Return plainText
End Function

Dim As String polybius = InitialisePolybiusSquare()
Print "The 6 x 6 Polybius square:"
Print " | A D F G V X"
Print "--------------"
For row As Integer = 0 To 5
    Print Mid(ADFGVX, row + 1, 1); "|";
    For column As Integer = 0 To 5
        Print " "; Mid(polybius, row * 6 + column + 1, 1);
    Next
    Print
Next

Dim As String key = CreateKey(9)
Print !"\nThe key is "; key
Dim As String plainText = "ATTACKAT1200AM"
Print !"\nPlain text: "; plainText
Dim As String encryptedText = Encrypt(plainText, polybius, key)
Print !"\nEncrypted: "; encryptedText
Dim As String decryptedText = Decrypt(encryptedText, polybius, key)
Print !"\nDecrypted: "; decryptedText

Sleep