Skip to content

Instantly share code, notes, and snippets.

@wqweto

wqweto/mdRipeMd160.bas

Created November 1, 2022 20:01
Show Gist options
  • Save wqweto/1e96b9ec2a8fa14d45a2b65904ee085c to your computer and use it in GitHub Desktop.
Save wqweto/1e96b9ec2a8fa14d45a2b65904ee085c to your computer and use it in GitHub Desktop.
Download ZIP
[VB6/VBA] Pure VB6 implementation of RIPEMD-160 hash
Raw
mdRipeMd160.bas
'--- mdRipeMd160.bas
Option Explicit
DefObj A-Z
#Const HasPtrSafe = (VBA7 <> 0)
#Const HasOperators = (TWINBASIC <> 0)
#If HasPtrSafe Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
#End If
Private Const LNG_BLOCKSZ As Long = 64
Private Const LNG_ROUNDS As Long = 80
Private Const LNG_HASHSZ As Long = 20
Public Type CryptoRipeMd160Context
H0 As Long
H1 As Long
H2 As Long
H3 As Long
H4 As Long
Partial(0 To LNG_BLOCKSZ - 1) As Byte
NPartial As Long
NInput As Currency
End Type
Private LNG_R0(0 To LNG_ROUNDS - 1) As Long
Private LNG_R1(0 To LNG_ROUNDS - 1) As Long
Private LNG_S0(0 To LNG_ROUNDS - 1) As Long
Private LNG_S1(0 To LNG_ROUNDS - 1) As Long
#If Not HasOperators Then
Private LNG_POW2(0 To 31) As Long
Private Function RotL32(ByVal lX As Long, ByVal lN As Long) As Long
'--- RotL32 = LShift(X, n) Or RShift(X, 32 - n)
Debug.Assert lN <> 0
RotL32 = ((lX And (LNG_POW2(31 - lN) - 1)) * LNG_POW2(lN) Or -((lX And LNG_POW2(31 - lN)) <> 0) * LNG_POW2(31)) Or _
((lX And (LNG_POW2(31) Xor -1)) \ LNG_POW2(32 - lN) Or -(lX < 0) * LNG_POW2(lN - 1))
End Function
Private Function UAdd32(ByVal lX As Long, ByVal lY As Long) As Long
If (lX Xor lY) >= 0 Then
UAdd32 = ((lX Xor &H80000000) + lY) Xor &H80000000
Else
UAdd32 = lX + lY
End If
End Function
#End If
Public Sub CryptoRipeMd160Init(uCtx As CryptoRipeMd160Context)
Dim vElem As Variant
Dim lIdx As Long
If LNG_R0(0) = 0 Then
For Each vElem In Split("0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 7 4 13 1 10 6 15 3 12 0 9 5 2 14 11 8 3 10 14 4 9 15 8 1 2 7 0 6 13 11 5 12 1 9 11 10 0 8 12 4 13 3 7 15 14 5 6 2 4 0 5 9 7 12 2 10 14 1 3 8 11 6 15 13 5 14 7 0 9 2 11 4 13 6 15 8 1 10 3 12 6 11 3 7 0 13 5 10 14 15 8 12 4 9 1 2 15 5 1 3 7 14 6 9 11 8 12 2 10 0 4 13 8 6 4 1 3 11 15 0 5 12 2 13 9 7 10 14 12 15 10 4 1 5 8 7 6 2 13 14 0 3 9 11")
If lIdx < LNG_ROUNDS Then
LNG_R0(lIdx) = vElem
Else
LNG_R1(lIdx - LNG_ROUNDS) = vElem
End If
lIdx = lIdx + 1
Next
lIdx = 0
For Each vElem In Split("11 14 15 12 5 8 7 9 11 13 14 15 6 7 9 8 7 6 8 13 11 9 7 15 7 12 15 9 11 7 13 12 11 13 6 7 14 9 13 15 14 8 13 6 5 12 7 5 11 12 14 15 14 15 9 8 9 14 5 6 8 6 5 12 9 15 5 11 6 8 13 12 5 12 13 14 11 8 5 6 8 9 9 11 13 15 15 5 7 7 8 11 14 14 12 6 9 13 15 7 12 8 9 11 7 7 12 7 6 15 13 11 9 7 15 11 8 6 6 14 12 13 5 14 13 13 7 5 15 5 8 11 14 14 6 14 6 9 12 9 12 5 15 8 8 5 12 9 12 5 14 6 8 13 6 5 15 13 11 11")
If lIdx < LNG_ROUNDS Then
LNG_S0(lIdx) = vElem
Else
LNG_S1(lIdx - LNG_ROUNDS) = vElem
End If
lIdx = lIdx + 1
Next
#If Not HasOperators Then
If LNG_POW2(0) = 0 Then
LNG_POW2(0) = 1
For lIdx = 1 To 30
LNG_POW2(lIdx) = LNG_POW2(lIdx - 1) * 2
Next
LNG_POW2(31) = &H80000000
End If
#End If
End If
With uCtx
.H0 = &H67452301: .H1 = &HEFCDAB89: .H2 = &H98BADCFE: .H3 = &H10325476: .H4 = &HC3D2E1F0
.NPartial = 0
.NInput = 0
End With
End Sub
#If HasOperators Then
[ IntegerOverflowChecks (False) ]
#End If
Public Sub CryptoRipeMd160Update(uCtx As CryptoRipeMd160Context, baInput() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1)
Static B(0 To 15) As Long
Dim lIdx As Long
Dim lA0 As Long
Dim lB0 As Long
Dim lC0 As Long
Dim lD0 As Long
Dim lE0 As Long
Dim lTemp0 As Long
Dim lK0 As Long
Dim lA1 As Long
Dim lB1 As Long
Dim lC1 As Long
Dim lD1 As Long
Dim lE1 As Long
Dim lTemp1 As Long
Dim lK1 As Long
With uCtx
If Size < 0 Then
Size = UBound(baInput) + 1 - Pos
End If
.NInput = .NInput + Size
If .NPartial > 0 Then
lIdx = LNG_BLOCKSZ - .NPartial
If lIdx > Size Then
lIdx = Size
End If
Call CopyMemory(.Partial(.NPartial), baInput(Pos), lIdx)
.NPartial = .NPartial + lIdx
Pos = Pos + lIdx
Size = Size - lIdx
End If
Do While Size > 0 Or .NPartial = LNG_BLOCKSZ
If .NPartial <> 0 Then
Call CopyMemory(B(0), .Partial(0), LNG_BLOCKSZ)
.NPartial = 0
ElseIf Size >= LNG_BLOCKSZ Then
Call CopyMemory(B(0), baInput(Pos), LNG_BLOCKSZ)
Pos = Pos + LNG_BLOCKSZ
Size = Size - LNG_BLOCKSZ
Else
Call CopyMemory(.Partial(0), baInput(Pos), Size)
.NPartial = Size
Exit Do
End If
'--- RipeMd160 step
lA0 = .H0: lB0 = .H1: lC0 = .H2: lD0 = .H3: lE0 = .H4
lA1 = .H0: lB1 = .H1: lC1 = .H2: lD1 = .H3: lE1 = .H4
For lIdx = 0 To LNG_ROUNDS - 1
Select Case lIdx \ 16
Case 0
lTemp0 = lB0 Xor lC0 Xor lD0
lTemp1 = lB1 Xor (lC1 Or Not lD1)
lK0 = 0: lK1 = &H50A28BE6
Case 1
lTemp0 = (lB0 And lC0) Or (Not lB0 And lD0)
lTemp1 = (lB1 And lD1) Or (lC1 And Not lD1)
lK0 = &H5A827999: lK1 = &H5C4DD124
Case 2
lTemp0 = (lB0 Or Not lC0) Xor lD0
lTemp1 = (lB1 Or Not lC1) Xor lD1
lK0 = &H6ED9EBA1: lK1 = &H6D703EF3
Case 3
lTemp0 = (lB0 And lD0) Or (lC0 And Not lD0)
lTemp1 = (lB1 And lC1) Or (Not lB1 And lD1)
lK0 = &H8F1BBCDC: lK1 = &H7A6D76E9
Case 4
lTemp0 = lB0 Xor (lC0 Or Not lD0)
lTemp1 = lB1 Xor lC1 Xor lD1
lK0 = &HA953FD4E: lK1 = 0
End Select
#If HasOperators Then
lTemp0 += lA0 + B(LNG_R0(lIdx)) + lK0
lTemp0 = (lTemp0 << LNG_S0(lIdx) Or lTemp0 >> (32 - LNG_S0(lIdx))) + lE0
lTemp1 += lA1 + B(LNG_R1(lIdx)) + lK1
lTemp1 = (lTemp1 << LNG_S1(lIdx) Or lTemp1 >> (32 - LNG_S1(lIdx))) + lE1
#Else
lTemp0 = UAdd32(RotL32(UAdd32(UAdd32(UAdd32(lTemp0, lA0), B(LNG_R0(lIdx))), lK0), LNG_S0(lIdx)), lE0)
lTemp1 = UAdd32(RotL32(UAdd32(UAdd32(UAdd32(lTemp1, lA1), B(LNG_R1(lIdx))), lK1), LNG_S1(lIdx)), lE1)
#End If
lA0 = lE0: lA1 = lE1
lE0 = lD0: lE1 = lD1
#If HasOperators Then
lD0 = (lC0 << 10 Or lC0 >> 22): lD1 = (lC1 << 10 Or lC1 >> 22)
#Else
lD0 = RotL32(lC0, 10): lD1 = RotL32(lC1, 10)
#End If
lC0 = lB0: lC1 = lB1
lB0 = lTemp0: lB1 = lTemp1
Next
#If HasOperators Then
lTemp0 = .H1 + lC0 + lD1
.H1 = .H2 + lD0 + lE1
.H2 = .H3 + lE0 + lA1
.H3 = .H4 + lA0 + lB1
.H4 = .H0 + lB0 + lC1
.H0 = lTemp0
#Else
lTemp0 = UAdd32(UAdd32(.H1, lC0), lD1)
.H1 = UAdd32(UAdd32(.H2, lD0), lE1)
.H2 = UAdd32(UAdd32(.H3, lE0), lA1)
.H3 = UAdd32(UAdd32(.H4, lA0), lB1)
.H4 = UAdd32(UAdd32(.H0, lB0), lC1)
.H0 = lTemp0
#End If
Loop
End With
End Sub
Public Sub CryptoRipeMd160Finalize(uCtx As CryptoRipeMd160Context, baOutput() As Byte)
Static B(0 To 4) As Long
Dim P(0 To LNG_BLOCKSZ + 9) As Byte
Dim lSize As Long
With uCtx
lSize = LNG_BLOCKSZ - .NPartial
If lSize < 9 Then
lSize = lSize + LNG_BLOCKSZ
End If
P(0) = &H80
.NInput = .NInput / 10000@ * 8
Call CopyMemory(P(lSize - 8), .NInput, 8)
CryptoRipeMd160Update uCtx, P, Size:=lSize
Debug.Assert .NPartial = 0
B(0) = .H0: B(1) = .H1: B(2) = .H2: B(3) = .H3: B(4) = .H4
ReDim baOutput(0 To LNG_HASHSZ - 1) As Byte
Call CopyMemory(baOutput(0), B(0), UBound(baOutput) + 1)
End With
End Sub
Public Function CryptoRipeMd160ByteArray(baInput() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1) As Byte()
Dim uCtx As CryptoRipeMd160Context
CryptoRipeMd160Init uCtx
CryptoRipeMd160Update uCtx, baInput, Pos, Size
CryptoRipeMd160Finalize uCtx, CryptoRipeMd160ByteArray
End Function
Private Function ToUtf8Array(sText As String) As Byte()
Const CP_UTF8 As Long = 65001
Dim baRetVal() As Byte
Dim lSize As Long
lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), ByVal 0, 0, 0, 0)
If lSize > 0 Then
ReDim baRetVal(0 To lSize - 1) As Byte
Call WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), baRetVal(0), lSize, 0, 0)
Else
baRetVal = vbNullString
End If
ToUtf8Array = baRetVal
End Function
Private Function ToHex(baData() As Byte) As String
Dim lIdx As Long
Dim sByte As String
ToHex = String$(UBound(baData) * 2 + 2, 48)
For lIdx = 0 To UBound(baData)
sByte = LCase$(Hex$(baData(lIdx)))
If Len(sByte) = 1 Then
Mid$(ToHex, lIdx * 2 + 2, 1) = sByte
Else
Mid$(ToHex, lIdx * 2 + 1, 2) = sByte
End If
Next
End Function
Public Function CryptoRipeMd160Text(sText As String) As String
CryptoRipeMd160Text = ToHex(CryptoRipeMd160ByteArray(ToUtf8Array(sText)))
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment