Task: Vigenère cipher








VB: Option Explicit

Sub test()
Dim Encryp As String
   Encryp = Vigenere("Beware the Jabberwock, my son! The jaws that bite, the claws that catch!", "vigenerecipher", True)
   Debug.Print "Encrypt:= """ & Encryp & """"
   Debug.Print "Decrypt:= """ & Vigenere(Encryp, "vigenerecipher", False) & """"
End Sub

Private Function Vigenere(sWord As String, sKey As String, Enc As Boolean) As String
Dim bw() As Byte, bk() As Byte, i As Long, c As Long
Const sW As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝ"
Const sWo As String = "AAAAACEEEEIIIINOOOOOUUUUY"
Const A As Long = 65
Const N As Long = 26

   c = Len(sKey)
   i = Len(sWord)
   sKey = Left(IIf(c < i, StrRept(sKey, (i / c) + 1), sKey), i)
   sKey = StrConv(sKey, vbUpperCase)         
   sWord = StrConv(sWord, vbUpperCase)
   sKey = StrReplace(sKey, sW, sWo)          
   sWord = StrReplace(sWord, sW, sWo)
   sKey = RemoveChars(sKey)                  
   sWord = RemoveChars(sWord)
   bk = CharToAscii(sKey)                     
   bw = CharToAscii(sWord)
   For i = LBound(bw) To UBound(bw)
      Vigenere = Vigenere & Chr((IIf(Enc, ((bw(i) - A) + (bk(i) - A)), ((bw(i) - A) - (bk(i) - A)) + N) Mod N) + A)
   Next i
End Function

Private Function StrRept(s As String, N As Long) As String
Dim j As Long, c As String
   For j = 1 To N
      c = c & s
   Next
   StrRept = c
End Function

Private Function StrReplace(s As String, What As String, By As String) As String
Dim t() As String, u() As String, i As Long
   t = SplitString(What)
   u = SplitString(By)
   StrReplace = s
   For i = LBound(t) To UBound(t)
      StrReplace = Replace(StrReplace, t(i), u(i))
   Next i
End Function

Private Function SplitString(s As String) As String()
   SplitString = Split(StrConv(s, vbUnicode), Chr(0))
End Function

Private Function RemoveChars(str As String) As String
Dim b() As Byte, i As Long
   b = CharToAscii(str)
   For i = LBound(b) To UBound(b)
      If b(i) >= 65 And b(i) <= 90 Then RemoveChars = RemoveChars & Chr(b(i))
   Next i
End Function

Private Function CharToAscii(s As String) As Byte()
   CharToAscii = StrConv(s, vbFromUnicode)
End Function



Fortran: program vigenere_cipher
  implicit none
  
  character(80) :: plaintext = "Beware the Jabberwock, my son
                   ciphertext = ""
  character(14) :: key = "VIGENERECIPHER"


  call encrypt(plaintext, ciphertext, key)
  write(*,*) plaintext
  write(*,*) ciphertext
  call decrypt(ciphertext, plaintext, key)
  write(*,*) plaintext

contains

subroutine encrypt(intxt, outtxt, k)
  character(*), intent(in)  :: intxt, k
  character(*), intent(out) :: outtxt
  integer :: chrn
  integer :: cp = 1, kp = 1
  integer :: i
  
  outtxt = ""
  do i = 1, len(trim(intxt))
    select case(intxt(i:i))
      case ("A":"Z", "a":"z")
        select case(intxt(i:i))
          case("a":"z")
            chrn = iachar(intxt(i:i)) - 32
   
          case default
            chrn = iachar(intxt(i:i))
                         
        end select
     
        outtxt(cp:cp) = achar(modulo(chrn + iachar(k(kp:kp)), 26) + 65)
        cp = cp + 1
        kp = kp + 1
        if(kp > len(k)) kp = kp - len(k)
 
    end select
  end do
end subroutine

subroutine decrypt(intxt, outtxt, k)
  character(*), intent(in)  :: intxt, k
  character(*), intent(out) :: outtxt
  integer :: chrn
  integer :: cp = 1, kp = 1
  integer :: i
  
  outtxt = ""
  do i = 1, len(trim(intxt))
    chrn = iachar(intxt(i:i))
    outtxt(cp:cp) = achar(modulo(chrn - iachar(k(kp:kp)), 26) + 65)
    cp = cp + 1
    kp = kp + 1
    if(kp > len(k)) kp = kp - len(k)
   end do
end subroutine
end program