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


+3
ÓscarSantos
Alvaro Teixeira
Assis
7 participantes

    Encriptação SHA1 retificação

    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

    Encriptação SHA1 retificação Empty Encriptação SHA1 retificação

    Mensagem  Assis 18/3/2015, 10:20

    Teixeira

    Aqui também dá erro, é quase no fim da função

    SHA1 = LCase(Right("00000000" & Hex(HASH(0)), & _
    Right("00000000" & Hex(HASH(1)), & _
    Right("00000000" & Hex(HASH(2)), & _
    Right("00000000" & Hex(HASH(3)), & _
    Right("00000000" & Hex(HASH(4)), Cool)

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Alvaro Teixeira 18/3/2015, 10:50

    Olá, vou postar todo de novo:
    Copiei do poste original (http://www.forosdelweb.com/1935907-post3.html) e rectifiquei um erro (tinha um espaço)
    Código:
    Option Explicit
    'http://www.forosdelweb.com/1935907-post3.html

     Private m_lOnBits(30) As Long
     Private m_l2Power(30) As Long
     Private Const BITS_TO_A_BYTE As Long = 8
     Private Const BYTES_TO_A_WORD As Long = 4
     Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE
     
    Private Sub Class_Initialize()
     m_lOnBits(0) = 1
     m_lOnBits(1) = 3
     m_lOnBits(2) = 7
     m_lOnBits(3) = 15
     m_lOnBits(4) = 31
     m_lOnBits(5) = 63
     m_lOnBits(6) = 127
     m_lOnBits(7) = 255
     m_lOnBits(8) = 511
     m_lOnBits(9) = 1023
     m_lOnBits(10) = 2047
     m_lOnBits(11) = 4095
     m_lOnBits(12) = 8191
     m_lOnBits(13) = 16383
     m_lOnBits(14) = 32767
     m_lOnBits(15) = 65535
     m_lOnBits(16) = 131071
     m_lOnBits(17) = 262143
     m_lOnBits(18) = 524287
     m_lOnBits(19) = 1048575
     m_lOnBits(20) = 2097151
     m_lOnBits(21) = 4194303
     m_lOnBits(22) = 8388607
     m_lOnBits(23) = 16777215
     m_lOnBits(24) = 33554431
     m_lOnBits(25) = 67108863
     m_lOnBits(26) = 134217727
     m_lOnBits(27) = 268435455
     m_lOnBits(28) = 536870911
     m_lOnBits(29) = 1073741823
     m_lOnBits(30) = 2147483647

     m_l2Power(0) = 1
     m_l2Power(1) = 2
     m_l2Power(2) = 4
     m_l2Power(3) = 8
     m_l2Power(4) = 16
     m_l2Power(5) = 32
     m_l2Power(6) = 64
     m_l2Power(7) = 128
     m_l2Power(8) = 256
     m_l2Power(9) = 512
     m_l2Power(10) = 1024
     m_l2Power(11) = 2048
     m_l2Power(12) = 4096
     m_l2Power(13) = 8192
     m_l2Power(14) = 16384
     m_l2Power(15) = 32768
     m_l2Power(16) = 65536
     m_l2Power(17) = 131072
     m_l2Power(18) = 262144
     m_l2Power(19) = 524288
     m_l2Power(20) = 1048576
     m_l2Power(21) = 2097152
     m_l2Power(22) = 4194304
     m_l2Power(23) = 8388608
     m_l2Power(24) = 16777216
     m_l2Power(25) = 33554432
     m_l2Power(26) = 67108864
     m_l2Power(27) = 134217728
     m_l2Power(28) = 268435456
     m_l2Power(29) = 536870912
     m_l2Power(30) = 1073741824
    End Sub
     
    Private Function LShift(ByVal lValue As Long, _
     ByVal iShiftBits As Integer) As Long
     If iShiftBits = 0 Then
     LShift = lValue
     Exit Function
     ElseIf iShiftBits = 31 Then
     If lValue And 1 Then
     LShift = &H80000000
     Else
     LShift = 0
     End If
     Exit Function

     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
     Err.Raise 6
     End If
     If (lValue And m_l2Power(31 - iShiftBits)) Then
     LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
     m_l2Power(iShiftBits)) Or &H80000000

     Else
     LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
     m_l2Power(iShiftBits))

     End If
     End Function
     Private Function RShift(ByVal lValue As Long, _
     ByVal iShiftBits As Integer) As Long

     If iShiftBits = 0 Then
     RShift = lValue
     Exit Function

     ElseIf iShiftBits = 31 Then
     If lValue And &H80000000 Then
     RShift = 1
     Else
     RShift = 0
     End If
     Exit Function

     ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
     Err.Raise 6
     End If

     RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

     If (lValue And &H80000000) Then
     RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
     End If
     End Function
     Private Function AddUnsigned(ByVal lX As Long, _
     ByVal lY As Long) As Long
     Dim lX4 As Long
     Dim lY4 As Long
     Dim lX8 As Long
     Dim lY8 As Long
     Dim lResult As Long

     lX8 = lX And &H80000000
     lY8 = lY And &H80000000
     lX4 = lX And &H40000000
     lY4 = lY And &H40000000

     lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

     If lX4 And lY4 Then
     lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
     ElseIf lX4 Or lY4 Then
     If lResult And &H40000000 Then
     lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
     Else
     lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
     End If
     Else
     lResult = lResult Xor lX8 Xor lY8
     End If

     AddUnsigned = lResult
     End Function
     Private Function LRot(ByVal x As Long, ByVal n As Long) As Long
     LRot = LShift(x, n) Or RShift(x, (32 - n))
     End Function
     Private Function ConvertToWordArray(sMessage As String) As Long()
     Dim lMessageLength As Long
     Dim lNumberOfWords As Long
     Dim lWordArray() As Long
     Dim lBytePosition As Long
     Dim lByteCount As Long
     Dim lWordCount As Long
     Dim lByte As Long

     Const MODULUS_BITS As Long = 512
     Const CONGRUENT_BITS As Long = 448

     lMessageLength = Len(sMessage)

     lNumberOfWords = (((lMessageLength + _
     ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
     (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
     (MODULUS_BITS \ BITS_TO_A_WORD)
     ReDim lWordArray(lNumberOfWords - 1)

     lBytePosition = 0
     lByteCount = 0
     Do Until lByteCount >= lMessageLength
     lWordCount = lByteCount \ BYTES_TO_A_WORD

     lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE

     lByte = AscB(Mid(sMessage, lByteCount + 1, 1))

     lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
     lByteCount = lByteCount + 1
     Loop

     lWordCount = lByteCount \ BYTES_TO_A_WORD
     lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
     lWordArray(lWordCount) = lWordArray(lWordCount) Or _
     LShift(&H80, lBytePosition)

     lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
     lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)

     ConvertToWordArray = lWordArray
     End Function
     Public Function SHA1(sMessage As String) As String
     Dim HASH(4) As Long
     Dim M() As Long
     Dim W(79) As Long
     Dim a, b, c, d, e As Long
     Dim g, h, i, j As Long
     Dim T1, T2 As Long

     HASH(0) = &H67452301
     HASH(1) = &HEFCDAB89
     HASH(2) = &H98BADCFE
     HASH(3) = &H10325476
     HASH(4) = &HC3D2E1F0

     M = ConvertToWordArray(sMessage)

     For i = 0 To UBound(M) Step 16
     a = HASH(0)
     b = HASH(1)
     c = HASH(2)
     d = HASH(3)
     e = HASH(4)

     For g = 0 To 15
     W(g) = M(i + g)
     Next g

     For g = 16 To 79
     W(g) = LRot(W(g - 3) Xor W(g - 8) Xor W(g - 14) Xor W(g - 16), 1)
     Next g

     For j = 0 To 79

     If j <= 19 Then
     T1 = (b And c) Or ((Not b) And d)
     T2 = &H5A827999
     ElseIf j <= 39 Then
     T1 = b Xor c Xor d
     T2 = &H6ED9EBA1
     ElseIf j <= 59 Then
     T1 = (b And c) Or (b And d) Or (c And d)
     T2 = &H8F1BBCDC
     ElseIf j <= 79 Then
     T1 = b Xor c Xor d
     T2 = &HCA62C1D6
     End If

     h = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(LRot(a, 5), T1), e), T2), W(j))
     e = d
     d = c
     c = LRot(b, 30)
     b = a
     a = h
     Next j

     HASH(0) = AddUnsigned(a, HASH(0))
     HASH(1) = AddUnsigned(b, HASH(1))
     HASH(2) = AddUnsigned(c, HASH(2))
     HASH(3) = AddUnsigned(d, HASH(3))
     HASH(4) = AddUnsigned(e, HASH(4))

     Next i

     SHA1 = LCase(Right("00000000" & Hex(HASH(0)), 8) & _
     Right("00000000" & Hex(HASH(1)), 8) & _
     Right("00000000" & Hex(HASH(2)), 8) & _
     Right("00000000" & Hex(HASH(3)), 8) & _
     Right("00000000" & Hex(HASH(4)), 8))
     End Function
    Abraço
    avatar
    Convidado
    Convidado


    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Convidado 18/3/2015, 11:23

    Bom dia,

    Gostava de saber como posso utilizar código acima para minha BD.
    Que passos devo fazer?

    Abraço... Cool
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Assis 18/3/2015, 12:50

    Teixeira

    Não estou a conseguir chamar a função com o código que esta na Msg. Nº 1
    E dá erro no " Debug "

    Dim oSHA1 As New SHA


    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 13:01

    Assis o mesmo erro dá a mim, e não estou a conseguir dar a volta



    .................................................................................
    _________________________________________________________
    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
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Alvaro Teixeira 18/3/2015, 13:34

    Olá Amigos , como sabem aqui não podemos postar duvidas.
    Colocar o modulo classe com o nome oSHA1
    No entanto vamos aguardar se o colega que postou código disponibiliza pequeno exemplo.
    Uma busca VBA SHA1 encontramos diversos exemplos.
    Abraço
    avatar
    NADIRONUNES
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 571
    Registrado : 30/08/2010

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  NADIRONUNES 18/3/2015, 13:47

    eu uso esse aqui

    Option Compare Database
    Option Explicit

    Private m_lOnBits(30) As Long
    Private m_l2Power(30) As Long

    Private Const BITS_TO_A_BYTE As Long = 8
    Private Const BYTES_TO_A_WORD As Long = 4
    Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE

    Private Sub class_Initialize()
    m_lOnBits(0) = 1
    m_lOnBits(1) = 3
    m_lOnBits(2) = 7
    m_lOnBits(3) = 15
    m_lOnBits(4) = 31
    m_lOnBits(5) = 63
    m_lOnBits(6) = 127
    m_lOnBits(7) = 255
    m_lOnBits(Cool = 511
    m_lOnBits(9) = 1023
    m_lOnBits(10) = 2047
    m_lOnBits(11) = 4095
    m_lOnBits(12) = 8191
    m_lOnBits(13) = 16383
    m_lOnBits(14) = 32767
    m_lOnBits(15) = 65535
    m_lOnBits(16) = 131071
    m_lOnBits(17) = 262143
    m_lOnBits(18) = 524287
    m_lOnBits(19) = 1048575
    m_lOnBits(20) = 2097151
    m_lOnBits(21) = 4194303
    m_lOnBits(22) = 8388607
    m_lOnBits(23) = 16777215
    m_lOnBits(24) = 33554431
    m_lOnBits(25) = 67108863
    m_lOnBits(26) = 134217727
    m_lOnBits(27) = 268435455
    m_lOnBits(28) = 536870911
    m_lOnBits(29) = 1073741823
    m_lOnBits(30) = 2147483647
    m_l2Power(0) = 1
    m_l2Power(1) = 2
    m_l2Power(2) = 4
    m_l2Power(3) = 8
    m_l2Power(4) = 16
    m_l2Power(5) = 32
    m_l2Power(6) = 64
    m_l2Power(7) = 128
    m_l2Power(Cool = 256
    m_l2Power(9) = 512
    m_l2Power(10) = 1024
    m_l2Power(11) = 2048
    m_l2Power(12) = 4096
    m_l2Power(13) = 8192
    m_l2Power(14) = 16384
    m_l2Power(15) = 32768
    m_l2Power(16) = 65536
    m_l2Power(17) = 131072
    m_l2Power(18) = 262144
    m_l2Power(19) = 524288
    m_l2Power(20) = 1048576
    m_l2Power(21) = 2097152
    m_l2Power(22) = 4194304
    m_l2Power(23) = 8388608
    m_l2Power(24) = 16777216
    m_l2Power(25) = 33554432
    m_l2Power(26) = 67108864
    m_l2Power(27) = 134217728
    m_l2Power(28) = 268435456
    m_l2Power(29) = 536870912
    m_l2Power(30) = 1073741824
    End Sub
    Private Function LShift(ByVal lValue As Long, _
    ByVal iShiftBits As Integer) As Long
    If iShiftBits = 0 Then
    LShift = lValue
    Exit Function
    ElseIf iShiftBits = 31 Then
    If lValue And 1 Then
    LShift = &H80000000
    Else
    LShift = 0
    End If
    Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    err.Raise 6
    End If
    If (lValue And m_l2Power(31 - iShiftBits)) Then
    LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
    m_l2Power(iShiftBits)) Or &H80000000

    Else
    LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
    m_l2Power(iShiftBits))

    End If
    End Function

    Private Function RShift(ByVal lValue As Long, _
    ByVal iShiftBits As Integer) As Long

    If iShiftBits = 0 Then
    RShift = lValue
    Exit Function
    ElseIf iShiftBits = 31 Then
    If lValue And &H80000000 Then
    RShift = 1
    Else
    RShift = 0
    End If
    Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    err.Raise 6
    End If
    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
    If (lValue And &H80000000) Then
    RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
    End Function
    Private Function AddUnsigned(ByVal lX As Long, _
    ByVal lY As Long) As Long
    Dim lX4 As Long
    Dim lY4 As Long
    Dim lX8 As Long
    Dim lY8 As Long
    Dim lResult As Long

    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then
    lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
    If lResult And &H40000000 Then
    lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
    Else
    lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
    End If
    Else
    lResult = lResult Xor lX8 Xor lY8
    End If

    AddUnsigned = lResult
    End Function
    Private Function LRot(ByVal X As Long, ByVal N As Long) As Long
    LRot = LShift(X, N) Or RShift(X, (32 - N))
    End Function
    Private Function ConvertToWordArray(sMessage As String) As Long()
    Dim lMessageLength As Long
    Dim lNumberOfWords As Long
    Dim lWordArray() As Long
    Dim lBytePosition As Long
    Dim lByteCount As Long
    Dim lWordCount As Long
    Dim lByte As Long

    Const MODULUS_BITS As Long = 512
    Const CONGRUENT_BITS As Long = 448

    lMessageLength = Len(sMessage)
    lNumberOfWords = (((lMessageLength + _
    ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
    (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
    (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)
    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
    lWordCount = lByteCount \ BYTES_TO_A_WORD

    lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
    lByte = AscB(Mid(sMessage, lByteCount + 1, 1))

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
    lByteCount = lByteCount + 1
    Loop
    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
    lWordArray(lWordCount) = lWordArray(lWordCount) Or _
    LShift(&H80, lBytePosition)
    lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)

    ConvertToWordArray = lWordArray
    End Function
    Public Function SHA1(sMessage As String) As String
    Dim HASH(4) As Long
    Dim M() As Long
    Dim w(79) As Long
    Dim a, b, C, d, E As Long
    Dim G, H, I, j As Long
    Dim T1, T2 As Long
    HASH(0) = &H67452301
    HASH(1) = &HEFCDAB89
    HASH(2) = &H98BADCFE
    HASH(3) = &H10325476
    HASH(4) = &HC3D2E1F0
    M = ConvertToWordArray(sMessage)
    For I = 0 To UBound(M) Step 16
    a = HASH(0)
    b = HASH(1)
    C = HASH(2)
    d = HASH(3)
    E = HASH(4)
    For G = 0 To 15
    w(G) = M(I + G)
    Next G
    For G = 16 To 79
    w(G) = LRot(w(G - 3) Xor w(G - Cool Xor w(G - 14) Xor w(G - 16), 1)
    Next G
    For j = 0 To 79

    If j <= 19 Then
    T1 = (b And C) Or ((Not b) And d)
    T2 = &H5A827999
    ElseIf j <= 39 Then
    T1 = b Xor C Xor d
    T2 = &H6ED9EBA1
    ElseIf j <= 59 Then
    T1 = (b And C) Or (b And d) Or (C And d)
    T2 = &H8F1BBCDC
    ElseIf j <= 79 Then
    T1 = b Xor C Xor d
    T2 = &HCA62C1D6
    End If
    H = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(LRot(a, 5), T1), E), T2), w(j))
    E = d
    d = C
    C = LRot(b, 30)
    b = a
    a = H
    Next j
    HASH(0) = AddUnsigned(a, HASH(0))
    HASH(1) = AddUnsigned(b, HASH(1))
    HASH(2) = AddUnsigned(C, HASH(2))
    HASH(3) = AddUnsigned(d, HASH(3))
    HASH(4) = AddUnsigned(E, HASH(4))

    Next I
    SHA1 = LCase(Right("00000000" & Hex(HASH(0)), Cool & _
    Right("00000000" & Hex(HASH(1)), Cool & _
    Right("00000000" & Hex(HASH(2)), Cool & _
    Right("00000000" & Hex(HASH(3)), Cool & _
    Right("00000000" & Hex(HASH(4)), Cool)
    End Function

    chamo ele assim

    Dim oSHA1 As New Class1
    Dim LngStart, LngEnd As Long
    LngStart = GetTickCount
    Me.TT = oSHA1.SHA1(Me.chvs)
    LngEnd = GetTickCount
    Set oSHA1 = Nothing
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4771
    Registrado : 06/11/2009

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Assis 18/3/2015, 14:01

    NADIRONUNES

    No debug da erro aqui:

    Dim oSHA1 As New Class1

    Não será falta de uma " Referencia " ?


    .................................................................................
    *** Só sei que nada sei ***
    avatar
    Convidado
    Convidado


    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Convidado 18/3/2015, 14:02

    Dava, se não fosse muito trabalho fazer um pequeno exemplo para mim... Embarassed
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 14:10

    aqui segue um exemplo a bombar

    https://www.dropbox.com/s/7e3hmdg4e82dypz/SHA1.mdb?dl=0

    espero que gostem .

    abraço


    .................................................................................
    _________________________________________________________
    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
    avatar
    Convidado
    Convidado


    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Convidado 18/3/2015, 14:18

    Não consigo baixar, politica da empresa Embarassed
    Da para enviar para meu email?

    Abraço... Cool
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 14:19

    claro da mail


    .................................................................................
    _________________________________________________________
    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
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 15:16

    para quem não consegue baixar aqui vai

    cria um novo modulo e dá o nome CRPTSHA1

    Option Explicit

    Private m_lOnBits(30) As Long
    Private m_l2Power(30) As Long
    Private Const BITS_TO_A_BYTE As Long = 8
    Private Const BYTES_TO_A_WORD As Long = 4
    Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE

    Private Sub Class_Initialize()
    m_lOnBits(0) = 1
    m_lOnBits(1) = 3
    m_lOnBits(2) = 7
    m_lOnBits(3) = 15
    m_lOnBits(4) = 31
    m_lOnBits(5) = 63
    m_lOnBits(6) = 127
    m_lOnBits(7) = 255
    m_lOnBits(Cool = 511
    m_lOnBits(9) = 1023
    m_lOnBits(10) = 2047
    m_lOnBits(11) = 4095
    m_lOnBits(12) = 8191
    m_lOnBits(13) = 16383
    m_lOnBits(14) = 32767
    m_lOnBits(15) = 65535
    m_lOnBits(16) = 131071
    m_lOnBits(17) = 262143
    m_lOnBits(18) = 524287
    m_lOnBits(19) = 1048575
    m_lOnBits(20) = 2097151
    m_lOnBits(21) = 4194303
    m_lOnBits(22) = 8388607
    m_lOnBits(23) = 16777215
    m_lOnBits(24) = 33554431
    m_lOnBits(25) = 67108863
    m_lOnBits(26) = 134217727
    m_lOnBits(27) = 268435455
    m_lOnBits(28) = 536870911
    m_lOnBits(29) = 1073741823
    m_lOnBits(30) = 2147483647

    m_l2Power(0) = 1
    m_l2Power(1) = 2
    m_l2Power(2) = 4
    m_l2Power(3) = 8
    m_l2Power(4) = 16
    m_l2Power(5) = 32
    m_l2Power(6) = 64
    m_l2Power(7) = 128
    m_l2Power(Cool = 256
    m_l2Power(9) = 512
    m_l2Power(10) = 1024
    m_l2Power(11) = 2048
    m_l2Power(12) = 4096
    m_l2Power(13) = 8192
    m_l2Power(14) = 16384
    m_l2Power(15) = 32768
    m_l2Power(16) = 65536
    m_l2Power(17) = 131072
    m_l2Power(18) = 262144
    m_l2Power(19) = 524288
    m_l2Power(20) = 1048576
    m_l2Power(21) = 2097152
    m_l2Power(22) = 4194304
    m_l2Power(23) = 8388608
    m_l2Power(24) = 16777216
    m_l2Power(25) = 33554432
    m_l2Power(26) = 67108864
    m_l2Power(27) = 134217728
    m_l2Power(28) = 268435456
    m_l2Power(29) = 536870912
    m_l2Power(30) = 1073741824
    End Sub

    Private Function LShift(ByVal lValue As Long, _
    ByVal iShiftBits As Integer) As Long
    If iShiftBits = 0 Then
    LShift = lValue
    Exit Function
    ElseIf iShiftBits = 31 Then
    If lValue And 1 Then
    LShift = &H80000000
    Else
    LShift = 0
    End If
    Exit Function

    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    Err.Raise 6
    End If
    If (lValue And m_l2Power(31 - iShiftBits)) Then
    LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
    m_l2Power(iShiftBits)) Or &H80000000

    Else
    LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
    m_l2Power(iShiftBits))

    End If
    End Function
    Private Function RShift(ByVal lValue As Long, _
    ByVal iShiftBits As Integer) As Long

    If iShiftBits = 0 Then
    RShift = lValue
    Exit Function

    ElseIf iShiftBits = 31 Then
    If lValue And &H80000000 Then
    RShift = 1
    Else
    RShift = 0
    End If
    Exit Function

    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    Err.Raise 6
    End If

    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then
    RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
    End Function
    Private Function AddUnsigned(ByVal lX As Long, _
    ByVal lY As Long) As Long
    Dim lX4 As Long
    Dim lY4 As Long
    Dim lX8 As Long
    Dim lY8 As Long
    Dim lResult As Long

    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then
    lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
    If lResult And &H40000000 Then
    lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
    Else
    lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
    End If
    Else
    lResult = lResult Xor lX8 Xor lY8
    End If

    AddUnsigned = lResult
    End Function
    Private Function LRot(ByVal x As Long, ByVal n As Long) As Long
    LRot = LShift(x, n) Or RShift(x, (32 - n))
    End Function
    Private Function ConvertToWordArray(sMessage As String) As Long()
    Dim lMessageLength As Long
    Dim lNumberOfWords As Long
    Dim lWordArray() As Long
    Dim lBytePosition As Long
    Dim lByteCount As Long
    Dim lWordCount As Long
    Dim lByte As Long

    Const MODULUS_BITS As Long = 512
    Const CONGRUENT_BITS As Long = 448

    lMessageLength = Len(sMessage)

    lNumberOfWords = (((lMessageLength + _
    ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
    (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
    (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)

    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
    lWordCount = lByteCount \ BYTES_TO_A_WORD

    lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE

    lByte = AscB(Mid(sMessage, lByteCount + 1, 1))

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
    lByteCount = lByteCount + 1
    Loop

    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
    lWordArray(lWordCount) = lWordArray(lWordCount) Or _
    LShift(&H80, lBytePosition)

    lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)

    ConvertToWordArray = lWordArray
    End Function
    Public Function SHA1(sMessage As String) As String
    Dim HASH(4) As Long
    Dim M() As Long
    Dim W(79) As Long
    Dim a, b, c, d, e As Long
    Dim g, h, i, j As Long
    Dim T1, T2 As Long

    HASH(0) = &H67452301
    HASH(1) = &HEFCDAB89
    HASH(2) = &H98BADCFE
    HASH(3) = &H10325476
    HASH(4) = &HC3D2E1F0

    M = ConvertToWordArray(sMessage)

    For i = 0 To UBound(M) Step 16
    a = HASH(0)
    b = HASH(1)
    c = HASH(2)
    d = HASH(3)
    e = HASH(4)

    For g = 0 To 15
    W(g) = M(i + g)
    Next g

    For g = 16 To 79
    W(g) = LRot(W(g - 3) Xor W(g - Cool Xor W(g - 14) Xor W(g - 16), 1)
    Next g

    For j = 0 To 79

    If j <= 19 Then
    T1 = (b And c) Or ((Not b) And d)
    T2 = &H5A827999
    ElseIf j <= 39 Then
    T1 = b Xor c Xor d
    T2 = &H6ED9EBA1
    ElseIf j <= 59 Then
    T1 = (b And c) Or (b And d) Or (c And d)
    T2 = &H8F1BBCDC
    ElseIf j <= 79 Then
    T1 = b Xor c Xor d
    T2 = &HCA62C1D6
    End If

    h = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(LRot(a, 5), T1), e), T2), W(j))
    e = d
    d = c
    c = LRot(b, 30)
    b = a
    a = h
    Next j

    HASH(0) = AddUnsigned(a, HASH(0))
    HASH(1) = AddUnsigned(b, HASH(1))
    HASH(2) = AddUnsigned(c, HASH(2))
    HASH(3) = AddUnsigned(d, HASH(3))
    HASH(4) = AddUnsigned(e, HASH(4))

    Next i

    SHA1 = LCase(Right("00000000" & Hex(HASH(0)), Cool & _
    Right("00000000" & Hex(HASH(1)), Cool & _
    Right("00000000" & Hex(HASH(2)), Cool & _
    Right("00000000" & Hex(HASH(3)), Cool & _
    Right("00000000" & Hex(HASH(4)), Cool)
    End Function


    no formulario e no evento click(botão)

    Private Sub Comando5_Click()
    Dim oSHA1 As New CRIPTSHA1
    Dim LngStart, LngEnd As Long
    LngStart = GetTickCount
    Me.testeSHA = oSHA1.SHA1(Me.Nome)
    LngEnd = GetTickCount
    Set oSHA1 = Nothing
    End Sub


    .................................................................................
    _________________________________________________________
    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
    Administrador
    Administrador
    Administrador
    Administrador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 425
    Registrado : 02/11/2009

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Administrador 18/3/2015, 15:35

    Tópico movido para Off-Topic.

    Quando tudo estiver direito, será recolocado na sala de Exemplos.


    .................................................................................
    Admin
    avatar
    igornovais
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 10
    Registrado : 20/10/2014

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  igornovais 18/3/2015, 15:54

    Será que esqueci de colocar algo?

    Está aqui o exemplo:
    https://www.dropbox.com/s/a97zkaj6xs74ig0/sha1.mdb?dl=0
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 15:58

    se reparares o exemplo esta acima a funcionar.

    abraço


    .................................................................................
    _________________________________________________________
    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
    Administrador
    Administrador
    Administrador
    Administrador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 425
    Registrado : 02/11/2009

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Administrador 18/3/2015, 16:13

    Exemplo testado e a funcionar.

    Tópico recolocado;

    http://maximoaccess.forumeiros.com/t22400-encriptacao-sha1



    .................................................................................
    Admin
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 16:17

    administrador eu sei que funciona, mas eu ja tinha colocado um antes dele a funcionar, apenas isso.

    cumprimentos


    .................................................................................
    _________________________________________________________
    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
    avatar
    Convidado
    Convidado


    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Convidado 18/3/2015, 17:13

    Boa tarde,

    Já consegui aplicar o código que o nosso amigo Oscar disponibilizou a funfar.
    Só uma pergunta:
    E seu quiser fazer o inverso? Ex: Caso alguém se esqueça da palavra passe, existir
    a possibilidade ao administrador do sistema poder visualiza-la.

    Abraço.. Cool
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 17:16

    nao ha reverso, no caso de passwords tens de ter uma chave unica para todos no caso de se esquecerem dela.

    pelo menos foi a informação que pesquisei

    encriptar via SHA1 ou MD5 é irreverssivel

    Abraço


    .................................................................................
    _________________________________________________________
    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
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11016
    Registrado : 04/11/2009

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  JPaulo 18/3/2015, 17:21

    Estou a gostar de acompanhar e;

    Este código encripta e volta ao normal texto;

    http://maximoaccess.forumeiros.com/t996-encripta-descripta-texto

    E nos 102 Códigos também, o código Encripta ou Decripta Senhas

    http://maximoaccess.forumeiros.com/t11-102-codigos-vba-para-access#14

    É seguro ??? A resposta é Não, não é.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Encriptação SHA1 retificação Folder_announce_new Utilize o Sistema de Busca do Fórum...
    Encriptação SHA1 retificação Folder_announce_new 102 Códigos VBA Gratuitos...
    Encriptação SHA1 retificação Folder_announce_new Instruções SQL como utilizar...
    avatar
    Convidado
    Convidado


    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Convidado 18/3/2015, 17:22

    Ok, Obrigado pela dica.
    Vou criar botão "Repor" com chave unica onde só o Administrador do sistema tenha acesso.

    Abraço... Cool
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 17:27

    Roberto, mas atenção ele fica vulneravel devido a ter a Password de reposição.

    O melhor depois será recadastrar-se para de novo encriptar a password.

    Abraço


    .................................................................................
    _________________________________________________________
    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
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Alvaro Teixeira 18/3/2015, 17:48

    Olá a todos.
    Vejam este excelente artigo do mestre Avelino.
    http://www.usandoaccess.com.br/dicas/dicas-praticas-de-access-parte-4.asp?id=1&idlista=190#inicio
    Abraço


    Última edição por ahteixeira em 20/3/2015, 14:12, editado 1 vez(es)
    ÓscarSantos
    ÓscarSantos
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

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

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos 18/3/2015, 17:53

    mas neste artigo fala em conversão de numeros apenas.

    embora seja um bom artigo sem duvida


    Abraço


    .................................................................................
    _________________________________________________________
    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
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Alvaro Teixeira 20/3/2015, 14:12

    Ola, veja este então:
    http://www.usandoaccess.com.br/tutoriais/video-sistema-shareware-com-libercao-online.asp?id=1#inicio
    Abraço

    Conteúdo patrocinado


    Encriptação SHA1 retificação Empty Re: Encriptação SHA1 retificação

    Mensagem  Conteúdo patrocinado

      Tópicos semelhantes

      -

      Data/hora atual: 29/3/2024, 00:09