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

    Encriptação SHA1 retificação

    Compartilhe
    avatar
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Encriptação SHA1 retificação

    Mensagem  Assis em Qua 18 Mar 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 ***
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ahteixeira em Qua 18 Mar 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
    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: Encriptação SHA1 retificação

    Mensagem  Roberto_1977 em Qua 18 Mar 2015, 11:23

    Bom dia,

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

    Abraço... Cool


    .................................................................................
    Para saber como marcar tópico como [Resolvido] Click Aqui [Você precisa estar registrado e conectado para ver esta imagem.]
    avatar
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  Assis em Qua 18 Mar 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 ***
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 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ó access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ahteixeira em Qua 18 Mar 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

    NADIRONUNES
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  NADIRONUNES em Qua 18 Mar 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
    avatar
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  Assis em Qua 18 Mar 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
    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: Encriptação SHA1 retificação

    Mensagem  Roberto_1977 em Qua 18 Mar 2015, 14:02

    Dava, se não fosse muito trabalho fazer um pequeno exemplo para mim... Embarassed


    .................................................................................
    Para saber como marcar tópico como [Resolvido] Click Aqui [Você precisa estar registrado e conectado para ver esta imagem.]
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 2015, 14:10

    aqui segue um exemplo a bombar

    [Você precisa estar registrado e conectado para ver este link.]

    espero que gostem .

    abraço


    .................................................................................
    _________________________________________________________
    sempre a aprender
    para enviar ou postar só access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: Encriptação SHA1 retificação

    Mensagem  Roberto_1977 em Qua 18 Mar 2015, 14:18

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

    Abraço... Cool


    .................................................................................
    Para saber como marcar tópico como [Resolvido] Click Aqui [Você precisa estar registrado e conectado para ver esta imagem.]
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 2015, 14:19

    claro da mail


    .................................................................................
    _________________________________________________________
    sempre a aprender
    para enviar ou postar só access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 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ó access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Administrador
    Administrador
    Administrador

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  Administrador em Qua 18 Mar 2015, 15:35

    Tópico movido para Off-Topic.

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


    .................................................................................
    Admin

    igornovais
    Novato
    Novato

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  igornovais em Qua 18 Mar 2015, 15:54

    Será que esqueci de colocar algo?

    Está aqui o exemplo:
    [Você precisa estar registrado e conectado para ver este link.]
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 2015, 15:58

    se reparares o exemplo esta acima a funcionar.

    abraço


    .................................................................................
    _________________________________________________________
    sempre a aprender
    para enviar ou postar só access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Administrador
    Administrador
    Administrador

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  Administrador em Qua 18 Mar 2015, 16:13

    Exemplo testado e a funcionar.

    Tópico recolocado;

    [Você precisa estar registrado e conectado para ver este link.]



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

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 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ó access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: Encriptação SHA1 retificação

    Mensagem  Roberto_1977 em Qua 18 Mar 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


    .................................................................................
    Para saber como marcar tópico como [Resolvido] Click Aqui [Você precisa estar registrado e conectado para ver esta imagem.]
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 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ó access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  JPaulo em Qua 18 Mar 2015, 17:21

    Estou a gostar de acompanhar e;

    Este código encripta e volta ao normal texto;

    [Você precisa estar registrado e conectado para ver este link.]

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

    [Você precisa estar registrado e conectado para ver este link.]

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


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

    [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver este link.]

    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: Encriptação SHA1 retificação

    Mensagem  Roberto_1977 em Qua 18 Mar 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


    .................................................................................
    Para saber como marcar tópico como [Resolvido] Click Aqui [Você precisa estar registrado e conectado para ver esta imagem.]
    avatar
    ÓscarSantos
    Avançado
    Avançado

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 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ó access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ahteixeira em Qua 18 Mar 2015, 17:48

    Olá a todos.
    Vejam este excelente artigo do mestre Avelino.
    [Você precisa estar registrado e conectado para ver este link.]
    Abraço


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

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ÓscarSantos em Qua 18 Mar 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ó access2003 infelizmente é o que tenho no trabalho [Você precisa estar registrado e conectado para ver esta imagem.] .
    para dar tópio como resolvido [Você precisa estar registrado e conectado para ver este link.]
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Encriptação SHA1 retificação

    Mensagem  ahteixeira em Sex 20 Mar 2015, 14:12

    Ola, veja este então:
    [Você precisa estar registrado e conectado para ver este link.]
    Abraço

      Data/hora atual: Qua 26 Jul 2017, 03:38