Enigma Machine Simulator

[neil]

This a basic three rotor Enigma machine simulator.
This Enigma machine simulator encodes/decodes messages.
This has been updated and now works correctly.
More info: https://en.wikipedia.org/wiki/Enigma_machine

Code: Select all

'FreeBasic Enigma Machine Simulator

' Enigma Machine Configuration
Const RotorCount As Integer = 3
Const Alphabet As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim Shared Rotor(RotorCount) As String
Dim Shared RotorOffset(RotorCount) As Integer

' Initialize the Enigma Machine
Sub InitializeEnigmaMachine()
    Rotor(1) = "EJMZALYXVBWFCRQUONTSPIKHGD"
    Rotor(2) = "YRUHQSLDPXNGOKMIEBFZCWVJAT"
    Rotor(3) = "FVPJIAOYEDRZXWGCTKUQSBNMHL"
   
    ' Set initial offsets for each rotor
    RotorOffset(1) = 0
    RotorOffset(2) = 0
    RotorOffset(3) = 0
End Sub

' Encrypt/Decrypt a character using the Enigma Machine
Function EncryptDecryptChar(ByRef ch As String) As String
    Dim i As Integer
    Dim index As Integer
   
    ' Find the index of the character in the alphabet
    index = Instr(Alphabet, ch) - 1
   
    ' Pass through the rotors
    For i = 1 To RotorCount
        index = (index + RotorOffset(i)) Mod 26
        ch = Mid(Rotor(i), index + 1, 1)
        index = Instr(Alphabet, ch) - 1
    Next
   
    ' Reflect through the rotor
    index = (index + 13) Mod 26
   
    ' Pass through the rotors again in reverse order
    For i = RotorCount To 1 Step -1
        ch = Mid(Alphabet, index + 1, 1)
        index = Instr(Rotor(i), ch) - 1
        index = (index - RotorOffset(i) + 26) Mod 26
    Next
   
    ' Find the character at the final index
    EncryptDecryptChar = Mid(Alphabet, index + 1, 1)
   
    ' Rotate the first rotor
    RotorOffset(1) = (RotorOffset(1) + 1) Mod 26
End Function

' Encrypt a message using the Enigma Machine
Function EncryptMessage(message As String) As String
    Dim i As Integer
    Dim encryptedMessage As String
   
    ' Initialize the encrypted message
    encryptedMessage = ""
   
    ' Encrypt each character in the message
    For i = 1 To Len(message)
        encryptedMessage = encryptedMessage & EncryptDecryptChar(Mid(message, i, 1))
    Next
   
    EncryptMessage = encryptedMessage
End Function

' Decrypt a message using the Enigma Machine
Function DecryptMessage(message As String) As String
    ' Decryption is the same as encryption in the Enigma Machine
    DecryptMessage = EncryptMessage(message)
End Function

' Main program
Sub Main()
    Dim message As String
    Dim encryptedMessage As String
    Dim decryptedMessage As String
   
    ' Initialize the Enigma Machine
    InitializeEnigmaMachine()
   
    ' Get message from user
    Print "Enter a message: ";
    Line Input message
   
    ' Encrypt the message
    encryptedMessage = EncryptMessage(UCase(message))
   
    InitializeEnigmaMachine
    ' Decrypt the encrypted message
    decryptedMessage = DecryptMessage(encryptedMessage)
   
    ' Print encrypted and decrypted messages
    Print "Encrypted Message: " & encryptedMessage
    Print "Decrypted Message: " & decryptedMessage
End Sub

' Run the main program
Main

sleep

[neil]

Here's the Rail Fence Cipher.
https://en.wikipedia.org/wiki/Rail_fence_cipher

Code: Select all

