web-dev-qa-db-fra.com

Cryptage et décryptage de chaînes dans Excel

Je suis intéressé par le chiffrement/déchiffrement de chaînes à l'aide d'Excel Visual Basic et de certains fournisseurs de services cryptographiques.

J'ai trouvé une procédure pas à pas Cryptage et décryptage de chaînes dans Visual Basic , mais il semble que cela ne soit valable que pour Visual Basic autonome.

Alors, suggérez-vous une autre méthode de cryptage ou montrez-moi comment la procédure pas à pas pourrait être adoptée pour Excel Visual Basic?

excel-vbaencryptionstringvbaexcel
12
Alexander Prokofyev

Le lien que vous indiquez montre comment effectuer le cryptage et le décryptage de chaînes à l'aide de VB.NET, et donc, à l'aide de .NET Framework.

Actuellement, les produits Microsoft Office ne peuvent pas encore utiliser le composant Visual Studio Tools pour Applications qui permettra aux produits Office d'accéder aux BCL (bibliothèques de classes de base) du framework .NET, qui à leur tour accèdent au CSP Windows (fournisseur de serveur cryptographique) sous-jacent. ) et fournit un wrapper Nice autour de ces fonctions de cryptage/décryptage.

Pour le moment, les produits Office sont bloqués avec l’ancien VBA ( Visual Basic pour Applications ) qui est basé sur les anciennes versions VB6 (et antérieures) de Visual Basic qui reposent sur COM plutôt que sur le .NET Framework. .

Pour toutes ces raisons, vous devrez soit appeler l'API Win32 pour accéder aux fonctions CSP, soit utiliser une méthode de cryptage "roulez vous-même" en code VB6/VBA pur, bien qu'il s'agisse probablement Moins sécurisé. Tout dépend de la "sécurité" de votre cryptage.

Si vous souhaitez mettre en place une routine de cryptage/décryptage de chaîne de base, jetez un coup d’œil à ce lien pour vous aider à démarrer:

Crypter une chaîne facilement
Mieux XOR Chiffrement avec une chaîne lisible
vb6 - fonction de cryptage
Visual Basic 6/Fonction de cryptage/décryptage de chaînes VBA

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 procédure à suivre:

Comment chiffrer une chaîne dans Visual Basic 6.0
Accès aux fonctions CryptEncrypt (CryptoAPI/WinAPI) dans VBA

Ce dernier lien est probablement celui que vous voudrez et comprend un module complet de classe VBA pour "boucler" les fonctions Windows CSP.

22
CraigTP

Créez 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:

chiffrer

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

À déchiffrer

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
3
user3407604

Vous pouvez appeler des données de cellule Excel de canal par le biais de n’importe quel script Shell. Installez l’interface de langage GPL Bert ( http://bert-toolkit.com/ ) R pour Excel. R script ci-dessous dans Excel pour diriger les données de 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) Facultatif: putclip enregistre le texte déchiffré dans le Presse-papiers. Les deux types de fonctions sont les suivants: Chaîne - > Chaîne. Mises en garde habituelles concernant l'échappement de guillemets simples dans des chaînes entre guillemets simples.

1
mosh

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

Je stocke INITIALIZATION_VECTOR et TRIPLE_DES_KEY sous forme de variables d'environnement (évidemment différentes de celles publiées ici) et les récupère à l'aide de la fonction VBA Environ (), de sorte que toutes les données sensibles (mots de passe) en 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 tiré d'ici: https://Gist.github.com/motoraku/97ad730891e59159d86c

Notez la différence entre le code d'origine et mon code, c'est l'option supplémentaire encryption_object.Padding = 3 qui force VBA à pas effectuer un remplissage. Avec l'option de remplissage définie sur 3, j'obtiens le résultat exactement comme dans l'implémentation C++ de l'algorithme DES_ede3_cbc_encrypt et qui est en accord avec ce qui est produit par cet outil en ligne . 

0
OGCJN

Voici un exemple de base de chiffrement/déchiffrement symétrique:

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

Sachez que cela plantera si votre chaîne d'entrée est plus longue que SECRET_PASSWORD. Ceci est juste un exemple pour commencer.

0
CodeKid

Ce code fonctionne bien dans VBA et peut facilement être déplacé vers VB.NET

Evite de traiter avec des personnages pas "normaux". Vous décidez dans AllowedChars quels caractères autoriser.

Public Function CleanEncryptSTR(MyString As String, MyPassword As String, Encrypt As Boolean) As String
'Encrypts strings chars contained in Allowedchars
'MyString = String to decrypt
'MyPassword = Password
'Encrypt True: Encrypy   False: Decrypt
    Dim i As Integer
    Dim ASCToAdd As Integer
    Dim ThisChar As String
    Dim ThisASC As Integer
    Dim NewASC As Integer
    Dim MyStringEncrypted As String
    Dim AllowedChars As String

    AllowedChars = "&0123456789;ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

    If Len(MyPassword) > 0 Then
        For i = 1 To Len(MyString)
'            ThisASC = Asc(Mid(MyString, i, 1))
'            ThisASC = IntFromArray(Asc(Mid(MyString, i, 1)), MyVector())

            ThisChar = Mid(MyString, i, 1)
            ThisASC = InStr(AllowedChars, ThisChar)

            If ThisASC > 0 Then
                ASCToAdd = Asc(Mid(MyPassword, i Mod Len(MyPassword) + 1, 1))
                If Encrypt Then
                    NewASC = ThisASC + ASCToAdd
                Else
                    NewASC = ThisASC - ASCToAdd
                End If
                NewASC = NewASC Mod Len(AllowedChars)
                If NewASC <= 0 Then
                    NewASC = NewASC + Len(AllowedChars)
                End If

                MyStringEncrypted = MyStringEncrypted & Mid(AllowedChars, NewASC, 1)
            Else
                MyStringEncrypted = MyStringEncrypted & ThisChar
            End If
        Next i
    Else
        MyStringEncrypted = MyString
    End If

    CleanEncryptSTR = MyStringEncrypted

End Function
0
user3579314