Este grupo de trabajo ha pasado mucho tiempo investigando la solución a tu búsqueda, te dejamos la respuestas de modo que esperamos serte de mucha ayuda.
Solución:
El enlace que proporciona muestra cómo realizar string cifrado y descifrado utilizando VB.NET y, por tanto, utilizando .NET Framework.
Actualmente, los productos de Microsoft Office aún no pueden utilizar el componente Visual Studio Tools for Applications, que permitirá que los productos de Office accedan a las BCL (bibliotecas de clase base) de .NET framework que, a su vez, acceden al CSP (proveedor de servidor criptográfico) subyacente de Windows y proporcionan un buen envoltorio alrededor de esas funciones de cifrado / descifrado.
Por el momento, los productos de Office están atascados con el antiguo VBA (Visual Basic para aplicaciones) que se basa en las versiones antiguas VB6 (y anteriores) de Visual Basic que se basan en COM, en lugar de .NET Framework.
Debido a todo esto, deberá llamar a la API de Win32 para acceder a las funciones de CSP, o deberá utilizar el método de cifrado “roll-your-own” en código VB6 / VBA puro, aunque es probable que sea menos seguro. Todo depende de cuán “seguro” le gustaría que fuera su cifrado.
Si quieres hacer tu propio “roll-your-own” básico string rutina de cifrado / descifrado, eche un vistazo a estos enlaces para comenzar:
Cifre una cadena fácilmenteMejor cifrado XOR con un legible string
vb6 – función de cifradoFunción de cifrado / descifrado de cadenas de Visual Basic 6 / VBA
Si desea acceder a la API de Win32 y utilizar el CSP de Windows subyacente (una opción mucho más segura), consulte estos enlaces para obtener información detallada sobre cómo lograrlo:
Cómo cifrar un string en Visual Basic 6.0
Acceso a las funciones de CryptEncrypt (CryptoAPI / WinAPI) en VBA
Es probable que ese último enlace sea el que desee e incluye un módulo de clase VBA completo para “envolver” las funciones de CSP de Windows.
Cree un módulo de clase llamado clsCifrado:
Option Explicit
Option Compare Binary
Private clsClave As String
Property Get Clave() As String
Clave = clsClave
End Property
Property Let Clave(value As String)
clsClave = value
End Property
Function Cifrar(Frase As String) As String
Dim Cachos() As Byte
Dim LaClave() As Byte
Dim i As Integer
Dim Largo As Integer
If Frase <> "" Then
Cachos() = StrConv(Frase, vbFromUnicode)
LaClave() = StrConv(clsClave, vbFromUnicode)
Largo = Len(clsClave)
For i = LBound(Cachos) To UBound(Cachos)
Cachos(i) = (Cachos(i) Xor LaClave(i Mod Largo)) + 34
Next i
Cifrar = StrConv(Cachos(), vbUnicode)
Else
Cifrar = ""
End If
End Function
Function Descifrar(Frase As String) As String
Dim Cachos() As Byte
Dim LaClave() As Byte
Dim i As Integer
Dim Largo As Integer
If Frase <> "" Then
Cachos() = StrConv(Frase, vbFromUnicode)
LaClave() = StrConv(clsClave, vbFromUnicode)
Largo = Len(clsClave)
For i = LBound(Cachos) To UBound(Cachos)
Cachos(i) = Cachos(i) - 34
Cachos(i) = (Cachos(i) Xor LaClave(i Mod Largo))
Next i
Descifrar = StrConv(Cachos(), vbUnicode)
Else
Descifrar = ""
End If
End Function
Ahora puedes usarlo en tu código:
cifrar
Private Sub btnCifrar_Click()
Dim Texto As String
Dim cCifrado As clsCifrado
Set cCifrado = New clsCifrado
'---poner la contraseña
If tbxClave.Text = "" Then
MsgBox "The Password is missing"
End Sub
Else
cCifrado.Clave = tbxClave.Text
End If
'---Sacar los datos
Texto = tbxFrase.Text
'---cifrar el texto
Texto = cCifrado.Cifrar(Texto)
tbxFrase.Text = Texto
End Sub
Para descifrar
Private Sub btnDescifrar_Click()
Dim Texto As String
Dim cCifrado As clsCifrado
Set cCifrado = New clsCifrado
'---poner la contraseña
If tbxClave.Text = "" Then
MsgBox "The Password is missing"
End Sub
Else
cCifrado.Clave = tbxClave.Text
End If
'---Sacar los datos
Texto = tbxFrase.Text
'---cifrar el texto
Texto = cCifrado.Descifrar(Texto)
tbxFrase.Text = Texto
End Sub
Este código funciona bien para mí (cifrado / descifrado 3DES):
Guardo INITIALIZATION_VECTOR y TRIPLE_DES_KEY como variables de entorno (obviamente valores diferentes a los publicados aquí) y los obtengo usando la función VBA Environ (), por lo que todos los datos confidenciales (contraseñas) en el código VBA están encriptados.
Option Explicit
Public Const INITIALIZATION_VECTOR = "zlrs$5kd" 'Always 8 characters
Public Const TRIPLE_DES_KEY = ">tlF8adk=35K{dsa" 'Always 16 characters
Sub TestEncrypt()
MsgBox "This is an encrypted string: -> " & EncryptStringTripleDES("This is an encrypted string:")
Debug.Print EncryptStringTripleDES("This is an encrypted string:")
End Sub
Sub TestDecrypt()
MsgBox "u99CVItCGiMQEVYHf8+S22QbJ5CPQGDXuS5n1jvEIgU= -> " & DecryptStringTripleDES("u99CVItCGiMQEVYHf8+S22QbJ5CPQGDXuS5n1jvEIgU=")
End Sub
Function EncryptStringTripleDES(plain_string As String) As Variant
Dim encryption_object As Object
Dim plain_byte_data() As Byte
Dim encrypted_byte_data() As Byte
Dim encrypted_base64_string As String
EncryptStringTripleDES = Null
On Error GoTo FunctionError
plain_byte_data = CreateObject("System.Text.UTF8Encoding").GetBytes_4(plain_string)
Set encryption_object = CreateObject("System.Security.Cryptography.TripleDESCryptoServiceProvider")
encryption_object.Padding = 3
encryption_object.key = CreateObject("System.Text.UTF8Encoding").GetBytes_4(TRIPLE_DES_KEY)
encryption_object.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(INITIALIZATION_VECTOR)
encrypted_byte_data = _
encryption_object.CreateEncryptor().TransformFinalBlock(plain_byte_data, 0, UBound(plain_byte_data) + 1)
encrypted_base64_string = BytesToBase64(encrypted_byte_data)
EncryptStringTripleDES = encrypted_base64_string
Exit Function
FunctionError:
MsgBox "TripleDES encryption failed"
End Function
Function DecryptStringTripleDES(encrypted_string As String) As Variant
Dim encryption_object As Object
Dim encrypted_byte_data() As Byte
Dim plain_byte_data() As Byte
Dim plain_string As String
DecryptStringTripleDES = Null
On Error GoTo FunctionError
encrypted_byte_data = Base64toBytes(encrypted_string)
Set encryption_object = CreateObject("System.Security.Cryptography.TripleDESCryptoServiceProvider")
encryption_object.Padding = 3
encryption_object.key = CreateObject("System.Text.UTF8Encoding").GetBytes_4(TRIPLE_DES_KEY)
encryption_object.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(INITIALIZATION_VECTOR)
plain_byte_data = encryption_object.CreateDecryptor().TransformFinalBlock(encrypted_byte_data, 0, UBound(encrypted_byte_data) + 1)
plain_string = CreateObject("System.Text.UTF8Encoding").GetString(plain_byte_data)
DecryptStringTripleDES = plain_string
Exit Function
FunctionError:
MsgBox "TripleDES decryption failed"
End Function
Function BytesToBase64(varBytes() As Byte) As String
With CreateObject("MSXML2.DomDocument").createElement("b64")
.DataType = "bin.base64"
.nodeTypedValue = varBytes
BytesToBase64 = Replace(.Text, vbLf, "")
End With
End Function
Function Base64toBytes(varStr As String) As Byte()
With CreateObject("MSXML2.DOMDocument").createElement("b64")
.DataType = "bin.base64"
.Text = varStr
Base64toBytes = .nodeTypedValue
End With
End Function
Código fuente tomado de aquí: https://gist.github.com/motoraku/97ad730891e59159d86c
Tenga en cuenta la diferencia entre el código original y mi código, esa es una opción adicional encryption_object.Padding = 3 lo que obliga a VBA a no realizar acolchado. Con la opción de relleno establecida en 3, obtengo el resultado exactamente como en la implementación de C ++ del algoritmo DES_ede3_cbc_encrypt y que está de acuerdo con lo que produce esta herramienta en línea.
Aquí puedes ver las reseñas y valoraciones de los usuarios
Si entiendes que te ha sido de utilidad este artículo, te agradeceríamos que lo compartas con otros desarrolladores así contrubuyes a extender esta información.