' Function to encode a string using Rail Fence cipher
Function RailFenceEncode(ByVal plaintext As String, ByVal rails As Integer) As String
    Dim encoded As String = ""
    Dim fence(rails, Len(plaintext)) As String
    Dim rail As Integer = 0
    Dim direction As Integer = 1
    
    For i As Integer = 0 To Len(plaintext) - 1
        fence(rail, i) = Mid(plaintext, i + 1, 1)
        
        rail += direction
        
        If rail = 0 Or rail = rails - 1 Then
            direction = -direction
        End If
    Next
    
    For r As Integer = 0 To rails - 1
        For c As Integer = 0 To Len(plaintext) - 1
            If fence(r, c) <> "" Then
                encoded += fence(r, c)
            End If
        Next
    Next
    
    Return encoded
End Function

' Function to decode a string using Rail Fence cipher
Function RailFenceDecode(ByVal encoded As String, ByVal rails As Integer) As String
    Dim decoded As String = ""
    Dim fence(rails, Len(encoded)) As String
    Dim rail As Integer = 0
    Dim direction As Integer = 1
    
    For i As Integer = 0 To Len(encoded) - 1
        fence(rail, i) = " "
        
        rail += direction
        
        If rail = 0 Or rail = rails - 1 Then
            direction = -direction
        End If
    Next
    
    Dim idx As Integer = 0
    For r As Integer = 0 To rails - 1
        For c As Integer = 0 To Len(encoded) - 1
            If fence(r, c) = " " Then
                fence(r, c) = Mid(encoded, idx + 1, 1)
                idx += 1
            End If
        Next
    Next
    
    rail = 0
    direction = 1
    
    For i As Integer = 0 To Len(encoded) - 1
        decoded += fence(rail, i)
        
        rail += direction
        
        If rail = 0 Or rail = rails - 1 Then
            direction = -direction
        End If
    Next
    
    Return decoded
End Function

' Example usage
Dim plaintext As String = "FREEBASIC"
Dim rails As Integer = 4

Dim encoded As String = RailFenceEncode(plaintext, rails)
Print "Encoded: " + encoded

Dim decoded As String = RailFenceDecode(encoded, rails)
Print "Decoded: " + decoded

Sleep

[neil]

Here's a new Enigma 5 rotor all-in-one encoder/decoder. It encodes and decodes correctly.

Code: Select all

' FreeBasic Enigma encoder/decoder

' Define Enigma rotor settings
dim shared as string rotor1
rotor1 = "EKMFLGDQVZNTOWYHXUSPAIBRCJ"
dim shared as string rotor2
rotor2 = "AJDKSIRUXBLHWTMCQGZNPYFVOE"
dim shared as string rotor3
rotor3 = "BDFHJLCPRTXVZNYEIWGAKMUSQO"
dim shared as string rotor4
rotor4 = "ESOVPZJAYQUIRHXLNFTGKDCMWB"
dim shared as string rotor5
rotor5 = "VZBRGITYUPSDNHLXAWMJQOFECK"

' Define reflector
dim shared as string reflector
reflector = "YRUHQSLDPXNGOKMIEBFZCWVJAT"

' Function to encode a character through the Enigma machine
function encodeChar(c as string) as string
    ' Convert character to uppercase
    c = ucase(c)

    ' Pass through rotor1
    dim index1 as integer = asc(c) - asc("A")
    c = mid(rotor1, index1 + 1, 1)

    ' Pass through rotor2
    dim index2 as integer = asc(c) - asc("A")
    c = mid(rotor2, index2 + 1, 1)

    ' Pass through rotor3
    dim index3 as integer = asc(c) - asc("A")
    c = mid(rotor3, index3 + 1, 1)

    ' Pass through rotor4
    dim index4 as integer = asc(c) - asc("A")
    c = mid(rotor4, index4 + 1, 1)

    ' Pass through rotor5
    dim index5 as integer = asc(c) - asc("A")
    c = mid(rotor5, index5 + 1, 1)

    ' Pass through reflector
    dim indexR as integer = asc(c) - asc("A")
    c = mid(reflector, indexR + 1, 1)

    ' Pass back through rotors (in reverse order)
    index5 = instr(rotor5, c) - 1
    c = chr(index5 + asc("A"))

    index4 = instr(rotor4, c) - 1
    c = chr(index4 + asc("A"))

    index3 = instr(rotor3, c) - 1
    c = chr(index3 + asc("A"))

    index2 = instr(rotor2, c) - 1
    c = chr(index2 + asc("A"))

    index1 = instr(rotor1, c) - 1
    c = chr(index1 + asc("A"))

    return c
