MD5 Message Digest Algorithm for Implementing Digital Signatures 2

 MD5 Message Digest Algorithm for Implementing Digital Signatures 2.

'*******************************************************************************
' MODULE:       MD5Hash
' CREATED:      16-Feb-2001 Phil Fresle
' REV:          26-Oct-2006 Anonymous
'
' DESCRIPTION:
' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
'
' This class is used to generate an MD5 'digest' or 'signature' of a string. The
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack. If you are using the
' routine for passwords, you can make it a little more secure by concatenating
' some known random characters to the password before you generate the signature
' and on subsequent tests, so even if a hacker knows you are using MD5 for
' your passwords, the random characters will make it harder to dictionary attack.
'
' *** CAUTION ***
' See the comment attached to the MD5 method below regarding use on systems
' with different character sets.
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on this code provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site:  http://www.frez.co.uk
' E-mail:    sales@frez.co.uk
'
' MODIFICATION HISTORY:
' 1.0       16-Feb-2001
'           Phil Fresle
'           Initial Version
' 1.1       26-Oct-2006
'           Added MD5File
'*******************************************************************************
Option Explicit

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 m_lOnBits(0 To 30) As Long
Private m_l2Power(0 To 30) As Long

Sub InitConstArrays()

' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - BITS SET FROM RIGHT
m_lOnBits(0) = 1            ' 00000000000000000000000000000001
m_lOnBits(1) = 3            ' 00000000000000000000000000000011
m_lOnBits(2) = 7            ' 00000000000000000000000000000111
m_lOnBits(3) = 15           ' 00000000000000000000000000001111
m_lOnBits(4) = 31           ' 00000000000000000000000000011111
m_lOnBits(5) = 63           ' 00000000000000000000000000111111
m_lOnBits(6) = 127          ' 00000000000000000000000001111111
m_lOnBits(7) = 255          ' 00000000000000000000000011111111
m_lOnBits(8) = 511          ' 00000000000000000000000111111111
m_lOnBits(9) = 1023         ' 00000000000000000000001111111111
m_lOnBits(10) = 2047        ' 00000000000000000000011111111111
m_lOnBits(11) = 4095        ' 00000000000000000000111111111111
m_lOnBits(12) = 8191        ' 00000000000000000001111111111111
m_lOnBits(13) = 16383       ' 00000000000000000011111111111111
m_lOnBits(14) = 32767       ' 00000000000000000111111111111111
m_lOnBits(15) = 65535       ' 00000000000000001111111111111111
m_lOnBits(16) = 131071      ' 00000000000000011111111111111111
m_lOnBits(17) = 262143      ' 00000000000000111111111111111111
m_lOnBits(18) = 524287      ' 00000000000001111111111111111111
m_lOnBits(19) = 1048575     ' 00000000000011111111111111111111
m_lOnBits(20) = 2097151     ' 00000000000111111111111111111111
m_lOnBits(21) = 4194303     ' 00000000001111111111111111111111
m_lOnBits(22) = 8388607     ' 00000000011111111111111111111111
m_lOnBits(23) = 16777215    ' 00000000111111111111111111111111
m_lOnBits(24) = 33554431    ' 00000001111111111111111111111111
m_lOnBits(25) = 67108863    ' 00000011111111111111111111111111
m_lOnBits(26) = 134217727   ' 00000111111111111111111111111111
m_lOnBits(27) = 268435455   ' 00001111111111111111111111111111
m_lOnBits(28) = 536870911   ' 00011111111111111111111111111111
m_lOnBits(29) = 1073741823  ' 00111111111111111111111111111111
m_lOnBits(30) = 2147483647  ' 01111111111111111111111111111111

' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - POWERS OF 2
m_l2Power(0) = 1            ' 00000000000000000000000000000001
m_l2Power(1) = 2            ' 00000000000000000000000000000010
m_l2Power(2) = 4            ' 00000000000000000000000000000100
m_l2Power(3) = 8            ' 00000000000000000000000000001000
m_l2Power(4) = 16           ' 00000000000000000000000000010000
m_l2Power(5) = 32           ' 00000000000000000000000000100000
m_l2Power(6) = 64           ' 00000000000000000000000001000000
m_l2Power(7) = 128          ' 00000000000000000000000010000000
m_l2Power(8) = 256          ' 00000000000000000000000100000000
m_l2Power(9) = 512          ' 00000000000000000000001000000000
m_l2Power(10) = 1024        ' 00000000000000000000010000000000
m_l2Power(11) = 2048        ' 00000000000000000000100000000000
m_l2Power(12) = 4096        ' 00000000000000000001000000000000
m_l2Power(13) = 8192        ' 00000000000000000010000000000000
m_l2Power(14) = 16384       ' 00000000000000000100000000000000
m_l2Power(15) = 32768       ' 00000000000000001000000000000000
m_l2Power(16) = 65536       ' 00000000000000010000000000000000
m_l2Power(17) = 131072      ' 00000000000000100000000000000000
m_l2Power(18) = 262144      ' 00000000000001000000000000000000
m_l2Power(19) = 524288      ' 00000000000010000000000000000000
m_l2Power(20) = 1048576     ' 00000000000100000000000000000000
m_l2Power(21) = 2097152     ' 00000000001000000000000000000000
m_l2Power(22) = 4194304     ' 00000000010000000000000000000000
m_l2Power(23) = 8388608     ' 00000000100000000000000000000000
m_l2Power(24) = 16777216    ' 00000001000000000000000000000000
m_l2Power(25) = 33554432    ' 00000010000000000000000000000000
m_l2Power(26) = 67108864    ' 00000100000000000000000000000000
m_l2Power(27) = 134217728   ' 00001000000000000000000000000000
m_l2Power(28) = 268435456   ' 00010000000000000000000000000000
m_l2Power(29) = 536870912   ' 00100000000000000000000000000000
m_l2Power(30) = 1073741824  ' 01000000000000000000000000000000

End Sub
'*******************************************************************************
' LShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' A left shift takes all the set binary bits and moves them left, in-filling
' with zeros in the vacated bits on the right. This function is equivalent to
' the << operator in Java and C++
'*******************************************************************************
Private Function LShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long

' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all.
If iShiftBits = 0 Then
   LShift = lValue
   Exit Function

' A shift of 31 will result in the right most bit becoming the left most
' bit and all other bits being cleared
ElseIf iShiftBits = 31 Then
   If lValue And 1 Then
      LShift = &H80000000
   Else
      LShift = 0
   End If
   Exit Function

' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
   Err.Raise 6
End If

' If the left most bit that remains will end up in the negative bit
' position (&H80000000) we would end up with an overflow if we took the
' standard route. We need to strip the left most bit and add it back
' afterwards.
If (lValue And m_l2Power(31 - iShiftBits)) Then

   ' (Value And OnBits(31 - (Shift + 1))) chops off the left most bits that
   ' we are shifting into, but also the left most bit we still want as this
   ' is going to end up in the negative bit marker position (&H80000000).
   ' After the multiplication/shift we Or the result with &H80000000 to
   ' turn the negative bit on.
   LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000

Else

   ' (Value And OnBits(31-Shift)) chops off the left most bits that we are
   ' shifting into so we do not get an overflow error when we do the
   ' multiplication/shift
   LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))

End If

End Function

'*******************************************************************************
' RShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' The right shift of an unsigned long integer involves shifting all the set bits
' to the right and in-filling on the left with zeros. This function is
' equivalent to the >>> operator in Java or the >> operator in C++ when used on
' an unsigned long.
'*******************************************************************************
Private Function RShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long

' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all
If iShiftBits = 0 Then
   RShift = lValue
   Exit Function

' A shift of 31 will clear all bits and move the left most bit to the right
' most bit position
ElseIf iShiftBits = 31 Then
   If lValue And &H80000000 Then
      RShift = 1
   Else
      RShift = 0
   End If
   Exit Function

' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
   Err.Raise 6
End If

' We do not care about the top most bit or the final bit, the top most bit
' will be taken into account in the next stage, the final bit (whether it
' is an odd number or not) is being shifted into, so we do not give a jot
' about it
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

