MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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


2 participantes

    função para encriptação/desencriptação de texto inclusivé acentuação

    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 335
    Registrado : 18/09/2013

    função para encriptação/desencriptação de texto inclusivé acentuação Empty função para encriptação/desencriptação de texto inclusivé acentuação

    Mensagem  ÓscarSantos 24/3/2015, 16:01

    após pesquisa encontrei este código para encriptação /desencriptação de texto inclusivé de acentuação.

    fonte :
    http://forum.imasters.com.br/topic/138634-descriptografa-md5/

    'criptografar texto

    Const EncC1 = 109
    Const EncC2 = 191
    Const EncKey = 161

    Public Function EncriptaStr(Texto)
    Dim TempStr, TempResult, TempNum, TempChar
    Dim TempKey
    Dim i

    TempStr = Texto
    TempResult = ""
    TempKey = ((EncKey * EncC1) + EncC2) Mod 65536

    For i = 1 To Len(TempStr)
    TempNum = (Asc(Mid(TempStr, i, 1)) Xor (AuxShr(TempKey, Cool)) Mod 256
    TempChar = Chr(TempNum)
    TempKey = (((Asc(TempChar) + TempKey) * EncC1) + EncC2) Mod 65536
    TempResult = TempResult & TempChar
    Next

    EncriptaStr = TempResult
    End Function

    'descriptograr texto
    Public Function DecriptaStr(Texto)
    Dim TempStr, TempResult, TempNum, TempChar
    Dim TempKey
    Dim i

    TempStr = Texto
    TempResult = ""
    TempKey = ((EncKey * EncC1) + EncC2) Mod 65536

    For i = 1 To Len(TempStr)
    TempNum = (Asc(Mid(TempStr, i, 1)) Xor (AuxShr(TempKey, Cool)) Mod 256
    TempChar = Chr(TempNum)
    TempKey = (((Asc(Mid(TempStr, i, 1)) + TempKey) * EncC1) + EncC2) Mod 65536
    TempResult = TempResult & TempChar
    Next

    DecriptaStr = TempResult
    End Function

    Private Function AuxShr(Numero, BShr)
    AuxShr = Int(Numero / (2 ^ BShr))
    End Function


    no envento Seubotao()
    'encripta texto
    varTeste = EncriptaStr( "texto ou variável para criptografar" )


    no envento Seubotao()
    'desencripta texto
    varTeste = DecriptaStr( "texto ou variável para descriptografar" )


    .................................................................................
    _________________________________________________________
    sempre a aprender
    para enviar ou postar só access2007 infelizmente é o que tenho no trabalho Sad .
    para dar tópico como resolvido https://www.maximoaccess.com/t860-resolucao-de-topicos
    formiga10x
    formiga10x
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 818
    Registrado : 11/09/2013

    função para encriptação/desencriptação de texto inclusivé acentuação Empty Re: função para encriptação/desencriptação de texto inclusivé acentuação

    Mensagem  formiga10x 24/3/2015, 17:50

    Muito bom Oscar. Aproveitando para dirimir algumas dúvidas que poderá surgir fiz um exemplo em base no código que postou.

    Link

    função para encriptação/desencriptação de texto inclusivé acentuação 2wf0med


    .................................................................................
    Abraço
    Formiga10x

    Sempre que possível poste o bd ou parte dele, com uma explicação bem clara e objetiva do que quer.
    “Um homem não está acabado quando enfrenta a derrota. Ele está acabado quando desiste - Richard Nixon”
    Formiga10x

    "Lembro do exato momento em que me dei conta que boa parte de minha vida foi dedicada a localizar erros em meus próprios programas."
    - Maurice Vicent Wilkes

      Data/hora atual: 28/3/2024, 19:24