end function

' Main program
dim encryptedMessage as string
dim decryptedMessage as string = ""

' Prompt user to enter an encrypted message
input "Enter the encrypted/decrypted message: ", encryptedMessage

' Decode message character by character
for i as integer = 1 to len(encryptedMessage)
    dim encryptedChar as string = mid(encryptedMessage, i, 1)
    dim decryptedChar as string = encodeChar(encryptedChar)
    decryptedMessage += decryptedChar
next

' Print decrypted message
print "Decrypted Message: "; decryptedMessage
sleep

[neil]

The enigma machine on the opening post has been updated; it now encodes and decodes and works correctly.

[neil]

I just updated the five-rotor all-in-one encoder and decoder. I also posted a rail fence cipher.

[neil]

Here's another three-rotor Enigma machine simulator.

Code: Select all

' three-rotor enigma machine simulator.
const rotor1 = "EKMFLGDQVZNTOWYHXUSPAIBRCJ"
const rotor2 = "AJDKSIRUXBLHWTMCQGZNPYFVOE"
const rotor3 = "BDFHJLCPRTXVZNYEIWGAKMUSQO"

const reflector = "YRUHQSLDPXNGOKMIEBFZCWVJAT"

dim as string alphabet
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

dim shared as integer rotor_pos
rotor_pos = 0
dim shared as integer rotor1_pos
rotor1_pos = 0
dim shared as integer rotor2_pos
rotor2_pos = 0
dim shared as integer rotor3_pos
rotor3_pos = 0

function encipher_char(byval ch as string, byval offset as integer) as string
    ' Move rotor positions
    rotor_pos += 1
    if rotor_pos > 25 then
        rotor_pos = 0
        rotor1_pos += 1
        if rotor1_pos > 25 then
            rotor1_pos = 0
            rotor2_pos += 1
            if rotor2_pos > 25 then
                rotor2_pos = 0
                rotor3_pos += 1
                if rotor3_pos > 25 then
                    rotor3_pos = 0
                end if
            end if
        end if
    end if

    ' Adjust character position
    dim index as integer = (asc(ch) - asc("A") + offset) mod 26
    if index < 0 then
        index += 26
    end if

    ' Pass through rotors
    index = (index + rotor_pos) mod 26
    index = (asc(mid(rotor1, index + 1, 1)) - asc("A") + rotor1_pos) mod 26
    index = (asc(mid(rotor2, index + 1, 1)) - asc("A") + rotor2_pos) mod 26
    index = (asc(mid(rotor3, index + 1, 1)) - asc("A") + rotor3_pos) mod 26

    ' Reflect
    dim reflector_index as integer = (index - rotor3_pos + asc("A")) mod 26
    dim reflected_char as string = chr(reflector_index + asc("A"))

    ' Pass back through rotors
    for i as integer = 0 to 25
        if asc(mid(rotor3, i + 1, 1)) = asc(reflected_char) then
            index = (i - rotor3_pos + 26) mod 26
            exit for
        end if
    next

    for i as integer = 0 to 25
        if asc(mid(rotor2, i + 1, 1)) = index + asc("A") then
            index = (i - rotor2_pos + 26) mod 26
            exit for
        end if
    next

    for i as integer = 0 to 25
        if asc(mid(rotor1, i + 1, 1)) = index + asc("A") then
            index = (i - rotor1_pos + 26) mod 26
            exit for
        end if
    next

    index = (index - rotor_pos + 26) mod 26
    if index < 0 then
        index += 26
    end if

    ' Adjust character back
    ch = chr(index + asc("A"))

    return ch
end function

sub start()
    dim as string plaintext = "OTYVKJBEB"
    dim as string encoded_text = ""

    for i as integer = 1 to len(plaintext)
        encoded_text += encipher_char(mid(plaintext, i, 1), 0)
    next

    print "Original text: " & plaintext
    print "Encoded/Decoded text: " & encoded_text

    sleep
end sub

start