API based random number generator for VB6

[Ben321]

The built-in one in VB6 isn't all that good at creating highly random numbers (at least for cryptographic purposes). The crypto API is much better at this. Below is some sample code that you can put in a module that will let you use the Microsoft CryptoAPI random number generator.

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 CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Any) As Long

Private Const PROV_RSA_FULL As Long = 1
Private Const VERIFY_CONTEXT As Long = &HF0000000


Public Function GenRandom(ByVal ptrMemory As Long, ByVal lenMemory As Long)
    Dim hProv As Long
    CryptAcquireContext hProv, vbNullString, vbNullString, PROV_RSA_FULL, VERIFY_CONTEXT
    CryptGenRandom hProv, lenMemory, ByVal ptrMemory
    CryptReleaseContext hProv, 0
End Function

I use actual numerical pointers passed ByVal, instead of something like "ByRef MyArrayFirstCell As Byte" because the ByRef alternative would require passing it something specifically Byte-type and if I had a Long-type array (or any other type) it wouldn't work, and I can't use ByRef As Any with VB functions (it only works with DLL functions). This allows it to access ANY kind of variable to be used for holding the memory, with the one caveat that you will need to use VarPtr to get the actual memory address of the variable, in order to pass it to this function.

[Bonnie West]

The correct name of the flag passed to CryptAcquireContext is actually CRYPT_VERIFYCONTEXT, not VERIFY_CONTEXT.

This one relies on the CryptGenRandom function:

Option Explicit

Private Declare Function CryptAcquireContextW Lib "advapi32.dll" (ByRef phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Any) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, Optional ByVal dwFlags As Long) As Long

Public Function GenRnd() As Long
    Const PROV_RSA_FULL = 1&, CRYPT_VERIFYCONTEXT = &HF0000000
    Dim hProvider As Long

    If CryptAcquireContextW(hProvider, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
        If CryptGenRandom(hProvider, 4&, GenRnd) = 0& Then GenRnd = 0&
        hProvider = CryptReleaseContext(hProvider): Debug.Assert hProvider
    End If
End Function

[Ben321]

Ok, so I fixed the constant's name now. Here's the complete code of the module, including the fix.

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 CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Any) As Long

Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000


Public Function GenRandom(ByVal ptrMemory As Long, ByVal lenMemory As Long)
    Dim hProv As Long
    CryptAcquireContext hProv, vbNullString, vbNullString, PROV_RSA_FULL, VERIFY_CONTEXT
    CryptGenRandom hProv, lenMemory, ByVal ptrMemory
    CryptReleaseContext hProv, 0
End Function

I've also created a program that uses this random number generator to do a transposition cipher on an image. It generates a randomizer key which randomizes a pre-generated lookup table for pixel coordinates. The then randomized coordinate lookup table is the actual key used to scramble pixel locations. Here's the code for the form.

Private Const FileName As String = 'Put your picture file name here. It must be a BMP, JPG, or GIF file, as VB6 doesn't natively support PNG, TIF, or any other image format.
Private Const PicW As Long = 320
Private Const PicH As Long = 240

Private Type Coords
    x As Integer
    y As Integer
End Type

Dim Key() As Coords


Private Sub Command1_Click(Index As Integer)
    Dim x As Long
    Dim y As Long
    
    Picture1.PaintPicture LoadPicture(FileName), 0, 0, PicW, PicH
    Picture2.Cls
    Picture3.Cls
    
    For y = 0 To PicH - 1
        For x = 0 To PicW - 1
            With Key(x, y)
                If Index = 0 Then
                    Picture2.PSet (.x, .y), Picture1.Point(x, y)
                    Picture1.PSet (x, y)
                Else
                    Picture2.PSet (x, y), Picture1.Point(.x, .y)
                    Picture1.PSet (.x, .y)
                End If
            End With
        Next x
        DoEvents
    Next y
    
    For y = 0 To PicH - 1
        For x = 0 To PicW - 1
            With Key(x, y)
                If Index = 0 Then
                    Picture3.PSet (x, y), Picture2.Point(.x, .y)
                    Picture2.PSet (.x, .y)
                Else
                    Picture3.PSet (.x, .y), Picture2.Point(x, y)
                    Picture2.PSet (x, y)
                End If
            End With
        Next x
        DoEvents
    Next y
End Sub

Private Sub Form_Load()
    Picture1.PaintPicture LoadPicture(FileName), 0, 0, PicW, PicH
    GenKey
End Sub


