Check Sum Module Usage 2

[M626]

I found this module to create checksums of files. Does anyone have any idea how to use it?

Option Explicit
Option Base 0


Private Const MD5_BLK_LEN As Long = 64
' Constants for MD5Transform routine
Private Const S11 As Long = 7
Private Const S12 As Long = 12
Private Const S13 As Long = 17
Private Const S14 As Long = 22
Private Const S21 As Long = 5
Private Const S22 As Long = 9
Private Const S23 As Long = 14
Private Const S24 As Long = 20
Private Const S31 As Long = 4
Private Const S32 As Long = 11
Private Const S33 As Long = 16
Private Const S34 As Long = 23
Private Const S41 As Long = 6
Private Const S42 As Long = 10
Private Const S43 As Long = 15
Private Const S44 As Long = 21
' Constants for unsigned word addition
Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647

' TEST FUNCTIONS...
' MD5 test suite:
' MD5 ("") = d41d8cd98f00b204e9800998ecf8427e
' MD5 ("a") = 0cc175b9c0f1b6a831c399e269772661
' MD5 ("abc") = 900150983cd24fb0d6963f7d28e17f72
' MD5 ("message digest") = f96b697d7cb7938d525a2f31aaf161d0
' MD5 ("abcdefghijklmnopqrstuvwxyz") = c3fcd3d76192e4007dfb496cca67e13b
' MD5 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") =
' d174ab98d277d9f5a5611c2c9f419d9f
' MD5 ("123456789012345678901234567890123456789012345678901234567890123456
' 78901234567890") = 57edf4a22be3c955ac49da2e2107b67a

' MD5 (1 million x 'a') = 7707d6ae4e027c70eea2a935c2296f21

Public Function Test_md5_abc()
Debug.Print MD5_string("abc")
End Function

Public Function md5_test_suite()
Debug.Print MD5_string("")
Debug.Print MD5_string("a")
Debug.Print MD5_string("abc")
Debug.Print MD5_string("message digest")
Debug.Print MD5_string("abcdefghijklmnopqrstuvwxyz")
Debug.Print MD5_string("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
Debug.Print MD5_string("12345678901234567890123456789012345678901234567890123456789012345678901234567890")
End Function

Public Function test_md5_empty()
Debug.Print MD5_string("")
End Function

Public Function test_md5_around64()
Dim strMessage As String
strMessage = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
Debug.Print MD5_string(strMessage)
Debug.Print MD5_string(Left(strMessage, 65))
Debug.Print MD5_string(Left(strMessage, 64))
Debug.Print MD5_string(Left(strMessage, 63))
Debug.Print MD5_string(Left(strMessage, 62))
Debug.Print MD5_string(Left(strMessage, 57))
Debug.Print MD5_string(Left(strMessage, 56))
Debug.Print MD5_string(Left(strMessage, 55))
End Function

Public Function test_md5_million_a()
' This may take some time...
Dim abMessage() As Byte
Dim mLen As Long
Dim i As Long
mLen = 1000000
ReDim abMessage(mLen - 1)
For i = 0 To mLen - 1
abMessage(i) = &H61 ' 0x61 = 'a'
Next
Debug.Print MD5_bytes(abMessage, mLen)

End Function

' MAIN EXPORTED MD5 FUNCTIONS...

Public Function MD5_string(strMessage As String) As String
' Returns 32-char hex string representation of message digest
' Input as a string (max length 2^29-1 bytes)
Dim abMessage() As Byte
Dim mLen As Long
' Cope with the empty string
If Len(strMessage) > 0 Then
abMessage = StrConv(strMessage, vbFromUnicode)
' Compute length of message in bytes
mLen = UBound(abMessage) - LBound(abMessage) + 1
End If
MD5_string = MD5_bytes(abMessage, mLen)
End Function

Public Function MD5_bytes(abMessage() As Byte, mLen As Long) As String
' Returns 32-char hex string representation of message digest
' Input as an array of bytes of length mLen bytes

Dim nBlks As Long
Dim nBits As Long
Dim block(MD5_BLK_LEN - 1) As Byte
Dim state(3) As Long
Dim wb(3) As Byte
Dim sHex As String
Dim index As Long
Dim partLen As Long
Dim i As Long
Dim j As Long

' Catch length too big for VB arithmetic (268 million!)
If mLen >= &HFFFFFFF Then Error 6 ' overflow

' Initialise
' Number of complete 512-bit/64-byte blocks to process
nBlks = mLen \ MD5_BLK_LEN

' Load magic initialization constants
state(0) = &H67452301
state(1) = &HEFCDAB89
state(2) = &H98BADCFE
state(3) = &H10325476

' Main loop for each complete input block of 64 bytes
index = 0
For i = 0 To nBlks - 1
Call md5_transform(state, abMessage, index)
index = index + MD5_BLK_LEN
Next

' Construct final block(s) with padding
partLen = mLen Mod MD5_BLK_LEN
index = nBlks * MD5_BLK_LEN
For i = 0 To partLen - 1
block(i) = abMessage(index + i)
Next
block(partLen) = &H80
' Make sure padding (and bit-length) set to zero
For i = partLen + 1 To MD5_BLK_LEN - 1
block(i) = 0
Next
' Two cases: partLen is < or >= 56
If partLen >= MD5_BLK_LEN - 8 Then
' Need two blocks
Call md5_transform(state, block, 0)
For i = 0 To MD5_BLK_LEN - 1
block(i) = 0
Next
End If
' Append number of bits in little-endian order
nBits = mLen * 8
block(MD5_BLK_LEN - 8) = nBits And &HFF
block(MD5_BLK_LEN - 7) = nBits \ &H100 And &HFF
block(MD5_BLK_LEN - 6) = nBits \ &H10000 And &HFF
block(MD5_BLK_LEN - 5) = nBits \ &H1000000 And &HFF
' (NB we don't try to cope with number greater than 2^31)

' Final padded block with bit length
Call md5_transform(state, block, 0)

' Decode 4 x 32-bit words into 16 bytes with LSB first each time
' and return result as a hex string
MD5_bytes = ""
For i = 0 To 3
Call uwSplit(state(i), wb(3), wb(2), wb(1), wb(0))
For j = 0 To 3
If wb(j) < 16 Then
sHex = "0" & Hex(wb(j))
Else
sHex = Hex(wb(j))
End If
MD5_bytes = MD5_bytes & sHex
Next
Next

End Function

' INTERNAL FUNCTIONS...

Private Sub md5_transform(state() As Long, buf() As Byte, ByVal index As Long)
' Updates 4 x 32-bit values in state
' Input: the next 64 bytes in buf starting at offset index
' Assumes at least 64 bytes are present after offset index
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim j As Integer
Dim x(15) As Long

a = state(0)
b = state(1)
c = state(2)
d = state(3)

' Decode the next 64 bytes into 16 words with LSB first
For j = 0 To 15
x(j) = uwJoin(buf(index + 3), buf(index + 2), buf(index + 1), buf(index))
index = index + 4
Next

' Round 1
a = FF(a, b, c, d, x(0), S11, &HD76AA478) ' 1
d = FF(d, a, b, c, x(1), S12, &HE8C7B756) ' 2
c = FF(c, d, a, b, x(2), S13, &H242070DB) ' 3
b = FF(b, c, d, a, x(3), S14, &HC1BDCEEE) ' 4
a = FF(a, b, c, d, x(4), S11, &HF57C0FAF) ' 5
d = FF(d, a, b, c, x(5), S12, &H4787C62A) ' 6
c = FF(c, d, a, b, x(6), S13, &HA8304613) ' 7
b = FF(b, c, d, a, x(7), S14, &HFD469501) ' 8
a = FF(a, b, c, d, x(8), S11, &H698098D8) ' 9
d = FF(d, a, b, c, x(9), S12, &H8B44F7AF) ' 10
c = FF(c, d, a, b, x(10), S13, &HFFFF5BB1) ' 11
b = FF(b, c, d, a, x(11), S14, &H895CD7BE) ' 12
a = FF(a, b, c, d, x(12), S11, &H6B901122) ' 13
d = FF(d, a, b, c, x(13), S12, &HFD987193) ' 14
c = FF(c, d, a, b, x(14), S13, &HA679438E) ' 15
b = FF(b, c, d, a, x(15), S14, &H49B40821) ' 16

' Round 2
a = GG(a, b, c, d, x(1), S21, &HF61E2562) ' 17
d = GG(d, a, b, c, x(6), S22, &HC040B340) ' 18
c = GG(c, d, a, b, x(11), S23, &H265E5A51) ' 19
b = GG(b, c, d, a, x(0), S24, &HE9B6C7AA) ' 20
a = GG(a, b, c, d, x(5), S21, &HD62F105D) ' 21
d = GG(d, a, b, c, x(10), S22, &H2441453) ' 22
c = GG(c, d, a, b, x(15), S23, &HD8A1E681) ' 23
b = GG(b, c, d, a, x(4), S24, &HE7D3FBC8) ' 24
a = GG(a, b, c, d, x(9), S21, &H21E1CDE6) ' 25
d = GG(d, a, b, c, x(14), S22, &HC33707D6) ' 26
c = GG(c, d, a, b, x(3), S23, &HF4D50D87) ' 27
b = GG(b, c, d, a, x(8), S24, &H455A14ED) ' 28
a = GG(a, b, c, d, x(13), S21, &HA9E3E905) ' 29
d = GG(d, a, b, c, x(2), S22, &HFCEFA3F8) ' 30
c = GG(c, d, a, b, x(7), S23, &H676F02D9) ' 31
b = GG(b, c, d, a, x(12), S24, &H8D2A4C8A) ' 32

' Round 3
a = HH(a, b, c, d, x(5), S31, &HFFFA3942) ' 33
d = HH(d, a, b, c, x(8), S32, &H8771F681) ' 34
c = HH(c, d, a, b, x(11), S33, &H6D9D6122) ' 35
b = HH(b, c, d, a, x(14), S34, &HFDE5380C) ' 36
a = HH(a, b, c, d, x(1), S31, &HA4BEEA44) ' 37
d = HH(d, a, b, c, x(4), S32, &H4BDECFA9) ' 38
c = HH(c, d, a, b, x(7), S33, &HF6BB4B60) ' 39
b = HH(b, c, d, a, x(10), S34, &HBEBFBC70) ' 40
a = HH(a, b, c, d, x(13), S31, &H289B7EC6) ' 41
d = HH(d, a, b, c, x(0), S32, &HEAA127FA) ' 42
c = HH(c, d, a, b, x(3), S33, &HD4EF3085) ' 43
b = HH(b, c, d, a, x(6), S34, &H4881D05) ' 44
a = HH(a, b, c, d, x(9), S31, &HD9D4D039) ' 45
d = HH(d, a, b, c, x(12), S32, &HE6DB99E5) ' 46
c = HH(c, d, a, b, x(15), S33, &H1FA27CF8) ' 47
b = HH(b, c, d, a, x(2), S34, &HC4AC5665) ' 48

' Round 4
a = II(a, b, c, d, x(0), S41, &HF4292244) ' 49
d = II(d, a, b, c, x(7), S42, &H432AFF97) ' 50
c = II(c, d, a, b, x(14), S43, &HAB9423A7) ' 51
b = II(b, c, d, a, x(5), S44, &HFC93A039) ' 52
a = II(a, b, c, d, x(12), S41, &H655B59C3) ' 53
d = II(d, a, b, c, x(3), S42, &H8F0CCC92) ' 54
c = II(c, d, a, b, x(10), S43, &HFFEFF47D) ' 55
b = II(b, c, d, a, x(1), S44, &H85845DD1) ' 56
a = II(a, b, c, d, x(8), S41, &H6FA87E4F) ' 57
d = II(d, a, b, c, x(15), S42, &HFE2CE6E0) ' 58
c = II(c, d, a, b, x(6), S43, &HA3014314) ' 59
b = II(b, c, d, a, x(13), S44, &H4E0811A1) ' 60
a = II(a, b, c, d, x(4), S41, &HF7537E82) ' 61
d = II(d, a, b, c, x(11), S42, &HBD3AF235) ' 62
c = II(c, d, a, b, x(2), S43, &H2AD7D2BB) ' 63
b = II(b, c, d, a, x(9), S44, &HEB86D391) ' 64

state(0) = uwAdd(state(0), a)
state(1) = uwAdd(state(1), b)
state(2) = uwAdd(state(2), c)
state(3) = uwAdd(state(3), d)

End Sub

' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4

Private Function AddRotAdd(f As Long, a As Long, b As Long, x As Long, s As Integer, ac As Long) As Long
' Common routine for FF, GG, HH and II
' #define AddRotAdd(f, a, b, c, d, x, s, ac) { \
' (a) += f + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Dim temp As Long
temp = uwAdd(a, f)
temp = uwAdd(temp, x)
temp = uwAdd(temp, ac)
temp = uwRol(temp, s)
AddRotAdd = uwAdd(temp, b)
End Function

Private Function FF(a As Long, b As Long, c As Long, d As Long, x As Long, s As Integer, ac As Long) As Long
' Returns new value of a
' #define F(x, y, z) (((x) & ) | ((~x) & (z)))
' #define FF(a, b, c, d, x, s, ac) { \
' (a) += F ((b), (c), (d)) + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Dim t As Long
Dim t2 As Long
' F ((b), (c), (d)) = (((b) & (c)) | ((~b) & (d)))
t = b And c
t2 = (Not b) And d
t = t Or t2
FF = AddRotAdd(t, a, b, x, s, ac)
End Function

Private Function GG(a As Long, b As Long, c As Long, d As Long, x As Long, s As Integer, ac As Long) As Long
' #define G(b, c, d) (((b) & (d)) | ((c) & (~d)))
Dim t As Long
Dim t2 As Long
t = b And d
t2 = c And (Not d)
t = t Or t2
GG = AddRotAdd(t, a, b, x, s, ac)
End Function

Private Function HH(a As Long, b As Long, c As Long, d As Long, x As Long, s As Integer, ac As Long) As Long
' #define H(b, c, d) ((b) ^ (c) ^ (d))
Dim t As Long
t = b Xor c Xor d
HH = AddRotAdd(t, a, b, x, s, ac)
End Function

Private Function II(a As Long, b As Long, c As Long, d As Long, x As Long, s As Integer, ac As Long) As Long
' #define I(b, c, d) ((c) ^ ((b) | (~d)))
Dim t As Long
t = b Or (Not d)
t = c Xor t
II = AddRotAdd(t, a, b, x, s, ac)
End Function

' Unsigned 32-bit word functions suitable for VB/VBA

Private Function uwRol(w As Long, s As Integer) As Long
' Return 32-bit word w rotated left by s bits
' avoiding problem with VB sign bit
Dim i As Integer
Dim t As Long

uwRol = w
For i = 1 To s
t = uwRol And &H3FFFFFFF
t = t * 2
If (uwRol And &H40000000) <> 0 Then
t = t Or &H80000000
End If
If (uwRol And &H80000000) <> 0 Then
t = t Or &H1
End If
uwRol = t
Next
End Function

Private Function uwJoin(a As Byte, b As Byte, c As Byte, d As Byte) As Long
' Join 4 x 8-bit bytes into one 32-bit word a.b.c.d
uwJoin = ((a And &H7F) * &H1000000) Or (b * &H10000) Or (CLng(c) * &H100) Or d
If a And &H80 Then
uwJoin = uwJoin Or &H80000000
End If
End Function

Private Sub uwSplit(ByVal w As Long, a As Byte, b As Byte, c As Byte, d As Byte)
' Split 32-bit word w into 4 x 8-bit bytes
a = CByte(((w And &HFF000000) \ &H1000000) And &HFF)
b = CByte(((w And &HFF0000) \ &H10000) And &HFF)
c = CByte(((w And &HFF00) \ &H100) And &HFF)
d = CByte((w And &HFF) And &HFF)
End Sub

Private Function uwAdd(wordA As Long, wordB As Long) As Long
' Adds words A and B avoiding overflow
Dim myUnsigned As Double

myUnsigned = LongToUnsigned(wordA) + LongToUnsigned(wordB)
' Cope with overflow
If myUnsigned > OFFSET_4 Then
myUnsigned = myUnsigned - OFFSET_4
End If
uwAdd = UnsignedToLong(myUnsigned)

End Function

'****************************************************
' These two functions from Microsoft Article Q189323
' "HOWTO: convert between Signed and Unsigned Numbers"

Private Function UnsignedToLong(value As Double) As Long
If value < 0 Or value >= OFFSET_4 Then Error 6 ' Overflow
If value <= MAXINT_4 Then
UnsignedToLong = value
Else
UnsignedToLong = value - OFFSET_4
End If
End Function

Private Function LongToUnsigned(value As Long) As Double
If value < 0 Then
LongToUnsigned = value + OFFSET_4
Else
LongToUnsigned = value
End If
End Function

' End of Microsoft-article functions
'****************************************************

 

[dilettante]

Looks pretty easy. Just call those "main exported functions." There are even sample calls present in the code you listed.

 

[strongm]

>I found this module to create checksums of files

Well, not exactly. The core function (MD5_String) produces an MD5 hash of a string (or input buffer). There's nothing in the module for actually opening a file and loading its contents into that string/buffer.

And it is pretty convoluted; you can do the same thing in about 5 lines of code ...

One quick question, though: why do you need an MD5 hash, what are you then going to do with it?

 

[M626]

I am uploading a video clip to a server that requires me to generate the md5 checksum.

 

[strongm]

Fine - then you need the slightly longer (compared to my basic MD5 hash code):

[blue]Option Explicit

Private Type MSIFILEHASHINFO
    dwFileHashInfoSize As Long
    strHashBuffer(0 To 15)  As Byte
End Type

Private Declare Function msiGetFileHash Lib "msi.dll" Alias "MsiGetFileHashA" (ByVal szFilePath As String, ByVal dwOptions As Long, pHash As Any) As Long 

Public Function GetFileHash(strfile As String) As String
    Dim CharByte As Variant
    Dim pHash As MSIFILEHASHINFO
    pHash.dwFileHashInfoSize = Len(pHash)
    msiGetFileHash strfile, 0&, pHash
    For Each CharByte In pHash.strHashBuffer
        GetFileHash = GetFileHash & LCase(Hex(CharByte))
    Next
End Function[/blue]

 

[M626]

Strongm... it looks like the checksums are generated but it's always missing zeros... example

is
2dbcc3476f0559dd4628eab8d4b033

should be
2dbc0c3476f0559dd4628eab8d4b0033

 

[strongm]

That's what I get for hacking a solution together too quickly ...

GetFileHash = GetFileHash & LCase(Hex(CharByte))

should be

GetFileHash = GetFileHash & LCase(Right("0" & Hex(CharByte), 2)

 

[M626]

Thanks...