' If the top most bit (&H80000000) was set we need to do things differently
' as in a normal VB signed long integer the top most bit is used to indicate
' the sign of the number, when it is set it is a negative number, so just
' deviding by a factor of 2 as above would not work.
' NOTE: (lValue And  &H80000000) is equivalent to (lValue < 0), you could
' get a very marginal speed improvement by changing the test to (lValue < 0)
If (lValue And &H80000000) Then
   ' We take the value computed so far, and then add the left most negative
   ' bit after it has been shifted to the right the appropriate number of
   ' places
   RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If

End Function

'*******************************************************************************
' RShiftSigned (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    -
' (In) - iShiftBits - Integer -
'
' RETURN VALUE:
' Long -
'
' DESCRIPTION:
' The right shift of a signed long integer involves shifting all the set bits to
' the right and in-filling on the left with the sign bit (0 if positive, 1 if
' negative. This function is equivalent to the >> operator in Java or the >>
' operator in C++ when used on a signed long integer. Not used in this class,
' but included for completeness.
'*******************************************************************************
Private Function RShiftSigned(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long

' NOTE: If you can guarantee that the Shift parameter will be in the
' range 1 to 30 you can safely strip of this first nested if structure for
' speed.
'
' A shift of zero is no shift at all
If iShiftBits = 0 Then
   RShiftSigned = lValue
   Exit Function

' A shift of 31 will clear all bits if the left most bit was zero, and will
' set all bits if the left most bit was 1 (a negative indicator)
ElseIf iShiftBits = 31 Then

   ' NOTE: (lValue And  &H80000000) is equivalent to (lValue < 0), you
   ' could get a very marginal speed improvement by changing the test to
   ' (lValue < 0)
   If (lValue And &H80000000) Then
      RShiftSigned = -1
   Else
      RShiftSigned = 0
   End If
   Exit Function

' A shift of less than zero or more than 31 is undefined
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
   Err.Raise 6
End If

' We get the same result by dividing by the appropriate power of 2 and
' rounding in the negative direction
RShiftSigned = Int(lValue / m_l2Power(iShiftBits))

End Function

'*******************************************************************************
' RotateLeft (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - Value to act on
' (In) - iShiftBits - Integer - Bits to move by
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Rotates the bits in a long integer to the left, those bits falling off the
' left edge are put back on the right edge
'*******************************************************************************
Private Function RotateLeft(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long

RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))

End Function

'*******************************************************************************
' AddUnsigned (FUNCTION)
'
' PARAMETERS:
' (In) - lX - Long - First value
' (In) - lY - Long - Second value
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Adds two potentially large unsigned numbers without overflowing
'*******************************************************************************
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

'*******************************************************************************
' F (FUNCTION)
'
' DESCRIPTION:
' MD5's F function
'*******************************************************************************
Private Function F(ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long

F = (x And y) Or ((Not x) And z)

End Function

'*******************************************************************************
' G (FUNCTION)
'
' DESCRIPTION:
' MD5's G function
'*******************************************************************************
Private Function G(ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long

G = (x And z) Or (y And (Not z))

End Function

'*******************************************************************************
' H (FUNCTION)
'
' DESCRIPTION:
' MD5's H function
'*******************************************************************************
Private Function H(ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long

H = (x Xor y Xor z)

End Function

'*******************************************************************************
' I (FUNCTION)
'
' DESCRIPTION:
' MD5's I function
'*******************************************************************************
Private Function I(ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long

I = (y Xor (x Or (Not z)))

End Function

'*******************************************************************************
' FF (SUB)
'
' DESCRIPTION:
' MD5's FF procedure
'*******************************************************************************
Private Sub FF(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Long, ByVal ac As Long)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)

End Sub

'*******************************************************************************
' GG (SUB)
'
' DESCRIPTION:
' MD5's GG procedure
'*******************************************************************************
Private Sub GG(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Long, ByVal ac As Long)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)

End Sub

'*******************************************************************************
' HH (SUB)
'
' DESCRIPTION:
' MD5's HH procedure
'*******************************************************************************
Private Sub HH(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Long, ByVal ac As Long)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)

End Sub

'*******************************************************************************
' II (SUB)
'
' DESCRIPTION:
' MD5's II procedure
'*******************************************************************************
Private Sub II(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Long, ByVal ac As Long)

a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)

