Qbasicnews.com
February 22, 2018, 07:36:57 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: MD5 Cryptographic Hash Function  (Read 5094 times)
stylin
Ancient QBer
****
Posts: 445


« on: November 01, 2009, 05:49:02 PM »

Here's some code I write for QBasic or QuickBASIC that calculates MD5 hashes of strings, files or arbitrary in-memory data. It's painfully slow since I had to simulate modulo 32-bit addition with unsigned integers -- see MD5AddModulo32&. It could be sped up significantly by implementing MD5HashBlock and its helper routines, the "meat" of the algorithm, in assembly, but I figured it would be fun to try a pure QB solution.

This code is adapted from the reference implementation of The MD5 Message-Digest Algorithm (RFC 1321). It should be pretty easy to follow; I've tried to comment the parts that need explanation, but for more detailed information on the MD5 algorithm itself, see the RFC and the Wikipedia page. Hope someone finds this useful.

Code:
'' PUBLIC API

'' function: MD5HashString$
''  Returns the 32-character hexadecimal string representation of the
''  message digest of `message`.
declare function MD5HashString$ ( message as string )

'' function: MD5HashFile$
''  Returns the 32-character hexadecimal string representation of the
''  message digest of the file `fileName`.
declare function MD5HashFile$ ( fileName as string )

'' type: MD5HashState
''  Stores the state of a hash operation. Use MD5Initialize, followed by calls
''  to MD5Update/MD5UpdateAux for all message bytes, then
''  MD5Finalize/MD5FinalizeAux to retrieve the message digest. (See
''  implementation for MD5HashFile$.) All fields are considered private.
type MD5HashState
bitCount as long
bitCount2 as long
a as long
b as long
c as long
d as long
block as string * 64
end type

'' sub: MD5Initialize
''  Prepares `state` for calls to Update.
declare sub MD5Initialize ( state as MD5HashState )

'' sub: MD5Update
''  Begins or continues a hashing operation on `state` with the bytes in
''  `source`.
declare sub MD5Update ( state as MD5HashState, source as string )

'' sub: MD5UpdateAux
''  Begins or continues a hashing operation on `state` with `sourceLength`
''  bytes starting at address `sourcePtr`.
declare sub MD5UpdateAux ( state as MD5HashState, sourcePtr as integer, sourceLength as integer )

'' sub: MD5Finalize
''  Finishes the hashing operation on `state`, allocating and placing the
''  16-byte message digest in `digest`.
declare sub MD5Finalize ( state as MD5HashState, digest as string )

'' sub: MD5FinalizeAux
''  Finishes the hashing operation on `state`, placing the 16-byte message
''  digest in the pre-allocated memory starting at `digestPtr`.
declare sub MD5FinalizeAux ( state as MD5HashState, digestPtr as integer )

'' function: MD5GetHexFromBytes$
''  Returns the (2 * `srcLen`)-character hexadecimal string representation of
''  the bytes starting at `srcPtr`.
declare function MD5GetHexFromBytes$ ( srcPtr as integer, srcLen as integer )

'' function: MD5GetStringDataPtr%
''  Helper to retrieve the near address of first character of variable-length
''  strings and string parameters.
declare function MD5GetStringDataPtr% ( s as string )

'' INTERNAL API

declare sub MD5HashBlock ( state as MD5HashState, blockPtr as integer )
declare function MD5RoundF& ( x as long, y as long, z as long )
declare function MD5RoundG& ( x as long, y as long, z as long )
declare function MD5RoundH& ( x as long, y as long, z as long )
declare function MD5RoundI& ( x as long, y as long, z as long )
declare sub MD5FF ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
declare sub MD5GG ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
declare sub MD5HH ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
declare sub MD5II ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
declare function MD5AddModulo32& ( a as long, b as long )
declare function MD5RotateLeft& ( n as long, s as integer )
declare sub MD5MemCopy ( dstPtr as integer, srcPtr as integer, length as integer )


'' ::::: [demo code]

' d41d8cd98f00b204e9800998ecf8427e
print MD5HashString$( "" )
' 0cc175b9c0f1b6a831c399e269772661
print MD5HashString$( "a" )
' 900150983cd24fb0d6963f7d28e17f72
print MD5HashString$( "abc" )
' f96b697d7cb7938d525a2f31aaf161d0
print MD5HashString$( "message digest" )
' c3fcd3d76192e4007dfb496cca67e13b
print MD5HashString$( "abcdefghijklmnopqrstuvwxyz" )
' d174ab98d277d9f5a5611c2c9f419d9f
print MD5HashString$( "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" )
' 57edf4a22be3c955ac49da2e2107b67a
print MD5HashString$( "12345678901234567890123456789012345678901234567890123456789012345678901234567890" )
end

