求Excel宏自定义函数：解密AES-256加密的字符串列

你提供的测试代码仅包含AES框架结构，核心解密逻辑未实现，导致无法正常运行。以下是基于Windows CryptoAPI实现的可直接使用的AES-256解密方案，支持十六进制格式密文，可作为自定义函数在单元格调用，也支持批量解密整列数据。

' Windows CryptoAPI 声明
Private Declare PtrSafe Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
    (ByRef hProv As LongPtr, ByVal pszContainer As String, ByVal pszProvider As String, _
    ByVal dwProvType As Long, ByVal dwFlags As Long) As Boolean

Private Declare PtrSafe Function CryptReleaseContext Lib "advapi32.dll" _
    (ByVal hProv As LongPtr, ByVal dwFlags As Long) As Boolean

Private Declare PtrSafe Function CryptCreateHash Lib "advapi32.dll" _
    (ByVal hProv As LongPtr, ByVal Algid As Long, ByVal hKey As LongPtr, ByVal dwFlags As Long, _
    ByRef hHash As LongPtr) As Boolean

Private Declare PtrSafe Function CryptHashData Lib "advapi32.dll" _
    (ByVal hHash As LongPtr, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Boolean

Private Declare PtrSafe Function CryptDeriveKey Lib "advapi32.dll" _
    (ByVal hProv As LongPtr, ByVal Algid As Long, ByVal hHash As LongPtr, ByVal dwFlags As Long, _
    ByRef hKey As LongPtr) As Boolean

Private Declare PtrSafe Function CryptDestroyHash Lib "advapi32.dll" _
    (ByVal hHash As LongPtr) As Boolean

Private Declare PtrSafe Function CryptDecrypt Lib "advapi32.dll" _
    (ByVal hKey As LongPtr, ByVal hHash As LongPtr, ByVal Final As Boolean, ByVal dwFlags As Long, _
    ByVal pbData As Byte, ByRef pdwDataLen As Long) As Boolean

Private Declare PtrSafe Function CryptDestroyKey Lib "advapi32.dll" _
    (ByVal hKey As LongPtr) As Boolean

' 常量定义
Const PROV_RSA_AES = 24
Const CALG_AES_256 = &H6610
Const CRYPT_VERIFYCONTEXT = &HF0000000

' 十六进制字符串转字节数组
Private Function HexToBytes(hexStr As String) As Byte()
    Dim bytes() As Byte
    Dim i As Integer
    ReDim bytes(Len(hexStr) \ 2 - 1)
    
    For i = 0 To UBound(bytes)
        bytes(i) = CByte("&H" & Mid(hexStr, i * 2 + 1, 2))
    Next i
    
    HexToBytes = bytes
End Function

' 字节数组转UTF-8字符串
Private Function BytesToString(bytes() As Byte) As String
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    
    objStream.Type = 1 ' 二进制模式
    objStream.Open
    objStream.Write bytes
    objStream.Position = 0
    objStream.Type = 2 ' 文本模式
    objStream.Charset = "UTF-8"
    
    BytesToString = objStream.ReadText
    objStream.Close
End Function

' AES-256解密自定义函数（密文为十六进制字符串，密钥为明文）
Function AES256Decrypt(cipherHex As String, key As String) As String
    Dim hProv As LongPtr
    Dim hHash As LongPtr
    Dim hKey As LongPtr
    Dim cipherBytes() As Byte
    Dim decryptedLen As Long
    Dim decryptedBytes() As Byte
    
    ' 初始化加密上下文
    If Not CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) Then
        AES256Decrypt = "上下文初始化失败"
        Exit Function
    End If
    
    ' 创建哈希对象
    If Not CryptCreateHash(hProv, CALG_AES_256, 0, 0, hHash) Then
        AES256Decrypt = "哈希创建失败"
        CryptReleaseContext hProv, 0
        Exit Function
    End If
    
    ' 哈希密钥
    If Not CryptHashData(hHash, key, Len(key), 0) Then
        AES256Decrypt = "密钥哈希失败"
        CryptDestroyHash hHash
        CryptReleaseContext hProv, 0
        Exit Function
    End If
    
    ' 派生AES-256密钥
    If Not CryptDeriveKey(hProv, CALG_AES_256, hHash, 0, hKey) Then
        AES256Decrypt = "密钥派生失败"
        CryptDestroyHash hHash
        CryptReleaseContext hProv, 0
        Exit Function
    End If
    
    ' 将十六进制密文转为字节数组
    cipherBytes = HexToBytes(cipherHex)
    decryptedLen = UBound(cipherBytes) + 1
    ReDim decryptedBytes(decryptedLen - 1)
    decryptedBytes = cipherBytes
    
    ' 执行解密
    If Not CryptDecrypt(hKey, 0, True, 0, decryptedBytes(0), decryptedLen) Then
        AES256Decrypt = "解密失败"
        CryptDestroyKey hKey
        CryptDestroyHash hHash
        CryptReleaseContext hProv, 0
        Exit Function
    End If
    
    ' 调整字节数组长度（移除填充）
    ReDim Preserve decryptedBytes(decryptedLen - 1)
    
    ' 转为UTF-8字符串
    AES256Decrypt = BytesToString(decryptedBytes)
    
    ' 清理资源
    CryptDestroyKey hKey
    CryptDestroyHash hHash
    CryptReleaseContext hProv, 0
End Function

' 批量解密指定列（示例：解密A列，结果写入B列）
Sub BatchDecryptColumn()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim key As String
    
    ' 设置工作表和密钥
    Set ws = ActiveSheet
    key = "你的256位密钥明文" ' 替换为实际密钥
    
    ' 获取列的最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 批量解密
    For i = 1 To lastRow
        If ws.Cells(i, "A").Value <> "" Then
            ws.Cells(i, "B").Value = AES256Decrypt(ws.Cells(i, "A").Value, key)
        End If
    Next i
End Sub

使用说明 #

• 单元格函数调用：在目标单元格输入公式=AES256Decrypt(加密单元格地址, "你的密钥")，例如=AES256Decrypt(A1, "MySecureKey32BytesLength")，即可直接解密对应单元格的密文。
• 批量解密整列：修改BatchDecryptColumn宏中的密钥和列标识（如将"A"改为目标加密列，"B"改为结果列），运行宏即可批量处理整列数据。

注意事项 #

• 密文需为十六进制字符串格式，若你的密文是Base64格式，需额外添加Base64转字节数组的转换函数。
• 密钥需满足AES-256要求：明文密钥长度建议为32字节，代码会自动通过哈希派生为标准32字节密钥。
• 代码依赖Windows CryptoAPI，仅支持Windows系统下的Excel版本。

内容的提问来源于stack exchange，提问作者Ying Hui