SHA1("") = da39a3ee5e6b4b0d3255bfef95601890afd80709
En un Modulo Clase(Class1):
Option ExplicitPrivate m_lOnBits(30) As LongPrivate m_l2Power(30) As LongPrivate Const BITS_TO_A_BYTE As Long = 8Private Const BYTES_TO_A_WORD As Long = 4Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTEPrivate 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) = 1073741824End SubPrivate 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 IfEnd FunctionPrivate 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 IfEnd FunctionPrivate 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 = lResultEnd FunctionPrivate Function LRot(ByVal x As Long, ByVal n As Long) As Long LRot = LShift(x, n) Or RShift(x, (32 - n))End FunctionPrivate 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 = lWordArrayEnd FunctionPublic 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
En el formulario:
Option ExplicitPrivate Declare Function GetTickCount Lib "kernel32" () As LongPrivate Sub Command1_Click() Dim oSHA1 As New Class1 Dim LngStart, LngEnd As Long LngStart = GetTickCount Text2.Text = oSHA1.SHA1(Text1.Text) LngEnd = GetTickCount Set oSHA1 = Nothing MsgBox "La Encriptacion Duro: " & LngEnd - LngStart & " milisegundos", vbInformation + vbOKOnly, "Enciptacion SHA-1"End SubPrivate Function BinaryRead(ByRef sFileName As String) As String Dim fh As Integer fh = FreeFile Open sFileName For Binary As #fh BinaryRead = Input$(LOF(fh), fh) Close #fhEnd FunctionPrivate Sub Command2_Click() With CommonDialog1 .Filter = "Archivos de texto|*.txt" .DialogTitle = "Selecciona un archivo para encriptar" .ShowOpen If .FileName = "" Then Exit Sub End With Dim oSHA1 As New Class1 Dim LngStart, LngEnd As Long Dim sFile As String Me.MousePointer = 11 sFile = BinaryRead(CommonDialog1.FileName) LngStart = GetTickCount Text2.Text = oSHA1.SHA1(sFile) LngEnd = GetTickCount Set oSHA1 = Nothing Me.MousePointer = 0 MsgBox "La Encriptacion Duro: " & LngEnd - LngStart & " milisegundos" & vbCrLf & "en " & Format(Len(sFile), "###,###,###,##0") & " byte de archivo.", vbInformation + vbOKOnly, "Enciptacion SHA-1"End Sub
Bien gracias por compartir , una duda se puede hacer en visual basic 6?
Interesante info, gracias por compartirla, en cuanto a SHA-3 no sabia que era conocido como Keccak, buen dato Krakakanok