在Excel中加密和解密字符串

Question

我很感兴趣,如果可以使用Excel Visual Basic和一些加密服务提供程序进行字符串加密/解密.

我在Visual Basic中找到了一个演练加密和解密字符串,但它似乎只适用于独立的Visual Basic.

那么你会建议我另一种加密方法或展示如何为Excel Visual Basic采用演练吗？

Answer 1

您提供的链接显示了如何使用VB.NET执行字符串加密和解密,从而使用.NET Framework.

目前,Microsoft Office产品尚不能使用Visual Studio Tools for Applications组件,这将使Office产品能够访问.NET框架的BCL(基类库),而BCL又访问底层Windows CSP(加密服务器提供程序)并提供围绕这些加密/解密功能的好包装.

目前,Office产品仍然使用旧的VBA(Visual Basic for Applications),它基于Visual Basic的旧VB6(及更早版本)版本,它们基于COM,而不是.NET Framework.

因为所有这些,你需要调用Win32 API来访问CSP函数,或者你必须在纯VB6/VBA代码中"自己动手"加密方法,尽管这很可能是不太安全.这完全取决于您对加密的"安全"程度.

如果您想"自己动手"基本字符串加密/解密例程,请查看这些链接以帮助您入门:

使用可读字符串加密字符串更容易更好的XOR加密
vb6 - 加密函数
Visual Basic 6/VBA字符串加密/解密功能

如果要访问Win32 API并使用基础Windows CSP(更安全的选项),请参阅以下链接以获取有关如何实现此目的的详细信息:

如何在Visual Basic 6.0中加密字符串在VBA中
访问CryptEncrypt(CryptoAPI/WinAPI)函数

最后一个链接可能是您想要的链接,并包含一个完整的VBA类模块来"包装"Windows CSP功能.

Answer 2

这段代码对我来说效果很好（3DES 加密/解密）：

我将 INITIALIZATION_VECTOR 和 TRIPLE_DES_KEY 存储为环境变量（显然与此处发布的值不同）并使用 VBA Environ() 函数获取它们，因此 VBA 代码中的所有敏感数据（密码）都被加密。

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

源代码取自此处： https: //gist.github.com/motoraku/97ad730891e59159d86c

请注意原始代码和我的代码之间的区别，即附加选项crypto_object.Padding = 3，它强制 VBA不执行填充。将填充选项设置为 3 时，我得到的结果与 DES_ede3_cbc_encrypt 算法的 C++ 实现完全相同，并且与此在线工具生成的结果一致。

Answer 3

该代码在 VBA 中运行良好，并且可以轻松移动到 VB.NET

避免处理非“正常”字符。您可以在AllowedChars 中决定允许哪些字符。

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