Can I use API or something else to get close to a TRUE RANDOM NUMBER in VBA?

问题

Is there an API, library, or some other chip-set based command I can access in VBA?

I currently have a setup for getting random numbers; however, when I put the result sets to the test, the numbers do not even come close to generating a good statistical curve. I tested this by generating 600 simulated rolls of 2 six-sided dice totaling the 2 dice together each time. I was hoping for the number 7 to take a huge lead; however it came in second twice with nowhere near the appropriate statistical curve being created.

My current code uses the standard VBA method, but as I said fails the statistics test:

Randomize
GetRandomNo = Int((6 * RND) + 1)

回答1:

For a rather full answer:

There are numerous ways to generate random numbers, but one way is to use the Windows API to do the heavy lifting. Windows has API functions to generate cryptographically secure random bytes, and these functions can make use of hardware random number providers.

First, we declare the API functions:

Public Declare PtrSafe Function BCryptOpenAlgorithmProvider Lib "bcrypt.dll" (ByRef phAlgorithm As LongPtr, ByVal pszAlgId As LongPtr, ByVal pszImplementation As LongPtr, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function BCryptGenRandom Lib "bcrypt.dll" (ByVal hAlgorithm As LongPtr, pbBuffer As Any, ByVal cbBuffer As Long, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function BCryptCloseAlgorithmProvider Lib "bcrypt.dll" (ByVal hAlgorithm As LongPtr, ByVal dwFlags As Long)

Then, we use this call, and use modulus to reduce our number to one in the desired range:

Public Function RandomRangeWinApi(Lower As Long, Upper As Long) As Long
    Dim hAlg As LongPtr
    Dim iAlg As String
    iAlg = "RNG" & vbNullChar
    BCryptOpenAlgorithmProvider hAlg, StrPtr(iAlg), 0, 0
    Dim lRandom As Long
    BCryptGenRandom hAlg, lRandom, LenB(lRandom), 0
    RandomRangeWinApi = Abs(lRandom) Mod (Upper - Lower + 1) + Lower
    BCryptCloseAlgorithmProvider hAlg, 0
End Function

This approach is fine if you assume an integer has an infinite range of values. However, it hasn't, which means at the limits it's imprecise. Similarly, multiplication assumes an infinitely precise number, which also isn't true and causes a slight bias.

We can get around this by directly using the binary presentation of numbers, and discarding numbers that fall outside of this template:

Public Function RandomRangeExact(Lower As Long, Upper As Long) As Long
    'Initialize random number generator
    Dim hAlg As LongPtr
    Dim iAlg As String
    iAlg = "RNG" & vbNullChar
    BCryptOpenAlgorithmProvider hAlg, StrPtr(iAlg), 0, 0
    'Initialize bit template
    Dim template As Long
    Dim i As Long
    Do While template < Upper - Lower
        template = template + 2# ^ i
        i = i + 1
    Loop
    Dim lRandom As Long
    Do
        'Generate random number
        BCryptGenRandom hAlg, lRandom, LenB(lRandom), 0
        'Limit it to template
        lRandom = lRandom And template
    Loop While lRandom > (Upper - Lower) 'Regenerate if larger than desired range (should happen less than 50% of times)
    RandomRangeExact = lRandom + Lower
    BCryptCloseAlgorithmProvider hAlg, 0
End Function

Now, let's investigate the performance of your solution and both opportunities for rolling dice: I've simulated 100000 random numbers for each approach between 1 and 6.

This is the result:

While the first approach seems to have larger variance between numbers (specifically less ones and more twos), for most applications I'd assume the first is accurate enough.

来源：https://stackoverflow.com/questions/61450917/can-i-use-api-or-something-else-to-get-close-to-a-true-random-number-in-vba

标签

vba

api

ms-access

encryption

chipset