为什么CryptAcquireContext在某些计算机上一直返回0(零)?

时间:2017-02-24 23:17:49

标签: vba

一段时间以来,我通过使用对Microsoft Strong Cryptographic Provider的MS API调用实现了我自己的MS Access VBA密码安全伪随机数生成器(CSPRNG)。它以加密安全的方式吐出随机字节0-255(00000000-11111111)。调用是通过VBA模块中的几个DLL函数声明(调用" advapi32.dll")完成的。

这里的问题是我对CryptAcquireContext(...)的调用并没有给我一个加密上下文....但只在某些计算机上。它在我构建的机器上工作得很好......但是在其他人的机器上却没有。它不是VBE参考问题; DLL存在,模块中的所有调用都不依赖于VBE引用。我已经尝试了其他几个"提供商......"不好。全零。

以下是代码:

Option Compare Database
Option Explicit

Private Const MS_STRONG_PROV = "Microsoft Strong Cryptographic Provider" 
Private Const PROV_RSA_FULL = 1 Private Const CRYPT_VERIFYCONTEXT = 0



#If VBA7 Then

    Private Declare PtrSafe 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 Boolean '

    Private Declare PtrSafe Function CryptGenRandom Lib "advapi32.dll" _
        (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Byte) As Boolean

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

#Else

    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 Boolean '

    Private Declare Function CryptGenRandom Lib "advapi32.dll" _
        (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Byte) As Boolean

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

#End If



Public Function RandomByte() As Byte

    On Error Resume Next

    Dim lngContext As Long, bytResult As Byte

    ' Supposed to dump a value into lngContext... only spitting out zero.
    Call CryptAcquireContext(lngContext, vbNullString, MS_STRONG_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)

    ' Which means THIS ALSO spits out only a zero....
    Call CryptGenRandom(lngContext, 1, bytResult)

    '...and this is crashing for unknown reasons.
    Call CryptReleaseContext(lngContext, 0)

    RandomByte = bytResult

End Function

1 个答案:

答案 0 :(得分:1)

我需要初始化一个密钥容器,如下所示:

Private Const CRYPT_NEWKEYSET = 8

Call CryptAcquireContext(lngContext, vbNullString, MS_STRONG_PROV, _
PROV_RSA_FULL, CRYPT_NEWKEYSET )

然后另一个电话(使用CRYPT_VERIFYCONTEXT)有效。

完整模块:

Option Compare Database
Option Explicit

Private Const MS_STRONG_PROV = "Microsoft Strong Cryptographic Provider"
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_VERIFYCONTEXT = 0
Private Const CRYPT_NEWKEYSET = 8

#If VBA7 Then

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

  Private Declare PtrSafe Function CryptGenRandom Lib "advapi32.dll" _
    (ByVal hProv As LongPtr, ByVal dwLen As Long, ByRef pbBuffer As Byte) As Boolean

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

#Else

  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 Boolean '

  Private Declare Function CryptGenRandom Lib "advapi32.dll" _
    (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Byte) As Boolean

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

#End If



Public Function RandomByte() As Byte

    On Error Resume Next

    Dim lngContext As LongPtr, bytResult As Byte

    Call CryptAcquireContext(lngContext, vbNullString, MS_STRONG_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)

    If Err.LastDllError = -2146893802 Then

        Call CryptAcquireContext(lngContext, vbNullString, MS_STRONG_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET)

    End If

    Call CryptGenRandom(lngContext, 1, bytResult)

    Call CryptReleaseContext(lngContext, 0)

    RandomByte = bytResult

End Function