vba 在 Excel 中加密和解密字符串

Encrypting and decrypting strings in Excel

提问by Alexander Prokofyev

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

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

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

我在 Visual Basic 中找到了加密和解密字符串的演练，但它似乎仅对独立的 Visual Basic 有效。

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

那么您会建议我使用另一种加密方法还是展示如何在 Excel Visual Basic 中采用演练？

回答by CraigTP

The link you provide shows how to perform string encryption and decryption using VB.NET, and thus, using the .NET Framework.

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

Currently, Microsoft Office products cannot yet use the Visual Studio Tools for Applicationscomponent which will enable Office products to access the .NET framework's BCL (base class libraries) which, in turn, access the underlying Windows CSP (cryptographic server provider) and provide a nice wrapper around those encryption/decryption functions.

目前，Microsoft Office 产品还不能使用Visual Studio Tools for Applications组件，该组件将使 Office 产品能够访问 .NET 框架的 BCL（基类库），后者又访问底层的 Windows CSP（加密服务器提供程序）并提供一个围绕这些加密/解密函数的好包装。

For the time being, Office products are stuck with the old VBA (Visual Basic for Applications) which is based on the old VB6 (and earlier) versions of visual Basic which are based upon COM, rather than the .NET Framework.

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

Because of all of this, you will either need to call out to the Win32 API to access the CSP functions, or you will have to "roll-your-own" encryption method in pure VB6/VBA code, although this is likely to be less secure. It all depends upon how "secure" you'd like your encryption to be.

因此，您要么需要调用 Win32 API 来访问 CSP 函数，要么必须在纯 VB6/VBA 代码中“推出自己的”加密方法，尽管这很可能是不太安全。这完全取决于您希望加密的“安全性”。

If you want to "roll-your-own" basic string encryption/decryption routine, take a look at these link to get you started:

如果您想“推出自己的”基本字符串加密/解密例程，请查看以下链接以开始使用：

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

使用可读字符串轻松加密字符串更好的 XOR 加密
vb6 - 加密函数
Visual Basic 6 / VBA 字符串加密/解密函数

If you want to access the Win32 API and use the underlying Windows CSP (a much more secure option), see these links for detailed information on how to achieve this:

如果您想访问 Win32 API 并使用底层的 Windows CSP（一个更安全的选项），请参阅这些链接以获取有关如何实现此目的的详细信息：

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

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

That last link is likely the one you'll want and includes a complete VBA Class module to "wrap" the Windows CSP functions.

最后一个链接可能是您想要的链接，它包含一个完整的 VBA 类模块来“包装”Windows CSP 函数。

回答by user3407604

Create a Class Module called clsCifrado:

创建一个名为 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

---

---

Now you can use it in your code:

现在你可以在你的代码中使用它：

to 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

---

---

To 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

回答by CodeKid

Here is a basic symmetric encryption/decryption example:

这是一个基本的对称加密/解密示例：

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

    Dim encrypted 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

Be aware that this will crash if your given input string is longer than the SECRET_PASSWORD. This is just an example to get started with.

请注意，如果您给定的输入字符串比 SECRET_PASSWORD 长，这将导致崩溃。这只是一个开始的例子。

回答by mosh

You can call pipe excel cell data through any shell script. Install the GPL Bert (http://bert-toolkit.com/) R language interface for Excel. Use the R script below in Excel to pipe cell data to Bash / perl / gpg / openssl.

您可以通过任何 shell 脚本调用管道 excel 单元格数据。为 Excel安装 GPL Bert ( http://bert-toolkit.com/) R 语言界面。在 Excel 中使用下面的 R 脚本将单元格数据通过管道传输到 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)  
  } 

In Excel, you can try: C1=CRYPTIT(A1,A2) and C2=DECRYPTIT(C1,A2) Optional: putclip saves decrypted text in clipboard. Both functions types are: String -> String. Usual caveats about escaping single-quotes in single-quoted strings.

在 Excel 中，您可以尝试： C1=CRYPTIT(A1,A2) 和 C2=DECRYPTIT(C1,A2) 可选：putclip 将解密的文本保存在剪贴板中。两种函数类型都是：String -> String。关于在单引号字符串中转义单引号的常见警告。

回答by user3579314

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

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

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

避免处理非“正常”字符。您在 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

回答by OGCJN

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

这段代码很适合我（3DES 加密/解密）：

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.

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

Option Explicit

Public Const INITIALIZATION_VECTOR = "zlrskd"  '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

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

Note the difference between the original code and my code, that is additional option encryption_object.Padding = 3which forces VBA to notperform 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.

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