'' ::::: [/demo code]

deflng a-z
function MD5HashString$ ( message as string )

dim state as MD5HashState
dim digest as string

MD5Initialize state
MD5Update state, message
MD5Finalize state, digest

MD5HashString$ = MD5GetHexFromBytes$( MD5GetStringDataPtr%( digest ), len( digest ) )

end function

deflng a-z
function MD5HashFile$ ( fileName as string )

dim fileNum as integer : fileNum = freefile
open fileName for binary access read as #fileNum

dim state as MD5HashState
MD5Initialize state

dim bytesLeft as long : bytesLeft = lof( fileNum )
dim buffer as string : buffer = space$( 2048 )

do while bytesLeft
if ( bytesLeft < len( buffer ) ) then
buffer = space$( bytesLeft )
end if
get #filenum, , buffer
bytesLeft = bytesLeft - len( buffer )
MD5Update state, buffer
loop
close #filenum

dim digest as string
MD5Finalize state, digest

MD5HashFile$ = MD5GetHexFromBytes$( MD5GetStringDataPtr%( digest ), len( digest ) )

end function

deflng a-z
function MD5GetHexFromBytes$ ( srcPtr as integer, srcLen as integer )

dim result as string * 32
for i = 0 to srcLen - 1
dim b as integer : b = peek( srcPtr + i )
dim highNibble as integer : highNibble = ( b and &HF0 ) \ 16
dim  lowNibble as integer :  lowNibble = ( b and &H0F )
mid$( result, (i*2) + 1, 1 ) = hex$( highNibble )
mid$( result, (i*2) + 2, 1 ) = hex$( lowNibble )
next i
MD5GetHexFromBytes$ = result

end function

deflng a-z
sub MD5Encode ( dstPtr as integer, srcPtr as integer, n as integer )
dim i as integer
dim j as integer

do while j < n
poke dstPtr + j    ,   peek( srcPtr + i + 0 )
poke dstPtr + j + 1,   peek( srcPtr + i + 1 )
poke dstPtr + j + 2,   peek( srcPtr + i + 2 )
poke dstPtr + j + 3,   peek( srcPtr + i + 3 )
i = i + 4
j = j + 4
loop
end sub

deflng a-z
sub MD5Decode ( dstPtr as integer, srcPtr as integer, n as integer )
dim i as integer
dim j as integer

do while j < n
poke dstPtr + j    ,   peek( srcPtr + i + 0 )
poke dstPtr + j + 1,   peek( srcPtr + i + 1 )
poke dstPtr + j + 2,   peek( srcPtr + i + 2 )
poke dstPtr + j + 3,   peek( srcPtr + i + 3 )
i = i + 4
j = j + 4
loop
end sub

deflng a-z
sub MD5Initialize ( state as MD5HashState )
' prime state variables with these magic numbers:
state.a = &h67452301
state.b = &hefcdab89
state.c = &h98badcfe
state.d = &h10325476
end sub

deflng a-z
sub MD5Update ( state as MD5HashState, bytes as string )
MD5UpdateAux state, MD5GetStringDataPtr%( bytes ), len( bytes )
end sub

deflng a-z
sub MD5UpdateAux ( state as MD5HashState, srcPtr as integer, srcLen as integer )

dim index as integer
dim partLen as integer
dim i as integer

index = ( state.bitCount \ 8 ) and &H3f

' update bit count..
state.bitCount = MD5AddModulo32&( state.bitCount, srcLen * 8 )
if ( state.bitCount < srcLen * 8 ) then
state.bitCount2 = state.bitCount2 + 1
state.bitCount2 = MD5AddModulo32&( state.bitCount2, ( srcLen / 2& ^ 29& ) )
end if

partLen = 64 - index
i = 0
if ( srclen >= partlen ) then
' fill and hash buffer.
MD5MemCopy varptr( state.block ) + index, srcPtr, partLen
MD5HashBlock state, varptr( state.block )

' hash as many full-sized source blocks as possible.
i = partlen
do while i + 63 < srcLen
MD5HashBlock state, srcPtr + i
i = i + 64
loop
index = 0
end if
' buffer remaining source.
MD5MemCopy varptr( state.block ) + index, srcPtr + i, srcLen - i

end sub

deflng a-z
sub MD5Finalize ( state as MD5HashState, digest as string )
digest = space$( 16 )
MD5FinalizeAux state, MD5GetStringDataPtr%( digest )
end sub

deflng a-z
sub MD5FinalizeAux ( state as MD5HashState, digestPtr as integer )

' storage for arbitrary padding lengths:
dim PADDING as string * 64
mid$( PADDING, 1, 1 ) = chr$( &H80 )

dim index as integer
dim padLen as integer

' save bit count (up to padding bits)
dim bitCountStorage as string * 8
MD5Encode varptr( bitCountStorage ), varptr( state.bitCount ), 8

' 'append' and hash padding bytes (leaving 8 bytes for length).
index = ( state.bitCount \ 8 ) and &H3f
if ( index < 56 ) then
padLen = 56 - index
else
padLen = 120 - index
end if
MD5UpdateAux state, varptr( PADDING ), padLen

' 'append' and hash the message length.
MD5Update state, bitCountStorage

' state (abcd) now holds the final digest; MD5Encode to byte array.
MD5Encode digestPtr, varptr( state.a ), 16

end function

deflng a-z
function MD5GetStringDataPtr% ( s as string )
dim dataPtr as double
dataPtr =           peek( varptr( s ) + 2 )
dataPtr = dataPtr + peek( varptr( s ) + 3 ) * 256#
' unsigned to signed
if ( dataPtr > 32767# ) then dataPtr = -(65535# - dataPtr + 1)

MD5GetStringDataPtr% = cint( dataPtr )

end function

deflng a-z
sub MD5MemCopy ( dstPtr as integer, srcPtr as integer, length as integer )
for i = 0 to length - 1
poke dstPtr + i, peek( srcPtr + i )
next i
end sub

deflng a-z

const T1 = &hd76aa478
const T2 = &he8c7b756
const T3 = &h242070db
const T4 = &hc1bdceee
const T5 = &hf57c0faf
const T6 = &h4787c62a
const T7 = &ha8304613
const T8 = &hfd469501
const T9 = &h698098d8
const T10 = &h8b44f7af
const T11 = &hffff5bb1
const T12 = &h895cd7be
const T13 = &h6b901122
const T14 = &hfd987193
const T15 = &ha679438e
const T16 = &h49b40821
const T17 = &hf61e2562
const T18 = &hc040b340
const T19 = &h265e5a51
const T20 = &he9b6c7aa
const T21 = &hd62f105d
const T22 = &h02441453
const T23 = &hd8a1e681
const T24 = &he7d3fbc8
const T25 = &h21e1cde6
const T26 = &hc33707d6
const T27 = &hf4d50d87
const T28 = &h455a14ed
const T29 = &ha9e3e905
const T30 = &hfcefa3f8
const T31 = &h676f02d9
const T32 = &h8d2a4c8a
const T33 = &hfffa3942
const T34 = &h8771f681
const T35 = &h6d9d6122
const T36 = &hfde5380c
const T37 = &ha4beea44
const T38 = &h4bdecfa9
const T39 = &hf6bb4b60
const T40 = &hbebfbc70
const T41 = &h289b7ec6
const T42 = &heaa127fa
const T43 = &hd4ef3085
const T44 = &h04881d05
const T45 = &hd9d4d039
const T46 = &he6db99e5
const T47 = &h1fa27cf8
const T48 = &hc4ac5665
const T49 = &hf4292244
const T50 = &h432aff97
const T51 = &hab9423a7
const T52 = &hfc93a039
const T53 = &h655b59c3
const T54 = &h8f0ccc92
const T55 = &hffeff47d
const T56 = &h85845dd1
const T57 = &h6fa87e4f
const T58 = &hfe2ce6e0
const T59 = &ha3014314
const T60 = &h4e0811a1
const T61 = &hf7537e82
const T62 = &hbd3af235
const T63 = &h2ad7d2bb
const T64 = &heb86d391

' signed/unsigned conversions:
'
' unsigned to signed:
'  if( value > MAX_SIGNED_VALUE ) then
'   value = -( MAX_UNSIGNED_VALUE - value + 1 )
'  end if
'
' signed to unsigned:
'  if( value < 0 ) then
'   value = MAX_UNSIGNED_VALUE + value + 1
'  end if

' The following is used instead of "a + b" where necessary to provide addition
' modulo 32-bit of unsigned integers; needed because
'  1) QuickBASIC/QB throws an error on additive overflow, and
'  2) QuickBASIC/QB has no unsigned integer types.
deflng a-z
function MD5AddModulo32& ( a as long, b as long )

dim aa as double : aa = cdbl( a )
dim bb as double : bb = cdbl( b )

' signed to unsigned
if ( a < 0 ) then aa = 4294967295# + a + 1
if ( b < 0 ) then bb = 4294967295# + b + 1

dim cc as double : cc = aa + bb
' keep 32-bit portion ( cc = cc and &hFFFFFFFF )
if ( cc > 4294967295# ) then cc = cc - 4294967296#
' unsigned to signed
if ( cc > 2147483647# ) then cc = -(4294967295# - cc + 1)

MD5AddModulo32& = clng( cc )

end function

'          31        23        15 s      7      0
' before: [hhhhhhhh][hhhhllll][llllllll][llllllll]
' after:  [llllllll][llllllll][llllhhhh][hhhhhhhh]
deflng a-z
function MD5RotateLeft& ( n as long, s as integer )
dim ss as integer : ss = s mod 32

if ss <= 0 then MD5RotateLeft& = n : exit function

dim highMask as double : highMask = (2# ^ ss - 1) * (2# ^ (32# - ss))
dim  lowMask as double :  lowMask = (2# ^ (32# - ss) - 1)
' unsigned to signed
if ( highMask > 2147483647# ) then highMask = -(4294967295# - highMask + 1)
if (  lowMask > 2147483647# ) then  lowMask = -(4294967295# - lowMask + 1)

dim highBits as double : highBits = cdbl( n and clng( highMask ) )
dim  lowBits as double :  lowBits = cdbl( n and clng( lowMask ) )
' signed to unsigned
if ( highBits < 0 ) then highBits = 4294967295# + highBits + 1
if (  lowBits < 0 ) then  lowBits = 4294967295# + lowBits + 1

highBits = highBits / (2# ^ (32 - ss))
lowBits =  lowBits * (2# ^ ss)
' unsigned to signed
if ( highBits > 2147483647# ) then highBits = -(4294967295# - highBits + 1)
if (  lowBits > 2147483647# ) then  lowBits = -(4294967295# - lowBits + 1)

MD5RotateLeft& = clng( lowBits ) or clng( highBits )

end function

deflng a-z
function MD5RoundF& ( x as long, y as long, z as long )
MD5RoundF& = (x and y) or ((not x) and z)
end function

deflng a-z
function MD5RoundG& ( x as long, y as long, z as long )
MD5RoundG& = (x and z) or (y and not z)
end function

deflng a-z
function MD5RoundH& ( x as long, y as long, z as long )
MD5RoundH& = x xor y xor z
end function

deflng a-z
function MD5RoundI& ( x as long, y as long, z as long )
MD5RoundI& = y xor (x or not z)
end function

deflng a-z
sub MD5FF ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
dim tmp as long

' a = MD5RotateLeft&( ( a + MD5RoundF&( b, c, d ) + k + T ), s ) + b
tmp = MD5AddModulo32&( a, MD5RoundF&( b, c, d ) )
tmp = MD5AddModulo32&( tmp, k )
tmp = MD5AddModulo32&( tmp, T )
tmp = MD5RotateLeft&( tmp, s )
a = MD5AddModulo32&( tmp, b )

end sub

deflng a-z
sub MD5GG ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
dim tmp as long

tmp = MD5AddModulo32&( a, MD5RoundG&( b, c, d ) )
tmp = MD5AddModulo32&( tmp, k )
tmp = MD5AddModulo32&( tmp, T )
tmp = MD5RotateLeft&( tmp, s )
a = MD5AddModulo32&( tmp, b )
end sub

deflng a-z
sub MD5HH ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
dim tmp as long

tmp = MD5AddModulo32&( a, MD5RoundH&( b, c, d ) )
tmp = MD5AddModulo32&( tmp, k )
tmp = MD5AddModulo32&( tmp, T )
tmp = MD5RotateLeft&( tmp, s )
a = MD5AddModulo32&( tmp, b )
end sub

deflng a-z
sub MD5II ( a as long, b as long, c as long, d as long, k as long, s as integer, T as long )
dim tmp as long

tmp = MD5AddModulo32&( a, MD5RoundI&( b, c, d ) )
tmp = MD5AddModulo32&( tmp, k )
tmp = MD5AddModulo32&( tmp, T )
tmp = MD5RotateLeft&( tmp, s )
a = MD5AddModulo32&( tmp, b )
end sub

deflng a-z
sub MD5HashBlock ( state as MD5HashState, blockPtr as integer )

dim X(0 to 15) as long

' The code
'    MD5Decode varptr( X(0) ), blockPtr, 64
' doesn't work, so we do the following:
for i = 0 to 15
dim value as double

value =         peek( blockPtr + (i*4)     )
value = value + peek( blockPtr + (i*4) + 1 ) * 2# ^ 8#
value = value + peek( blockPtr + (i*4) + 2 ) * 2# ^ 16#
value = value + peek( blockPtr + (i*4) + 3 ) * 2# ^ 24#
' unsigned to signed
if ( value > 2147483647# ) then value = -(4294967295# - value + 1)

X(i) = clng( value )
next i

dim a as long : a = state.a
dim b as long : b = state.b
dim c as long : c = state.c
dim d as long : d = state.d

' Round 1

MD5FF a, b, c, d,  X(0),  7,  T1
MD5FF d, a, b, c,  X(1), 12,  T2
MD5FF c, d, a, b,  X(2), 17,  T3
MD5FF b, c, d, a,  X(3), 22,  T4
MD5FF a, b, c, d,  X(4),  7,  T5
MD5FF d, a, b, c,  X(5), 12,  T6
MD5FF c, d, a, b,  X(6), 17,  T7
MD5FF b, c, d, a,  X(7), 22,  T8
MD5FF a, b, c, d,  X(8),  7,  T9
MD5FF d, a, b, c,  X(9), 12, T10
MD5FF c, d, a, b, X(10), 17, T11
MD5FF b, c, d, a, X(11), 22, T12
MD5FF a, b, c, d, X(12),  7, T13
MD5FF d, a, b, c, X(13), 12, T14
MD5FF c, d, a, b, X(14), 17, T15
MD5FF b, c, d, a, X(15), 22, T16


' Round 2
MD5GG a, b, c, d,  X(1),  5, T17
MD5GG d, a, b, c,  X(6),  9, T18
MD5GG c, d, a, b, X(11), 14, T19
MD5GG b, c, d, a,  X(0), 20, T20
MD5GG a, b, c, d,  X(5),  5, T21
MD5GG d, a, b, c, X(10),  9, T22
MD5GG c, d, a, b, X(15), 14, T23
MD5GG b, c, d, a,  X(4), 20, T24
MD5GG a, b, c, d,  X(9),  5, T25
MD5GG d, a, b, c, X(14),  9, T26
MD5GG c, d, a, b,  X(3), 14, T27
MD5GG b, c, d, a,  X(8), 20, T28
MD5GG a, b, c, d, X(13),  5, T29
MD5GG d, a, b, c,  X(2),  9, T30
MD5GG c, d, a, b,  X(7), 14, T31
MD5GG b, c, d, a, X(12), 20, T32


' Round 3
MD5HH a, b, c, d,  X(5),  4, T33
MD5HH d, a, b, c,  X(8), 11, T34
MD5HH c, d, a, b, X(11), 16, T35
MD5HH b, c, d, a, X(14), 23, T36
MD5HH a, b, c, d,  X(1),  4, T37
MD5HH d, a, b, c,  X(4), 11, T38
MD5HH c, d, a, b,  X(7), 16, T39
MD5HH b, c, d, a, X(10), 23, T40
MD5HH a, b, c, d, X(13),  4, T41
MD5HH d, a, b, c,  X(0), 11, T42
MD5HH c, d, a, b,  X(3), 16, T43
MD5HH b, c, d, a,  X(6), 23, T44
MD5HH a, b, c, d,  X(9),  4, T45
MD5HH d, a, b, c, X(12), 11, T46
MD5HH c, d, a, b, X(15), 16, T47
MD5HH b, c, d, a,  X(2), 23, T48

' Round 4
MD5II a, b, c, d,  X(0),  6, T49
MD5II d, a, b, c,  X(7), 10, T50
MD5II c, d, a, b, X(14), 15, T51
MD5II b, c, d, a,  X(5), 21, T52
MD5II a, b, c, d, X(12),  6, T53
MD5II d, a, b, c,  X(3), 10, T54
MD5II c, d, a, b, X(10), 15, T55
MD5II b, c, d, a,  X(1), 21, T56
MD5II a, b, c, d,  X(8),  6, T57
MD5II d, a, b, c, X(15), 10, T58
MD5II c, d, a, b,  X(6), 15, T59
MD5II b, c, d, a, X(13), 21, T60
MD5II a, b, c, d,  X(4),  6, T61
MD5II d, a, b, c, X(11), 10, T62
MD5II c, d, a, b,  X(2), 15, T63
MD5II b, c, d, a,  X(9), 21, T64

' update the state.
state.a = MD5AddModulo32&( state.a, a )
state.b = MD5AddModulo32&( state.b, b )
state.c = MD5AddModulo32&( state.c, c )
state.d = MD5AddModulo32&( state.d, d )

end sub
Logged

stylin:
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!