Skip to content

Instantly share code, notes, and snippets.

@DiegoQueiroz

DiegoQueiroz/GeraDigitosAleatorios.bas

Last active July 29, 2020 19:06
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save DiegoQueiroz/9c77d8ca78d761e5272b28973b730dfc to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save DiegoQueiroz/9c77d8ca78d761e5272b28973b730dfc to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. DiegoQueiroz revised this gist Jul 29, 2020. 1 changed file with 13 additions and 22 deletions.
    35 changes: 13 additions & 22 deletions GeraDigitosAleatorios.bas
    View file
    Original file line number Diff line number Diff line change
    @@ -1,35 +1,26 @@
    Attribute VB_Name = "GeraDigitosAleatorios"
    Option Explicit

    ' Declarações extraídas de wincrypt.h
    ' https://docs.microsoft.com/en-us/windows/win32/api/wincrypt/
    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 Long) As Long
    Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, Optional ByVal dwFlags As Long) As Long
    Const PROV_RSA_FULL = 1&
    Const CRYPT_VERIFYCONTEXT = &HF0000000
    Private Declare Function BCryptGenRandom Lib "bcrypt.dll" (ByVal hAlgorithm As Long, ByRef pbBuffer As Long, ByVal cbBuffer As Long, ByVal dwFlags As Long) As Long
    Const BCRYPT_USE_SYSTEM_PREFERRED_RNG = &H2
    Const STATUS_SUCCESS = &H0

    Public Function GeraDigitosAleatorios(ByVal tamanho As Integer) As String

    Const ERRO_GERACAO_SEQUENCIA_NUMERO = vbObjectError + 1
    Const ERRO_GERACAO_SEQUENCIA_DESCRICAO = "Erro na geração da sequência aleatória"

    Dim hProvider, numero As Long
    If CryptAcquireContextW(hProvider, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then

    GeraDigitosAleatorios = ""
    While Len(GeraDigitosAleatorios) < tamanho
    If CryptGenRandom(hProvider, 4&, numero) = 0& Then
    Err.Raise number:=ERRO_GERACAO_SEQUENCIA_NUMERO, _
    Description:=ERRO_GERACAO_SEQUENCIA_DESCRICAO
    End If
    Dim numero As Long
    GeraDigitosAleatorios = ""
    While Len(GeraDigitosAleatorios) < tamanho
    If STATUS_SUCCESS <> BCryptGenRandom(0, numero, 4&, BCRYPT_USE_SYSTEM_PREFERRED_RNG) Then
    Err.Raise Number:=ERRO_GERACAO_SEQUENCIA_NUMERO, _
    Description:=ERRO_GERACAO_SEQUENCIA_DESCRICAO
    End If

    GeraDigitosAleatorios = GeraDigitosAleatorios + CStr(Abs(numero))
    Wend
    GeraDigitosAleatorios = GeraDigitosAleatorios + CStr(Abs(numero))
    Wend

    hProvider = CryptReleaseContext(hProvider, 0)
    End If

    GeraDigitosAleatorios = Right(GeraDigitosAleatorios, tamanho)
    End Function

  2. DiegoQueiroz created this gist Jul 22, 2020.
    41 changes: 41 additions & 0 deletions GeraDigitosAleatorios.bas
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,41 @@
    Attribute VB_Name = "GeraDigitosAleatorios"
    Option Explicit

    ' Declarações extraídas de wincrypt.h
    ' https://docs.microsoft.com/en-us/windows/win32/api/wincrypt/
    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 Long) As Long
    Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, Optional ByVal dwFlags As Long) As Long
    Const PROV_RSA_FULL = 1&
    Const CRYPT_VERIFYCONTEXT = &HF0000000

    Public Function GeraDigitosAleatorios(ByVal tamanho As Integer) As String

    Const ERRO_GERACAO_SEQUENCIA_NUMERO = vbObjectError + 1
    Const ERRO_GERACAO_SEQUENCIA_DESCRICAO = "Erro na geração da sequência aleatória"

    Dim hProvider, numero As Long
    If CryptAcquireContextW(hProvider, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then

    GeraDigitosAleatorios = ""
    While Len(GeraDigitosAleatorios) < tamanho
    If CryptGenRandom(hProvider, 4&, numero) = 0& Then
    Err.Raise number:=ERRO_GERACAO_SEQUENCIA_NUMERO, _
    Description:=ERRO_GERACAO_SEQUENCIA_DESCRICAO
    End If

    GeraDigitosAleatorios = GeraDigitosAleatorios + CStr(Abs(numero))
    Wend

    hProvider = CryptReleaseContext(hProvider, 0)
    End If

    GeraDigitosAleatorios = Right(GeraDigitosAleatorios, tamanho)
    End Function

    '##################################
    ' Exemplo de Utilização
    '##################################
    'Private Sub Command1_Click()
    ' MsgBox GeraDigitosAleatorios(8)
    'End Sub