Encriptação SHA1

Olá pessoal, eu tinha um banco de dados MYSQL onde as senhas dos usuários estavam encriptadas utilizando o algoritmo SHA1. Depois de muito garimpar encontrei esse módulo para encriptar textos. No meu caso consegui comparar as senha inserida com a que estava no banco de dados.

Módulo de Classe:
No meu caso eu nomeei o modulo de classe de "SHA".

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 -  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)),  & _
 Right("00000000" & Hex(HASH(1)),  & _
 Right("00000000" & Hex(HASH(2)),  & _
 Right("00000000" & Hex(HASH(3)),  & _
 Right("00000000" & Hex(HASH(4)), 8))
 End Function

Exemplo de uso:

Código:


Option Compare Database

Dim oSHA1 As New SHA

Private Sub botao_Click()
Me.txt2 = oSHA1.SHA1(Me.txt1)
Set oSHA1 = Nothing
End Sub

Exemplo Download:
http://dl.dropboxusercontent.com/u/771097/sha1.zip


Referência: http://www.forosdelweb.com/1935907-post3.html