Last active
July 29, 2020 19:06
-
-
Save DiegoQueiroz/9c77d8ca78d761e5272b28973b730dfc to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment