如何通过Excel VBA利用RSA-SHA1算法和私钥生成签名对接API？

我之前也碰到过一模一样的需求——VBA本身确实没有原生支持RSA-SHA1签名的功能，但我们可以借助Windows系统自带的CryptoAPI来实现，比纯VBA写哈希和签名代码效率更高、可靠性也更强。下面是具体的实现步骤和可直接复用的代码：

核心思路 #

我们的目标是完成这几个关键步骤：

• 安全读取本地存储的私钥文件（支持PFX/PKCS#12或转换后的PEM格式）
• 对API请求内容进行SHA1哈希计算
• 用私钥对哈希值进行RSA签名
• 将签名结果转换成API要求的格式（比如Base64或十六进制）

完整代码实现 #

把这些代码放在一个VBA模块里即可：

1. 先声明CryptoAPI相关系统函数（模块顶部） #

Option Explicit

' Windows CryptoAPI 核心函数声明
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Private Const CALG_SHA1 As Long = &H8004
Private Const AT_SIGNATURE As Long = 2
Private Const X509_ASN_ENCODING As Long = &H1
Private Const PKCS_7_ASN_ENCODING As Long = &H10000

Private Type CRYPT_KEY_PROV_INFO
    pwszContainerName As String
    pwszProvName As String
    dwProvType As Long
    dwFlags As Long
    cProvParam As Long
    rgProvParam As Long
    dwKeySpec As Long
End Type

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
    ByRef phProv As Long, _
    ByVal pszContainer As String, _
    ByVal pszProvider As String, _
    ByVal dwProvType As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function CryptImportKey Lib "advapi32.dll" ( _
    ByVal hProv As Long, _
    ByVal pbData As String, _
    ByVal dwDataLen As Long, _
    ByVal hPubKey As Long, _
    ByVal dwFlags As Long, _
    ByRef phKey As Long) As Long

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

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

Private Declare Function CryptSignHash Lib "advapi32.dll" Alias "CryptSignHashA" ( _
    ByVal hHash As Long, _
    ByVal dwKeySpec As Long, _
    ByVal sDescription As String, _
    ByVal dwFlags As Long, _
    ByVal pbSignature As String, _
    ByRef pdwSigLen As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
    ByVal hHash As Long) As Long

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

Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
    ByVal hKey As Long) As Long

2. 读取私钥文件的辅助函数 #

Private Function ReadPrivateKey(ByVal filePath As String) As String
    Dim fileNum As Integer
    fileNum = FreeFile
    Open filePath For Binary Access Read As #fileNum
    ReadPrivateKey = String$(LOF(fileNum), Chr$(0))
    Get #fileNum, , ReadPrivateKey
    Close #fileNum
End Function

3. RSA-SHA1签名核心函数 #

Public Function GenerateRSASHA1Signature(ByVal requestContent As String, ByVal privateKeyPath As String) As String
    Dim hProv As Long, hKey As Long, hHash As Long
    Dim privateKey As String
    Dim signature As String
    Dim sigLen As Long
    Dim isSuccess As Boolean
    
    ' 读取本地私钥文件
    privateKey = ReadPrivateKey(privateKeyPath)
    
    ' 获取加密上下文
    isSuccess = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
    If Not isSuccess Then GoTo CleanupResources
    
    ' 导入私钥到上下文
    isSuccess = CryptImportKey(hProv, privateKey, Len(privateKey), 0, 0, hKey)
    If Not isSuccess Then GoTo CleanupResources
    
    ' 创建SHA1哈希对象
    isSuccess = CryptCreateHash(hProv, CALG_SHA1, 0, 0, hHash)
    If Not isSuccess Then GoTo CleanupResources
    
    ' 对请求内容进行哈希计算
    isSuccess = CryptHashData(hHash, requestContent, Len(requestContent), 0)
    If Not isSuccess Then GoTo CleanupResources
    
    ' 先获取签名所需长度
    sigLen = 0
    isSuccess = CryptSignHash(hHash, AT_SIGNATURE, vbNullString, 0, vbNullString, sigLen)
    If Not isSuccess Then GoTo CleanupResources
    
    ' 分配内存存储签名结果
    signature = String$(sigLen, Chr$(0))
    isSuccess = CryptSignHash(hHash, AT_SIGNATURE, vbNullString, 0, signature, sigLen)
    If Not isSuccess Then GoTo CleanupResources
    
    ' 转成Base64格式（如果API要求十六进制，替换成HexEncode函数即可）
    GenerateRSASHA1Signature = Base64Encode(signature)
    
CleanupResources:
    ' 必须释放所有加密资源，避免内存泄漏
    If hHash <> 0 Then CryptDestroyHash hHash
    If hKey <> 0 Then CryptDestroyKey hKey
    If hProv <> 0 Then CryptReleaseContext hProv, 0
    If Not isSuccess Then GenerateRSASHA1Signature = ""
End Function

4. Base64编码辅助函数（按需使用） #

Public Function Base64Encode(ByVal inputStr As String) As String
    Dim xmlDoc As Object, base64Node As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set base64Node = xmlDoc.createElement("base64")
    
    base64Node.DataType = "bin.base64"
    base64Node.nodeTypedValue = StrConv(inputStr, vbFromUnicode)
    
    Base64Encode = base64Node.Text
    
    Set base64Node = Nothing
    Set xmlDoc = Nothing
End Function

使用指南 #

1. 私钥格式转换：如果你的私钥是OpenSSL生成的PEM格式，需要先转换成PFX格式，用这个OpenSSL命令：

   openssl pkcs12 -export -in private_key.pem -out private_key.pfx
   

2. 调用签名函数：

   Dim apiRequestContent As String
   Dim apiSignature As String
   ' 这里替换成API要求的待签名内容（比如参数拼接后的字符串）
   apiRequestContent = "app_id=123&timestamp=1699999999&data=xxx"
   ' 替换成你的私钥文件路径
   apiSignature = GenerateRSASHA1Signature(apiRequestContent, "C:\Secure\private_key.pfx")
   ' 最后把apiSignature加入到API请求的Header或参数中即可
   

注意事项 #

• 私钥文件一定要妥善存储，绝对不要硬编码路径，最好让用户通过文件选择框选择
• 测试时记得用API提供的签名验证工具校验结果，确保签名正确
• 如果API要求十六进制格式的签名，把Base64Encode换成对应的十六进制转换函数即可

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