Funciones para encriptar y desencriptar una cadena de texto
[Libro de ejemplo]
Las siguientes funciones sirven para encriptar (o cifrar) y desencriptar (o descifrar) una cadena de texto en función de la clave facilitada.
Cuanto más larga sea la clave, más difícil será descubrirla, aunque no tiene ningún sentido que su longitud sea mayor que la del texto a encriptar.
La complejidad de la clave está determinada tanto por su longitud como por lo variada que sea. Por ejemplo, la clave “AAAAAAA” sería tan sencilla de descubir como “A” Esta es la función para encriptar:
Public Function Encriptar(texto As String, clave As String) As String If Len(texto) = 0 Or Len(clave) = 0 Then Encriptar = "Error en la función Encriptar." …ver más…

De esta forma, no sólo es necesario conocer la clave para descifrar el criptograma (el texto cifrado), sino también su modificador, que al poder ser un número entre 0 y 32.767 añade alguna complicación a la hora de intentar descifrarlo si no se le conoce. El código de la función para cifrar es: Public Function EncriptarU(texto As String, clave As String, Optional lModificador As Long) As String 'Sintaxis: =EncriptarU(texto a encriptar, clave, modificador), donde modificador es un parámetro opcional, _ que, de usarse, ha de ser un número entero >0 y 32767 Then EncriptarU = "El modificador no puede ser 32767" Exit Function End If If Len(texto) = 0 Or Len(clave) = 0 Then EncriptarU = "Error en la función EncriptarU." Exit Function End If Dim posT As Integer, posC As Integer posC = 1 For posT = 1 To Len(texto) EncriptarU = EncriptarU + ChrW(IIf(AscW(Mid(texto, posT, 1)) + AscW(Mid(clave, posC, 1)) + lModificador > 32767, AscW(Mid(texto, posT, 1)) + AscW(Mid(clave, posC, 1)) + lModificador - 32767, AscW(Mid(texto, posT, 1)) + AscW(Mid(clave, posC, 1)) + lModificador)) posC = IIf(posC = Len(clave), 1, posC + 1)