string encryption/decryption

Question

I am interested if it's possible to do string encryption/decryption using Excel Visual Basic and some cryptographic service provider.

I have found a walk-through Encrypting and Decrypting Strings in Visual Basic, but it seems it's valid for standalone Visual Basic only.

So would you suggest me another encryption method or show how the walk-through could be adopted for Excel Visual Basic?

Answer 1

This code works well for me (3DES Encryption/Decryption):

I store INITIALIZATION_VECTOR and TRIPLE_DES_KEY as environment variables (obviously different values than those posted here) and get them using VBA Environ() function, so all sensitive data (passwords) in VBA code is encrypted.

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

Source code taken from here: https://gist.github.com/motoraku/97ad730891e59159d86c

Note the difference between the original code and my code, that is additional option encryption_object.Padding = 3 which forces VBA to not perform padding. With padding option set to 3 I get result exactly as in C++ implementation of DES_ede3_cbc_encrypt algorithm and which is in agreement with what is produced by this online tool.

Answer 2

This code works fine in VBA and can easily be moved to VB.NET

Avoids dealing with not "normal" characters. You decide in AllowedChars what characters to allow.

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