Attribute VB_Name = "ModSuperRnd"
Option Explicit
'*************************************************************************
'**模 块 名：ModSuperRnd
'**说    明：利用CryptGenRandom实现的高度随机数,原帖地址: http://topic.csdn.net/u/20080410/17/4138bc06-7c26-4fb7-b283-dbd6eb46f43f.html
'**创 建 人：嗷嗷叫的老马
'**日    期：2003年12月17日
'**备    注: 紫水晶工作室 版权所有
'**          更多模块/类模块请访问我站:  http://www.m5home.com
'**版    本：V1.0
'*************************************************************************

Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_SID_MD5 As Long = 3
Private Const ALG_CLASS_HASH As Long = 32768

Private Const HP_HASHVAL As Long = 2
Private Const HP_HASHSIZE As Long = 4

Private Const CRYPT_VERIFYCONTEXT = &HF0000000

Private Const PROV_RSA_FULL As Long = 1
Private Const MS_ENHANCED_PROV As String = "Microsoft Enhanced Cryptographic Provider v1.0"

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 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 CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal pCryptHash As Long, ByVal dwParam As Long, ByRef pbData As Any, ByRef pcbData As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal pCryptHash As Long, ByVal dwLength As Long, ByRef pbData As Any) 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 CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long

Public Function GenerateRandom(ByVal lByteCount As Long) As Byte()
    '产生指定字节的随机数
    Dim hCrypt As Long
    Dim b()    As Byte
    
    ReDim b(lByteCount - 1)
    
    If CryptAcquireContext(hCrypt, vbNullString, MS_ENHANCED_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
        If CryptGenRandom(hCrypt, lByteCount, b(0)) <> 0 Then
            GenerateRandom = b
        End If
    End If
    
    If hCrypt Then CryptReleaseContext hCrypt, 0
End Function

Public Function GenerateRandomLong() As Long
    '产生一个LONG类型的随机数
    Dim hCrypt As Long
    
    If CryptAcquireContext(hCrypt, vbNullString, MS_ENHANCED_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
        Call CryptGenRandom(hCrypt, 4, GenerateRandomLong)
    End If
    
    If hCrypt Then CryptReleaseContext hCrypt, 0
End Function

Public Function GenerateRandomInteger() As Integer
    '产生一个INT的随机数
    Dim hCrypt As Long
    
    If CryptAcquireContext(hCrypt, vbNullString, MS_ENHANCED_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
        Call CryptGenRandom(hCrypt, 2, GenerateRandomInteger)
    End If
    
    If hCrypt Then CryptReleaseContext hCrypt, 0
End Function