Saltar al contenido

string cifrado / descifrado

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ácilmente
Mejor cifrado XOR con un legible string

vb6 – función de cifrado
Funció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.

¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)



Utiliza Nuestro Buscador

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *