Criptografía (CCLXV): Cifrado de Polibio en Excel

Y ahora, en este post incluyo el cifrado y descifrado utilizando este mismo criptosistema en Excel. 

Antes de poner el correspondiente código Visual Basic para aplicaciones (VBA), recordar que este cifrado se basa en una tabla de 5 filas y 5 columnas cuyas celdas se completan con las letras del alfabeto (la "I" y la "J" comparten celda, y "Ñ" excluida).

Para cifrar se sustituía cada carácter del texto en claro por el dígito de la fila y el dígito de la columna en cuya intersección se encontraba éste.

' CIFRADO DE POLIBIO:
'' Cifra y descifra textos en claro y criptogramas, respectivamente,
' utilizando el cifrado de Polibio.
'' http://mikelgarcialarragan.blogspot.com/

Option Explicit
Public TEXTO_CLARO As Range
Public CRIPTOGRAMA As Range
Public Sub Cifrar()
    Dim Caracter As Integer

    Range("TEXTO_CLARO").Value = Replace(Range("TEXTO_CLARO").Value, "j", "i")
    Range("TEXTO_CLARO").Value = Replace(Range("TEXTO_CLARO").Value, "J", "I")
    Range("TEXTO_CLARO").Value = Replace(Range("TEXTO_CLARO").Value, "ñ", "n")
    Range("TEXTO_CLARO").Value = Replace(Range("TEXTO_CLARO").Value, "Ñ", "N")
    Range("TEXTO_CLARO").Value = A_Z(UCase(Replace(Range("TEXTO_CLARO").Value, "", "")))
    
    If Len(Range("TEXTO_CLARO").Value) = 0 Then
        MsgBox "Introduzca el texto en claro a cifrar. Sólo caracteres alfabéticos [A-Z], 'Ñ' excluida.", vbOKOnly + vbCritical, "¡Error!"
    Else
        Range("CRIPTOGRAMA").Value = ""
        For Caracter = 1 To Len(Range("TEXTO_CLARO").Value)
            If Asc(Mid(Range("TEXTO_CLARO").Value, Caracter, 1)) < 74 Then
                Range("CRIPTOGRAMA").Value = Range("CRIPTOGRAMA").Value & (Asc(Mid(Range("TEXTO_CLARO").Value, Caracter, 1)) - 65) \ 5 + 1 & (Asc(Mid(Range("TEXTO_CLARO").Value, Caracter, 1)) - 65) Mod 5 + 1
            Else
                Range("CRIPTOGRAMA").Value = Range("CRIPTOGRAMA").Value & (Asc(Mid(Range("TEXTO_CLARO").Value, Caracter, 1)) - 66) \ 5 + 1 & (Asc(Mid(Range("TEXTO_CLARO").Value, Caracter, 1)) - 66) Mod 5 + 1
            End If
        Next
    End If

End Sub
Public Sub Descifrar()
    Dim Caracter As Integer

    Range("CRIPTOGRAMA").Value = D1_9(Replace(Range("CRIPTOGRAMA").Value, "", ""))
    
    If Len(Range("CRIPTOGRAMA").Value) = 0 Then
        MsgBox "Introduzca el criptograma a descifrar. Sólo dígitos del 1 al 5.", vbOKOnly + vbCritical, "¡Error!"
    Else
        If Len(Range("CRIPTOGRAMA").Value) Mod 2 <> 0 Then
            MsgBox "El criptograma debe tener un número par de dígitos.", vbOKOnly + vbCritical, "¡Error!"
        Else
            Range("TEXTO_CLARO").Value = ""
            For Caracter = 1 To Len(Range("CRIPTOGRAMA").Value) Step 2
                If Mid(Range("CRIPTOGRAMA").Value, Caracter, 1) & Mid(Range("CRIPTOGRAMA").Value, Caracter + 1, 1) < 25 Then
                    Range("TEXTO_CLARO").Value = Range("TEXTO_CLARO").Value & Chr((Mid(Range("CRIPTOGRAMA").Value, Caracter, 1) - 1) * 5 + (Mid(Range("CRIPTOGRAMA").Value, Caracter + 1, 1) - 1) Mod 5 + 65)
                Else
                    Range("TEXTO_CLARO").Value = Range("TEXTO_CLARO").Value & Chr((Mid(Range("CRIPTOGRAMA").Value, Caracter, 1) - 1) * 5 + (Mid(Range("CRIPTOGRAMA").Value, Caracter + 1, 1) - 1) Mod 5 + 66)
                End If
            Next
        End If
    End If

End Sub
Function A_Z(Cadena As String) As String
    Dim Caracter As Integer

    For Caracter = 1 To Len(Cadena)
        Select Case Asc(Mid(Cadena, Caracter, 1))
            Case 65 To 90:
                A_Z = A_Z & Mid(Cadena, Caracter, 1)
        End Select
    Next

End Function
Function D1_9(Cadena As String) As String
    Dim Caracter As Integer

    For Caracter = 1 To Len(Cadena)
        Select Case Asc(Mid(Cadena, Caracter, 1))
            Case 49 To 53:
                D1_9 = D1_9 & Mid(Cadena, Caracter, 1)
        End Select
    Next

End Function

Ejemplo de funcionamiento:

- Cifrar:

- Descifrar:

Quizás también te interese: