Ya puse una entrada con un script en python para cifrar y descifrar utilizando el cifrado de Polibio.
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.
El código es el siguiente:
' 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:
Comentarios
Publicar un comentario