Cryptage et décryptage des chaînes dans Excel

Question

Je suis intéressé s'il est possible de faire du cryptage/décryptage de chaîne en utilisant Excel Visual Basic et un fournisseur de services de cryptographie.

J'ai trouvé une procédure pas à pas Encrypting and Decrypting Strings in Visual Basic, mais il semble qu'elle soit valide uniquement pour Visual Basic autonome.

Alors, pourriez-vous me suggérer une autre méthode de chiffrement ou montrer comment la procédure pas à pas pourrait être adoptée pour Excel Visual Basic?

Answer 1

Le lien que vous fournissez montre comment effectuer le cryptage et le décryptage des chaînes à l'aide de VB.NET et, par conséquent, à l'aide de .NET Framework. Actuellement, les produits Microsoft Office ne peuvent pas encore utiliser le composant Visual Studio Tools for Applications qui permettra aux produits Office d'accéder aux BCL du framework .NET (bibliothèques de classes de base) qui, à leur tour, accèdent au fournisseur CSP Windows (fournisseur de serveur cryptographique) sous-jacent et fournissent un bonne enveloppe autour de ces fonctions de cryptage/décryptage.

Pour le moment, les produits Office sont coincés avec l'ancien VBA (Visual Basic for Applications) qui est basé sur l'ancien VB6 (et versions antérieures) versions de Visual Basic qui sont basés sur COM, plutôt que le .NET Framework. Pour cette raison, vous devrez soit appeler l'API Win32 pour accéder aux fonctions CSP, soit utiliser la méthode de chiffrement "roll-your-own" dans le code VB6/VBA pur, bien que est susceptible d'être moins sécurisé. Tout dépend de la sécurité de votre cryptage.

Si vous voulez "à rouler propre" chiffrement chaîne de base/routine de décryptage, jetez un oeil à ce lien pour commencer:

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

Si vous souhaitez accéder à l'API Win32 et utiliser le CSP Windows sous-jacent (une option beaucoup plus sécurisée), consultez ces liens pour obtenir des informations détaillées sur la manière d'y parvenir:

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

Ce dernier lien est probablement celui que vous aurez envie et comprend un module complet de classe VBA pour « envelopper » les fonctions Windows CSP.

Answer 2

Créer un module de classe appelé 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 

---

Maintenant, vous pouvez l'utiliser dans votre code:

à Cipher

---

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 

---

Pour 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

Voici un exemple de chiffrement/déchiffrement symetric de base:

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 

Soyez conscient que cela se bloque si votre chaîne d'entrée donnée est plus longue que la SECRET_PASSWORD . Ceci est juste un exemple pour commencer.

Answer 4

Vous pouvez appeler les données de la cellule Excel à l'aide de n'importe quel script shell. Installez l'interface de langage R GPL Bert() pour Excel. Utilisez le script R ci-dessous dans Excel pour acheminer les données de la cellule vers 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) 
    } 

Dans Excel, vous pouvez essayer: C1 = CryptIt (A1, A2) et C2 = DECRYPTIT (C1, A2) En option: putclip enregistre les messages texte déchiffré dans le presse papier. Les deux types de fonctions sont: Chaîne -> Chaîne. Mise en garde habituelle sur l'échappement des guillemets simples dans les chaînes à guillemets simples.

Answer 5

Ce code fonctionne bien pour moi (3DES/Decryption):

je stocke INITIALIZATION_VECTOR et TRIPLE_DES_KEY comme variables d'environnement (évidemment des valeurs différentes que celles affichées ici) et obtenir les utiliser VBA fonction Environ(), donc toutes les données sensibles (mots de passe) dans le code VBA sont cryptées.

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 

code source provenant ici: https://gist.github.com/motoraku/97ad730891e59159d86c

Notez la différence entre le code d'origine et mon code, qui est autre option encryption_object.Padding = 3 qui oblige VBA à pas effectuer un rembourrage. Avec l'option padding réglée à 3, j'obtiens le résultat exactement comme dans l'implémentation en C++ de l'algorithme DES_ede3_cbc_encrypt et qui est en accord avec ce qui est produit par ce online tool.