Private Sub GenKey()
    Dim Randomizer() As Coords
    Dim x As Long
    Dim y As Long
    Dim x2 As Long
    Dim y2 As Long
    Dim temp As Coords
    
    ReDim Randomizer(PicW - 1, PicH - 1)
    ReDim Key(PicW - 1, PicH - 1)

    
    GenRandom VarPtr(Randomizer(0, 0)), PicW * PicH * 4
    
    For y = 0 To PicH - 1
        For x = 0 To PicW - 1
            With Key(x, y)
                .x = x
                .y = y
            End With
        Next x
    Next y
    
    For y = 0 To PicH - 1
        For x = 0 To PicW - 1
            With Randomizer(x, y)
                x2 = (.x And &HFFFF&) Mod PicW
                y2 = (.y And &HFFFF&) Mod PicH
            End With
            
            temp = Key(x, y)
            Key(x, y) = Key(x2, y2)
            Key(x2, y2) = temp
        Next x
    Next y
End Sub

It needs 3 picture box controls, and a command button array consisting of 2 buttons (name of control array must be Command1). The form itself and all 3 picture boxes must have AutoRedraw set to true, and ScaleMode set to Pixel. The 3 picture boxes must have width and height of 320x240, Appearance set to Flat, and BorderStyle set to None. The names of the picture boxes must be Picture1, Picture2, and Picture3. The first command button (Index = 0) encrypts Picture1 into Picture2, and then decrypts Picture 2 into Picture3. The second command button (Index = 1) takes the already normal picture in Picture1 and then "decrypts" it into Picture2, and then "encrypts" Picture2 into Picture 3, where the picture appears normal again.

[Steve Grant]

Ben you still need to modify the constant in the line CryptAcquireContext.

[dilettante]

The intrinsic Rnd() function was never meant for crypto purposes, and not even simple statistical purposes. It dates back to an era where large volumes of data weren't being processed anyway.

It is still useful, but mainly for things like generating dummy data and such or simple games.

Here's another decent alternative, though it has been posted many times in Q&A threads:

'Said to be flawed prior to XP SP3:
Private Declare Function RtlGenRandom Lib "AdvAPI32" Alias "SystemFunction036" ( _
    ByVal pRandomBuffer As Long, _
    ByVal RandomBufferLength As Long) As Long

Private Function Rand(ByVal Min As Long, ByVal Max As Long) As Long
    If RtlGenRandom(VarPtr(Rand), 4) Then
        Rand = Abs(Rand) Mod (Max - Min + 1) + Min
    Else
        Err.Raise 51 'Internal error, for lack of a more specific exception.
    End If
End Function

By varying the "buffer length" and dealing with the sign bit in different ways you can accomodate different needs.

[Kunical]

I have always had problems with VB6 builtin Rnd function. The problem occurs when you call your random function too many times in a fast way it will generate duplicate values. This happens because the Rnd function uses the Time only as seed and when you call it too much the Time can be the same sometimes and thus the seed. Indeed CryptGenRandom does not relay only on Time for seed. It uses various things such as threads, time, mouse or keyboard , system counter, memory status, free disk clusters, and so on.

[dilettante]

The time isn't a factor unless you repeatedly set the sequence. Programs should never call Randomize more than once except in very particular circumstances.

This sounds more like misuse of Rnd(), the way so many newbs try to misuse Timer controls thinking they are some sort of stopwatch. The built in function is perfectly fine. You just have to use it properly and avoid trying to misapply it to scenarios it isn't designed for.

You can eyeball it using something like the attached Project.

[Elroy]

Ben,

I hate to tell you but these issues have been discussed ad-nausea in many other threads in these forums. Generating true random numbers (VB6 or not) is an exceedingly difficult problem. In fact, to truly do it, it takes either access to some type of quantum number device or access to some kind of real-world phenomena, such as the heat of your CPU and/or the precisely measured relative humidity and/or your precisely measured blood pressure. Here's just one (of many) threads where these issues have been discussed:

http://www.vbforums.com/showthread.p...ber-%28Long%29


Also, I just read an article the other day where people are developing devices to hook to computers that will provide "true" random numbers. Here's the article:

http://www.techrepublic.com/article/...s-it-security/

Regards,
Elroy

[Ben321]

Ben you still need to modify the constant in the line CryptAcquireContext.

Thanks for noticing that. The new code is now:

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 CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByRef pbBuffer As Any) As Long

Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000


Public Sub GenRandom(ByVal ptrMemory As Long, ByVal lenMemory As Long)
    Dim hProv As Long
    CryptAcquireContext hProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT
    CryptGenRandom hProv, lenMemory, ByVal ptrMemory
    CryptReleaseContext hProv, 0
End Function