End Sub

'*******************************************************************************
' ConvertToWordArray (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sMessage - String - String message
'
' RETURN VALUE:
' Long() - Converted message as long array
'
' DESCRIPTION:
' Takes the string message and puts it in a long array with padding according to
' the MD5 rules.
'*******************************************************************************
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

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

lMessageLength = Len(sMessage)

' Get padded number of words. Message needs to be congruent to 448 bits,
' modulo 512 bits. If it is exactly congruent to 448 bits, modulo 512 bits
' it must still have another 512 bits added. 512 bits = 64 bytes
' (or 16 * 4 byte words), 448 bits = 56 bytes. This means lMessageSize must
' be a multiple of 16 (i.e. 16 * 4 (bytes) * 8 (bits))
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)

' Combine each block of 4 bytes (ascii code of character) into one long
' value and store in the message. The high-order (most significant) bit of
' each byte is listed first. However, the low-order (least significant) byte
' is given first in each word.
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
   ' Each word is 4 bytes
   lWordCount = lByteCount \ BYTES_TO_A_WORD

   ' The bytes are put in the word from the right most edge
   lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
   lWordArray(lWordCount) = lWordArray(lWordCount) Or _
      LShift(AscB(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
   lByteCount = lByteCount + 1
Loop

' Terminate according to MD5 rules with a 1 bit, zeros and the length in
' bits stored in the last two words
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

' Add a terminating 1 bit, all the rest of the bits to the end of the
' word array will default to zero
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

' We put the length of the message in bits into the last two words, to get
' the length in bits we need to multiply by 8 (or left shift 3). This left
' shifted value is put in the first word. Any bits shifted off the left edge
' need to be put in the second word, we can work out which bits by shifting
' right the length by 29 bits.
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

ConvertToWordArray = lWordArray

End Function

'*******************************************************************************
' WordToHex (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long - Long value to convert
'
' RETURN VALUE:
' String - Hex value to return
'
' DESCRIPTION:
' Takes a long integer and due to the bytes reverse order it extracts the
' individual bytes and converts them to hex appending them for an overall hex
' value
'*******************************************************************************
Private Function WordToHex(ByVal lValue As Long) As String

Dim lByte As Long
Dim lCount As Long

For lCount = 0 To 3
   lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
   WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next

End Function

'*******************************************************************************
' MD5File (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sFileName - String - File containing String to be digested
'
' RETURN VALUE:
' String - The MD5 digest
'
' DESCRIPTION:
' This function takes a file and generates an MD5 digest for it.
' File length can be up to the VB string length limit of 2^31 (approx. 2 billion)
' bytes.
'
' EXAMPLE:
'Dim FileName As String
'Dim unit As Integer
'Dim TestString As String
'Dim ExpectedDigest As String
'
'FileName = "c:\killme.txt"
'TestString = "abc"
'ExpectedDigest = "900150983cd24fb0d6963f7d28e17f72"
'
'If Len(Dir(FileName)) Then Kill FileName
'unit = FreeFile
'Open FileName For Binary As #unit
'Put #unit, 1, TestString
'Close #unit
'
'MsgBox "String: " + TestString + vbCrLf + "Expected: " + ExpectedDigest + vbCrLf + "Actual: " + MD5File(FileName)
'*******************************************************************************
Public Function MD5File(sFileName As String) As String

Dim x() As Long
Dim k   As Long
Dim AA  As Long
Dim BB  As Long
Dim CC  As Long
Dim DD  As Long
Dim a   As Long
Dim b   As Long
Dim c   As Long
Dim d   As Long

Const S11 As Long = 7
Const S12 As Long = 12
Const S13 As Long = 17
Const S14 As Long = 22
Const S21 As Long = 5
Const S22 As Long = 9
Const S23 As Long = 14
Const S24 As Long = 20
Const S31 As Long = 4
Const S32 As Long = 11
Const S33 As Long = 16
Const S34 As Long = 23
Const S41 As Long = 6
Const S42 As Long = 10
Const S43 As Long = 15
Const S44 As Long = 21

' fill constant arrays
InitConstArrays

' Steps 1 and 2. Append padding bits and length and convert to words when file is exhausted

' Step 3.  Initialise
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476

ReDim x(0 To 15) As Long

Dim unit As Integer
Dim lMessageLength As Long
Dim lBytesSoFar As Long
Dim StopBitSetFlag As Boolean
Dim DoneFlag As Boolean
Dim widx As Integer
Dim bitstoshift As Integer

' file assumed to exist, otherwise, 0-byte file created
unit = FreeFile
Open sFileName For Binary Access Read As #unit
lMessageLength = LOF(unit)
lBytesSoFar = 0
StopBitSetFlag = False
DoneFlag = False

' loop until file is exhausted and size words are addressed
Do
   ' Get will read what it can, even 0 bytes past end of file, and fill remainder with 0's
   Get #unit, lBytesSoFar + 1, x
   lBytesSoFar = lBytesSoFar + 64
   ' see if done with file
   If lBytesSoFar > lMessageLength Then
      ' set stop bit if not already done
      If Not StopBitSetFlag Then
         widx = (lMessageLength \ BYTES_TO_A_WORD) Mod 16
         bitstoshift = (lMessageLength Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
         x(widx) = x(widx) Or LShift(&H80, bitstoshift)
         StopBitSetFlag = True
      End If
      ' see if there's room for the 2 words (8 bytes) of message length
      If lBytesSoFar - lMessageLength > 8 Then
         ' put the length of the message (in bits) into the last two words
         x(14) = LShift(lMessageLength, 3)
         x(15) = RShift(lMessageLength, 29)
         DoneFlag = True
      Else
         ' keep going with new 64-byte block
         DoneFlag = False
      End If
   End If

   ' Step 4.  Process the message in 16-word blocks
   AA = a
   BB = b
   CC = c
   DD = d

   ' The hex number on the end of each of the following procedure calls is
   ' an element from the 64 element table constructed with
   ' T(i) = Int(4294967296 * Abs(Sin(i))) where i is 1 to 64.
   '
   ' However, for speed we don't want to calculate the value every time.
   FF a, b, c, d, x(k + 0), S11, &HD76AA478
   FF d, a, b, c, x(k + 1), S12, &HE8C7B756
   FF c, d, a, b, x(k + 2), S13, &H242070DB
   FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
   FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
   FF d, a, b, c, x(k + 5), S12, &H4787C62A
   FF c, d, a, b, x(k + 6), S13, &HA8304613
   FF b, c, d, a, x(k + 7), S14, &HFD469501
   FF a, b, c, d, x(k + 8), S11, &H698098D8
   FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
   FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
   FF b, c, d, a, x(k + 11), S14, &H895CD7BE
   FF a, b, c, d, x(k + 12), S11, &H6B901122
   FF d, a, b, c, x(k + 13), S12, &HFD987193
   FF c, d, a, b, x(k + 14), S13, &HA679438E
   FF b, c, d, a, x(k + 15), S14, &H49B40821

   GG a, b, c, d, x(k + 1), S21, &HF61E2562
   GG d, a, b, c, x(k + 6), S22, &HC040B340
   GG c, d, a, b, x(k + 11), S23, &H265E5A51
   GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
   GG a, b, c, d, x(k + 5), S21, &HD62F105D
   GG d, a, b, c, x(k + 10), S22, &H2441453
   GG c, d, a, b, x(k + 15), S23, &HD8A1E681
   GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
   GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
   GG d, a, b, c, x(k + 14), S22, &HC33707D6
   GG c, d, a, b, x(k + 3), S23, &HF4D50D87
   GG b, c, d, a, x(k + 8), S24, &H455A14ED
   GG a, b, c, d, x(k + 13), S21, &HA9E3E905
   GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
   GG c, d, a, b, x(k + 7), S23, &H676F02D9
   GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A

   HH a, b, c, d, x(k + 5), S31, &HFFFA3942
   HH d, a, b, c, x(k + 8), S32, &H8771F681
   HH c, d, a, b, x(k + 11), S33, &H6D9D6122
   HH b, c, d, a, x(k + 14), S34, &HFDE5380C
   HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
   HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
   HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
   HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
   HH a, b, c, d, x(k + 13), S31, &H289B7EC6
   HH d, a, b, c, x(k + 0), S32, &HEAA127FA
   HH c, d, a, b, x(k + 3), S33, &HD4EF3085
   HH b, c, d, a, x(k + 6), S34, &H4881D05
   HH a, b, c, d, x(k + 9), S31, &HD9D4D039
   HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
   HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
   HH b, c, d, a, x(k + 2), S34, &HC4AC5665

   II a, b, c, d, x(k + 0), S41, &HF4292244
   II d, a, b, c, x(k + 7), S42, &H432AFF97
   II c, d, a, b, x(k + 14), S43, &HAB9423A7
   II b, c, d, a, x(k + 5), S44, &HFC93A039
   II a, b, c, d, x(k + 12), S41, &H655B59C3
   II d, a, b, c, x(k + 3), S42, &H8F0CCC92
   II c, d, a, b, x(k + 10), S43, &HFFEFF47D
   II b, c, d, a, x(k + 1), S44, &H85845DD1
   II a, b, c, d, x(k + 8), S41, &H6FA87E4F
   II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
   II c, d, a, b, x(k + 6), S43, &HA3014314
   II b, c, d, a, x(k + 13), S44, &H4E0811A1
   II a, b, c, d, x(k + 4), S41, &HF7537E82
   II d, a, b, c, x(k + 11), S42, &HBD3AF235
   II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
   II b, c, d, a, x(k + 9), S44, &HEB86D391

   a = AddUnsigned(a, AA)
   b = AddUnsigned(b, BB)
   c = AddUnsigned(c, CC)
   d = AddUnsigned(d, DD)

   If DoneFlag Then Exit Do
Loop
Close #unit

' Step 5.  Output the 128 bit digest
MD5File = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))

End Function

'*******************************************************************************
' MD5 (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sMessage - String - String to be digested
'
' RETURN VALUE:
' String - The MD5 digest
'
' DESCRIPTION:
' This function takes a string message and generates an MD5 digest for it.
' sMessage can be up to the VB string length limit of 2^31 (approx. 2 billion)
' characters.
'
' NOTE: Due to the way in which the string is processed the routine assumes a
' single byte character set. VB passes unicode (2-byte) character strings, the
' ConvertToWordArray function uses on the first byte for each character. This
' has been done this way for ease of use, to make the routine truely portable
' you could accept a byte array instead, it would then be up to the calling
' routine to make sure that the byte array is generated from their string in
' a manner consistent with the string type.
'*******************************************************************************
Public Function MD5(sMessage As String) As String

Dim x() As Long
Dim k   As Long
Dim AA  As Long
Dim BB  As Long
Dim CC  As Long
Dim DD  As Long
Dim a   As Long
Dim b   As Long
Dim c   As Long
Dim d   As Long

Const S11 As Long = 7
Const S12 As Long = 12
Const S13 As Long = 17
Const S14 As Long = 22
Const S21 As Long = 5
Const S22 As Long = 9
Const S23 As Long = 14
Const S24 As Long = 20
Const S31 As Long = 4
Const S32 As Long = 11
Const S33 As Long = 16
Const S34 As Long = 23
Const S41 As Long = 6
Const S42 As Long = 10
Const S43 As Long = 15
Const S44 As Long = 21

' fill constant arrays
InitConstArrays

' Steps 1 and 2.  Append padding bits and length and convert to words
x = ConvertToWordArray(sMessage)

' Step 3.  Initialise
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476

' Step 4.  Process the message in 16-word blocks
For k = 0 To UBound(x) Step 16
   AA = a
   BB = b
   CC = c
   DD = d

   ' The hex number on the end of each of the following procedure calls is
   ' an element from the 64 element table constructed with
   ' T(i) = Int(4294967296 * Abs(Sin(i))) where i is 1 to 64.
   '
   ' However, for speed we don't want to calculate the value every time.
   FF a, b, c, d, x(k + 0), S11, &HD76AA478
   FF d, a, b, c, x(k + 1), S12, &HE8C7B756
   FF c, d, a, b, x(k + 2), S13, &H242070DB
   FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
   FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
   FF d, a, b, c, x(k + 5), S12, &H4787C62A
   FF c, d, a, b, x(k + 6), S13, &HA8304613
   FF b, c, d, a, x(k + 7), S14, &HFD469501
   FF a, b, c, d, x(k + 8), S11, &H698098D8
   FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
   FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
   FF b, c, d, a, x(k + 11), S14, &H895CD7BE
   FF a, b, c, d, x(k + 12), S11, &H6B901122
   FF d, a, b, c, x(k + 13), S12, &HFD987193
   FF c, d, a, b, x(k + 14), S13, &HA679438E
   FF b, c, d, a, x(k + 15), S14, &H49B40821

   GG a, b, c, d, x(k + 1), S21, &HF61E2562
   GG d, a, b, c, x(k + 6), S22, &HC040B340
   GG c, d, a, b, x(k + 11), S23, &H265E5A51
   GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
   GG a, b, c, d, x(k + 5), S21, &HD62F105D
   GG d, a, b, c, x(k + 10), S22, &H2441453
   GG c, d, a, b, x(k + 15), S23, &HD8A1E681
   GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
   GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
   GG d, a, b, c, x(k + 14), S22, &HC33707D6
   GG c, d, a, b, x(k + 3), S23, &HF4D50D87
   GG b, c, d, a, x(k + 8), S24, &H455A14ED
   GG a, b, c, d, x(k + 13), S21, &HA9E3E905
   GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
   GG c, d, a, b, x(k + 7), S23, &H676F02D9
   GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A

   HH a, b, c, d, x(k + 5), S31, &HFFFA3942
   HH d, a, b, c, x(k + 8), S32, &H8771F681
   HH c, d, a, b, x(k + 11), S33, &H6D9D6122
   HH b, c, d, a, x(k + 14), S34, &HFDE5380C
   HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
   HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
   HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
   HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
   HH a, b, c, d, x(k + 13), S31, &H289B7EC6
   HH d, a, b, c, x(k + 0), S32, &HEAA127FA
   HH c, d, a, b, x(k + 3), S33, &HD4EF3085
   HH b, c, d, a, x(k + 6), S34, &H4881D05
   HH a, b, c, d, x(k + 9), S31, &HD9D4D039
   HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
   HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
   HH b, c, d, a, x(k + 2), S34, &HC4AC5665

   II a, b, c, d, x(k + 0), S41, &HF4292244
   II d, a, b, c, x(k + 7), S42, &H432AFF97
   II c, d, a, b, x(k + 14), S43, &HAB9423A7
   II b, c, d, a, x(k + 5), S44, &HFC93A039
   II a, b, c, d, x(k + 12), S41, &H655B59C3
   II d, a, b, c, x(k + 3), S42, &H8F0CCC92
   II c, d, a, b, x(k + 10), S43, &HFFEFF47D
   II b, c, d, a, x(k + 1), S44, &H85845DD1
   II a, b, c, d, x(k + 8), S41, &H6FA87E4F
   II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
   II c, d, a, b, x(k + 6), S43, &HA3014314
   II b, c, d, a, x(k + 13), S44, &H4E0811A1
   II a, b, c, d, x(k + 4), S41, &HF7537E82
   II d, a, b, c, x(k + 11), S42, &HBD3AF235
   II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
   II b, c, d, a, x(k + 9), S44, &HEB86D391

   a = AddUnsigned(a, AA)
   b = AddUnsigned(b, BB)
   c = AddUnsigned(c, CC)
   d = AddUnsigned(d, DD)
Next

' Step 5.  Output the 128 bit digest
MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))

End Function

 

This entry was posted in Uncategorized. Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s