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
'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
Last edited by neil on Feb 01, 2024 20:30, edited 2 times in total.
' 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
Last edited by neil on Feb 02, 2024 8:01, edited 1 time in total.
' 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
Last edited by neil on Feb 02, 2024 9:43, edited 1 time in total.
' 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