一段时间以来,我通过使用对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
答案 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