MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

    Compartilhe

    DiogenesSousa
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 16
    Registrado : 29/01/2018

    [Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

    Mensagem  DiogenesSousa em Ter 06 Fev 2018, 04:14

    Pessoal esse código em vba gera senhas aleatórias sem repetição de sequências, porém ele reorganiza as mesmas letras em uma nova sequência. Gostaria  de saber se é possível fazer ele gerar sequências sem repetição dos mesmos grupos de letras, afim que seja geradas todas as sequências possíveis sem repetição do mesmo conjunto letras. Ex.: Letras (ABCDEF) Gerar senha com apenas três letras das seis escolhidas (abc, abd, abe, abf... quero poder continuar gerando senhas sem repetir o mesmo grupo de letras. Ex.: (abc) pois da forma que está ele ainda vai aparecer reorganizado diferente (cba, acb...). Quero impedir essa reorganização dos mesmos letras. Obs.: Se for possível essa rotina gostaria de saber o que tenho que alterar no código abaixo.

    Option Compare Database

    Function GerarSenha()
    On Error GoTo TratarErro
    Dim TamanhoSenha As Integer, Codigo As String, Novo As String

    '--------------------------------------
    'CRIA SENHA ALEATÓRIA
    '--------------------------------------

    Codigo = ""
    TamanhoSenha = Nz(Form_SenhaAleatoria.TamanhoSenha, Cool

    Dim Letra(22)

    Letra(0) = "A "
    Letra(1) = "B "
    Letra(2) = "C "
    Letra(3) = "D "
    Letra(4) = "E "
    Letra(5) = "F "
    Letra(6) = "G "
    Letra(7) = "H "
    Letra(Cool = "I "
    Letra(9) = "J "
    Letra(10) = "K "
    Letra(11) = "M "
    Letra(12) = "N "
    Letra(13) = "O "
    Letra(14) = "P "
    Letra(15) = "Q "
    Letra(16) = "R "
    Letra(17) = "S "
    Letra(18) = "T "
    Letra(19) = "U"
    Letra(20) = "V "
    Letra(21) = "X "
    Letra(22) = "Z "

    Randomize

    Do While Len(Codigo) < TamanhoSenha
       Novo = Letra(Int(22 * Rnd))

       If InStr(1, Codigo, Novo) = 0 Then
           Codigo = Codigo & Novo
       End If

    Loop

    GerarSenha = Codigo

    SairFunction:
    Exit Function

    TratarErro:
    MsgBox "Ocorreu um erro ao processar o comando:" & Chr(13) & Err.Description, vbCritical, " Erro " & Err.Number
    Resume SairFunction

    End Function

    Desde já agradeço!!!
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 663
    Registrado : 18/01/2013

    Re: [Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

    Mensagem  CassioFabre em Ter 06 Fev 2018, 11:50

    Bom dia,

    Como cada letra possui um código específico dentro da matriz e este não vai mudar em momento algum, voce pode gravar numa tabela auxiliar a soma desses códigos e, no momento de gerar o código, fazer uma verificação se a soma dos caracteres gerados pela função já existe nessa tabela, caso exista, o código irá refazer o processo. Como ambas as somas de BC e CB vão dar 3, só a primeira combinação que for gerada entre as duas será gravada na tabela (por exemplo).


    ------------------------------
    EDIT:

    Agora que percebi que a matriz está errada. Ela deve ter 23 elementos, e não 22 como no seu código e no exemplo. Do jeito que está, a latra Z está sendo excluída das senhas. Vou consertar apenas aqui no post, lembre de faze-lo no seu programa.

    ------------------------------

    Segue:
    Código:
    Sub geraSenha()
        Dim tamanhoSenha As Integer
        Dim codigo As Integer
        Dim soma As Integer
        Dim senha As String
        Dim booOk As Boolean
        Dim rs As Recordset
        
        tamanhoSenha = txtTamanhoSenha
        booOk = False
        senha = ""
        codigo = 0
        soma = 0
        
        Dim Letra(23)
        Letra(0) = "A"
        Letra(1) = "B"
        Letra(2) = "C"
        Letra(3) = "D"
        Letra(4) = "E"
        Letra(5) = "F"
        Letra(6) = "G"
        Letra(7) = "H"
        Letra(8) = "I"
        Letra(9) = "J"
        Letra(10) = "K"
        Letra(11) = "M"
        Letra(12) = "N"
        Letra(13) = "O"
        Letra(14) = "P"
        Letra(15) = "Q"
        Letra(16) = "R"
        Letra(17) = "S"
        Letra(18) = "T"
        Letra(19) = "U"
        Letra(20) = "V"
        Letra(21) = "X"
        Letra(22) = "Z"
        
        Do While booOk = False
            Do While Len(senha) < tamanhoSenha
                codigo = Int(Rnd * 23) + 1
                
                If InStr(1, senha, Letra(codigo)) = 0 Then
                    soma = soma + codigo
                    senha = senha & Letra(codigo)
                End If
            Loop
            
            Set rs = CurrentDb.OpenRecordset("SELECT COUNT(codigo) AS c FROM tblSenhas WHERE soma = " & soma & "")
            
            If rs!c = 0 Then
                booOk = True
                
                Dim rs1 As Recordset
                Set rs1 = CurrentDb.OpenRecordset("tblSenhas")
                rs1.AddNew
                    rs1("senha") = senha
                    rs1("soma") = soma
                rs1.Update
                rs1.Close
                
                txtSenhaGerada = senha
                
                MsgBox "Senha gravada com sucesso!", vbInformation, "Senha"
                
                txtSenhaGerada = Null
            End If
            
            codigo = 0
            soma = 0
            senha = ""
        Loop
    End Sub

    Em anexo o modelo que fiz.

    Abraço.
    Anexos
    gerarSenha.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (95 Kb) Baixado 17 vez(es)


    .................................................................................
    Só não tem código pra morte!

    DiogenesSousa
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 16
    Registrado : 29/01/2018

    Re: [Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

    Mensagem  DiogenesSousa em Ter 06 Fev 2018, 14:48

    Show de Bola!!!!

    Muito Obrigado CassioFabre, analisar o fonte que você anexou me ajudou muito a entender onde eu estava errando. Muito Obrigado mesmo!!!!

    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3632
    Registrado : 29/06/2012

    Re: [Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

    Mensagem  Noobezinho em Ter 06 Fev 2018, 16:37

    Cassio

    Boa sacada essa da soma dos elementos resultantes.

    Gostei!

    Parabéns!


    [ ]'s
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 663
    Registrado : 18/01/2013

    Re: [Resolvido]Gerar Senhas - Ms Access (Tabela: tblSenha / Formulário: frmSenhaAleatoria) HELP!!!!

    Mensagem  CassioFabre em Qua 07 Fev 2018, 14:51

    Boa tarde,

    Muito obrigado Noobezinho. Já aprendi demais com você!

    Abraço.


    .................................................................................
    Só não tem código pra morte!

      Data/hora atual: Qui 24 Maio 2018, 01:24