VBS zur einfachen Codierung

Option Explicit

'''''''''''''''''' Caesar Substitionsfunktion (wird für alle nachfolgenden Chiffre Typen benötigt) ''''''''''''''''''  

' Ersetzt ein Zeichen im durch Anfang und Ende beschriebenen Alphabet durch Verschiebung um den definierten Betrag  
' char     zu ersetzendes Zeichen  
' chFirst  erstes Zeichen des zu verwendenden Alphabets  
' chLast   letztes Zeichen des zu verwendenden Alphabets  
' steps    Anzahl Zeichen im Alphabet um die verschoben werden soll  
' return  ersetztes Zeichen  
Function subst(ByRef char, ByRef chFirst, ByRef chLast, steps)
  Dim chVal, chFirstVal, chLastVal, span
  ' Zeichenwerte  
  chVal = Asc(char)
  chFirstVal = Asc(chFirst)
  chLastVal = Asc(chLast)
  ' Wenn ein Zeichen nicht im Alphabet liegt, führe keine Ersetzung durch  
  If chVal < chFirstVal Or chVal > chLastVal Or chLastVal <= chFirstVal Then
    subst = char
    Exit Function
  End If
  ' ersetze durch rotierende Verschiebung (heißt, setze am Anfang des Alphabets fort, falls das Ende überschritten wird)  
  span = 1 + chLastVal - chFirstVal
  subst = Chr(((chVal - chFirstVal + (steps Mod span) + span) Mod span) + chFirstVal)
End Function

'''''''''''''''''' Chiffre Funktionen ''''''''''''''''''  

' Caesar Chiffre  
' str  zu chiffrierender String  
' n    Anzahl Zeichen im Alphabet " " bis "~" um die verschoben werden soll  
' return  chiffrierter String  
Function caesar_cipher(ByRef str, n)
  Dim i, newStr
  For i = 1 To Len(str)
    newStr = newStr & subst(Mid(str, i, 1), " ", "~", n)  
  Next
  caesar_cipher = newStr
End Function

' ROT13 / ROT5 Chiffre; A-Z, a-z und 0-9 definieren je ein Alphabet, verschoben wird jeweils um die Hälfte der Länge des Alphabets  
' str  zu chiffrierender String  
' return  chiffrierter String, A-Z und a-z um 13 Zeichen, 0-9 um 5 Zeichen verschoben  
Function rot_cipher(ByRef str)
  Dim i, ch, newStr
  For i = 1 To Len(str)
    ch = Mid(str, i, 1)
    ch = subst(ch, "A", "Z", 13)  
    ch = subst(ch, "a", "z", 13)  
    ch = subst(ch, "0", "9", 5)  
    newStr = newStr & ch
  Next
  rot_cipher = newStr
End Function

' Atbash Chiffre, ersetzt Zeichen mit Index x im Alphabet " " bis "~" durch Zeichen mit Index -x vom Ende des Alphabets  
' str  zu chiffrierender String  
' return  chiffrierter String  
Function atbash_cipher(ByRef str)
  Const first = " ", last = "~"  
  Dim firstVal, lastVal, i, ch, newStr
  firstVal = Asc(first)
  lastVal = Asc(last)
  For i = 1 To Len(str)
    ch = Mid(str, i, 1)
    newStr = newStr & subst(ch, first, last, lastVal - firstVal - 2 * (Asc(ch) - firstVal))
  Next
  atbash_cipher = newStr
End Function

' Vigenère Chiffre, die Werte der Zeichen eines Schlüsselwortes definieren den zu verschiebenden Betrag im Alphabet " " bis "~"  
' str          zu chiffrierender String  
' key          Schlüsselwort dessen Zeichenwerte den zu verschiebenden Betrag repräsentieren  
' isEncrypted  boolescher Wert (False für die Chiffrierung, True für die Dechiffrierung)  
' return  chiffrierter String  
Function vigenere_cipher(ByRef str, ByRef key, isEncrypted)
  Dim lenKey, factor, i, j, newStr
  lenKey = Len(key)
  factor = 1 + 2 * CInt(isEncrypted) ' ergibt 1 zum chiffrieren, -1 zum dechiffrieren  
  j = 1
  For i = 1 To Len(str)
    newStr = newStr & subst(Mid(str, i, 1), " ", "~", factor * Asc(Mid(key, j, 1)))  
    j = j + 1
    If j > lenKey Then j = 1
  Next
  vigenere_cipher = newStr
End Function

'''''''''''''''''' Beispielcode ''''''''''''''''''  

Const originalStr = "Am Anfang war das Wort, und das Wort war Content-Type: text/plain"  
Dim newString

' Caesar  
newString = caesar_cipher(originalStr, 56)
MsgBox newString, 0, "Caesar - verschlüsselt"  

newString = caesar_cipher(newString, -56)
MsgBox newString, 0, "Caesar - entschlüsselt"  


' ROT13 (für A-Z bzw. a-z) und ROT5 (für 0-9)  
newString = rot_cipher(originalStr)
MsgBox newString, 0, "ROT13/ROT5 - verschlüsselt"  

newString = rot_cipher(newString)
MsgBox newString, 0, "ROT13/ROT5 - entschlüsselt"  


' Atbash  
newString = atbash_cipher(originalStr)
MsgBox newString, 0, "Atbash - verschlüsselt"  

newString = atbash_cipher(newString)
MsgBox newString, 0, "Atbash - entschlüsselt"  


' Vigenère  
Const keyword = "|T's-mY^#1.oF;A]l,4wEs()M3~Se{r3t/kEy_W0Rd$"  
newString = vigenere_cipher(originalStr, keyword, False)
MsgBox newString, 0, "Viginère - verschlüsselt"  

newString = vigenere_cipher(newString, keyword, True)
MsgBox newString, 0, "Viginère - entschlüsselt"