Encriptación y desencriptación de cadenas en Excel

Question

Estoy interesado si es posible realizar cifrado/descifrado de cadenas con Excel Visual Basic y algún proveedor de servicios criptográficos.

He encontrado un tutorial Encrypting and Decrypting Strings in Visual Basic, pero parece que es válido solo para Visual Basic.

¿Me sugerirías otro método de cifrado o mostrarías cómo se podría adoptar el tutorial para Excel Visual Basic?

Answer 1

El enlace que proporciona muestra cómo realizar el cifrado y descifrado de cadenas utilizando VB.NET y, por lo tanto, utilizando .NET Framework.

Actualmente, los productos de Microsoft Office no pueden usar el componente Visual Studio Tools for Applications que permitirá a los productos de Office acceder al BCL del .NET Framework (bibliotecas de clases base) que, a su vez, acceden al Windows CSP subyacente (proveedor de servidores criptográficos) y proporcionan un buen envoltorio alrededor de esas funciones de cifrado/descifrado. Por el momento, los productos de Office tienen el viejo VBA (Visual Basic for Applications) que se basa en las antiguas versiones de 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 tendrá que "rodar por su cuenta" el método de cifrado en código VB6/VBA puro, aunque esto es probable que sea menos seguro. Todo depende de cuán "seguro" quieras que sea tu cifrado.

Si desea "roll-su propia" rutina de cifrado/descifrado básica de cuerdas, echar un vistazo a este link para que pueda empezar:

Encrypt a String Easily
Better XOR Encryption with a readable string
vb6 - encryption function
Visual Basic 6/VBA String Encryption/Decryption Function

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 lograr esto:

How to encrypt a string in Visual Basic 6.0
Access to CryptEncrypt (CryptoAPI/WinAPI) functions in VBA

Ese último eslabón probable es el que usted querrá e incluye un módulo completo de VBA clase de "envolver" las funciones de Windows CSP.

Answer 2

Crear 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 usted puede utilizarlo en su código:

de cifrado

---

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 descipher

---

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 

Answer 3

Aquí está un ejemplo de encriptación/desencriptación simétrica básica:

Sub testit() 
    Dim inputStr As String 
    inputStr = "Hello world!" 

    Dim enctrypted As String, decrypted As String 
    encrypted = scramble(inputStr) 
    decrypted = scramble(encrypted) 
    Debug.Print encrypted 
    Debug.Print decrypted 
End Sub 


Function stringToByteArray(str As String) As Variant 
    Dim bytes() As Byte 
    bytes = str 
    stringToByteArray = bytes 
End Function 

Function byteArrayToString(bytes() As Byte) As String 
    Dim str As String 
    str = bytes 
    byteArrayToString = str 
End Function 


Function scramble(str As String) As String 
    Const SECRET_PASSWORD As String = "K*4HD%f#nwS%sdf032#gfl!HLKN*pq7" 

    Dim stringBytes() As Byte, passwordBytes() As Byte 
    stringBytes = stringToByteArray(str) 
    passwordBytes = stringToByteArray(SECRET_PASSWORD) 

    Dim upperLim As Long 
    upperLim = UBound(stringBytes) 
    ReDim scrambledBytes(0 To upperLim) As Byte 
    Dim idx As Long 
    For idx = LBound(stringBytes) To upperLim 
     scrambledBytes(idx) = stringBytes(idx) Xor passwordBytes(idx) 
    Next idx 
    scramble = byteArrayToString(scrambledBytes) 
End Function 

Tenga en cuenta que este se bloqueará si su cadena de entrada es más larga que la SECRET_PASSWORD . Este es solo un ejemplo para comenzar.

Answer 4

Puede llamar a los datos de celda de pipe excel a través de cualquier script de shell. Instale la interfaz de lenguaje R de GPL Bert (http://bert-toolkit.com/) para Excel. Utilice la secuencia de comandos R a continuación en Excel para canalizar datos de celda a Bash/perl/gpg/openssl.

c:\> cat c:\R322\callable_from_excel.R 
    CRYPTIT <- function(PLAINTEXT, MASTER_PASS) { 
    system(
     sprintf("bash -c 'echo '%s' | 
     gpg --symmetric --cipher-algo blowfish --force-mdc --passphrase '%s' -q | 
     base64 -w 0'", 
     PLAINTEXT, MASTER_PASS), 
     intern=TRUE) 
    } 

DECRYPTIT <- function(CRYPTTEXT, MASTER_PASS) { 
    system(
     sprintf("bash -c 'echo '%s'| 
     base64 -d | 
     gpg --passphrase '%s' -q | 
     putclip | getclip' ",CRYPTTEXT,MASTER_PASS), 
     intern=TRUE) 
    } 

En Excel, puede intentar: C1 = CryptIt (A1, A2) y C2 = DECRYPTIT (C1, A2) Opcional: putclip ahorra texto descifrado en el portapapeles. Ambos tipos de funciones son: Cadena -> Cadena. Advertencias habituales sobre el escape de comillas simples en cadenas entre comillas simples.

Answer 5

Este código funciona bien para mí (3DES cifrado/descifrado):

almaceno initialization_vector y TRIPLE_DES_KEY como variables de entorno (obviamente valores diferentes a los publicados aquí) y hacer que el uso de la función de VBA Environ(), por lo que todos los datos confidenciales (contraseñas) en 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 

El código fuente tomada de aquí: https://gist.github.com/motoraku/97ad730891e59159d86c

Nota la diferencia entre el código original y mi código, que es adicional opción encryption_object.Padding = 3 que obliga a VBA no realizar el relleno. Con la opción de relleno establecida en 3 obtengo el resultado exactamente como en la implementación C++ del algoritmo DES_ede3_cbc_encrypt y que está de acuerdo con lo que se produce con este online tool.