'MD5Checksum

'Initialisierungskonstanten
#Define MD5_INIT_STATE_0 &H67452301
#Define MD5_INIT_STATE_1 &Hefcdab89
#Define MD5_INIT_STATE_2 &H98badcfe
#Define MD5_INIT_STATE_3 &H10325476

'Konstanten für den Transformationsprozess
#Define MD5_S11 7
#Define MD5_S12 12
#Define MD5_S13 17
#Define MD5_S14 22
#Define MD5_S21 5
#Define MD5_S22 9
#Define MD5_S23 14
#Define MD5_S24 20
#Define MD5_S31 4
#Define MD5_S32 11
#Define MD5_S33 16
#Define MD5_S34 23
#Define MD5_S41 6
#Define MD5_S42 10
#Define MD5_S43 15
#Define MD5_S44 21

'Transformierungskonstanten - Runde 1
#Define MD5_T01  &Hd76aa478 'Transformationskonstante 1
#Define MD5_T02  &He8c7b756 'Transformationskonstante 2
#Define MD5_T03  &H242070db 'Transformationskonstante 3
#Define MD5_T04  &Hc1bdceee 'Transformationskonstante 4
#Define MD5_T05  &Hf57c0faf 'Transformationskonstante 5
#Define MD5_T06  &H4787c62a 'Transformationskonstante 6
#Define MD5_T07  &Ha8304613 'Transformationskonstante 7
#Define MD5_T08  &Hfd469501 'Transformationskonstante 8
#Define MD5_T09  &H698098d8 'Transformationskonstante 9
#Define MD5_T10  &H8b44f7af 'Transformationskonstante 10
#Define MD5_T11  &Hffff5bb1 'Transformationskonstante 11
#Define MD5_T12  &H895cd7be 'Transformationskonstante 12
#Define MD5_T13  &H6b901122 'Transformationskonstante 13
#Define MD5_T14  &Hfd987193 'Transformationskonstante 14
#Define MD5_T15  &Ha679438e 'Transformationskonstante 15
#Define MD5_T16  &H49b40821 'Transformationskonstante 16

'Transformierungskonstanten - Runde 2
#Define MD5_T17  &Hf61e2562 'Transformationskonstante 17
#Define MD5_T18  &Hc040b340 'Transformationskonstante 18
#Define MD5_T19  &H265e5a51 'Transformationskonstante 19
#Define MD5_T20  &He9b6c7aa 'Transformationskonstante 20
#Define MD5_T21  &Hd62f105d 'Transformationskonstante 21
#Define MD5_T22  &H02441453 'Transformationskonstante 22
#Define MD5_T23  &Hd8a1e681 'Transformationskonstante 23
#Define MD5_T24  &He7d3fbc8 'Transformationskonstante 24
#Define MD5_T25  &H21e1cde6 'Transformationskonstante 25
#Define MD5_T26  &Hc33707d6 'Transformationskonstante 26
#Define MD5_T27  &Hf4d50d87 'Transformationskonstante 27
#Define MD5_T28  &H455a14ed 'Transformationskonstante 28
#Define MD5_T29  &Ha9e3e905 'Transformationskonstante 29
#Define MD5_T30  &Hfcefa3f8 'Transformationskonstante 30
#Define MD5_T31  &H676f02d9 'Transformationskonstante 31
#Define MD5_T32  &H8d2a4c8a 'Transformationskonstante 32

'Transformierungskonstanten - Runde 3
#Define MD5_T33  &Hfffa3942 'Transformationskonstante 33
#Define MD5_T34  &H8771f681 'Transformationskonstante 34
#Define MD5_T35  &H6d9d6122 'Transformationskonstante 35
#Define MD5_T36  &Hfde5380c 'Transformationskonstante 36
#Define MD5_T37  &Ha4beea44 'Transformationskonstante 37
#Define MD5_T38  &H4bdecfa9 'Transformationskonstante 38
#Define MD5_T39  &Hf6bb4b60 'Transformationskonstante 39
#Define MD5_T40  &Hbebfbc70 'Transformationskonstante 40
#Define MD5_T41  &H289b7ec6 'Transformationskonstante 41
#Define MD5_T42  &Heaa127fa 'Transformationskonstante 42
#Define MD5_T43  &Hd4ef3085 'Transformationskonstante 43
#Define MD5_T44  &H04881d05 'Transformationskonstante 44
#Define MD5_T45  &Hd9d4d039 'Transformationskonstante 45
#Define MD5_T46  &He6db99e5 'Transformationskonstante 46
#Define MD5_T47  &H1fa27cf8 'Transformationskonstante 47
#Define MD5_T48  &Hc4ac5665 'Transformationskonstante 48

'Transformierungskonstanten - Runde 4
#Define MD5_T49  &Hf4292244 'Transformationskonstante 49
#Define MD5_T50  &H432aff97 'Transformationskonstante 50
#Define MD5_T51  &Hab9423a7 'Transformationskonstante 51
#Define MD5_T52  &Hfc93a039 'Transformationskonstante 52
#Define MD5_T53  &H655b59c3 'Transformationskonstante 53
#Define MD5_T54  &H8f0ccc92 'Transformationskonstante 54
#Define MD5_T55  &Hffeff47d 'Transformationskonstante 55
#Define MD5_T56  &H85845dd1 'Transformationskonstante 56
#Define MD5_T57  &H6fa87e4f 'Transformationskonstante 57
#Define MD5_T58  &Hfe2ce6e0 'Transformationskonstante 58
#Define MD5_T59  &Ha3014314 'Transformationskonstante 59
#Define MD5_T60  &H4e0811a1 'Transformationskonstante 60
#Define MD5_T61  &Hf7537e82 'Transformationskonstante 61
#Define MD5_T62  &Hbd3af235 'Transformationskonstante 62
#Define MD5_T63  &H2ad7d2bb 'Transformationskonstante 63
#Define MD5_T64  &Heb86d391 'Transformationskonstante 64

'Null Daten (außer des ersten BYTE) werden benutzt, um die Prüfsummenberechnung zu beenden
Dim Shared As UByte PADDING(64) => { _
	&H80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }

'*******************************************************

#Define RotateLeft(x, n) ((x Shl n) Or (x Shr (32 - n)))

#Macro FF(a, b, c, d, x, s, t)
	a += ((b And c) Or ((Not b) And d)) + x + t
	a = RotateLeft(a, s) + b
#EndMacro

#Macro GG(a, b, c, d, x, s, t)
	a += ((b And d) Or (c And (Not d))) + x + t
	a = RotateLeft(a, s) + b
#EndMacro

#Macro HH(a, b, c, d, x, s, t)
	a += (b Xor c Xor d) + x + t
	a = RotateLeft(a, s) + b
#EndMacro

#Macro II(a, b, c, d, x, s, t)
	a += (c Xor (b Or (Not d))) + x + t
	a = RotateLeft(a, s) + b
#EndMacro

'*******************************************************

Type MD5Checksum
  Public:
  'Konstruktor/Destruktor
  Declare Constructor()
  Declare Destructor()
  
  'RSA MD5 Implementierung
  Declare Sub Transform(block As UByte Ptr)
  Declare Sub Update(inpt As UByte Ptr, nInputLen As UInteger)
  Declare Function Final() As String
  
  Protected:
  'Nebenfunktionen
  Declare Sub UIntegerToUByte(outpt As UByte Ptr, inpt As UInteger Ptr, nLength As UInteger)
  Declare Sub UByteToUInteger(outpt As UInteger Ptr, inpt As UByte Ptr, nLength As UInteger)
  
  Private:
  As UByte m_lpszBuffer(64)  'Eingabepuffer
  As UInteger m_nCount(2)    'Anzahl der bits, modulo 2^64 (lsb zuerst)
  As UInteger m_lMD5(4)    'MD5 Prüfsumme
End Type


#Ifndef memcpy
  Function memcpy(destination As UByte Ptr, source As UByte Ptr, num As UInteger) As UByte Ptr
    'Ersatz für "crt/string.bi"
    'Prüft nicht nach der Größe von Destination
    For i As Integer = 0 To num - 1
      destination[i]  = source[i]
    Next
    Return destination
  End Function
#EndIf

Sub MD5Checksum.UByteToUInteger(outpt As UInteger Ptr, inpt As UByte Ptr, nLength As UInteger)
  'Initialisierung
  Dim As UInteger i = 0
  Dim As UInteger j = 0
  
  'transferiere die Daten durch shifting und kopieren
  While j < nLength
    outpt[i] = (Cast(UInteger, inpt[j])) Or (Cast(UInteger, inpt[j+1]) Shl 8) Or (Cast(UInteger, inpt[j+2]) Shl 16) Or (Cast(UInteger, inpt[j+3]) Shl 24)
    i += 1
    j += 4
  Wend
End Sub

Sub MD5Checksum.Transform(block As UByte Ptr)
  'initialisiere die lokalen Daten mit der aktuellen checksum
  Dim As UInteger a = m_lMD5(0)
  Dim As UInteger b = m_lMD5(1)
  Dim As UInteger c = m_lMD5(2)
  Dim As UInteger d = m_lMD5(3)
  
  'Kopiert Bytes aus input 'Block' in ein Array von UIntegers 'X'
  Dim As UInteger X(16)
  UByteToUInteger(@X(0), block, 64)
  
  'Runde 1 Transformation
  FF(a, b, c, d, X( 0), MD5_S11, MD5_T01)
  FF(d, a, b, c, X( 1), MD5_S12, MD5_T02)
  FF(c, d, a, b, X( 2), MD5_S13, MD5_T03)
  FF(b, c, d, a, X( 3), MD5_S14, MD5_T04)
  FF(a, b, c, d, X( 4), MD5_S11, MD5_T05)
  FF(d, a, b, c, X( 5), MD5_S12, MD5_T06)
  FF(c, d, a, b, X( 6), MD5_S13, MD5_T07)
  FF(b, c, d, a, X( 7), MD5_S14, MD5_T08)
  FF(a, b, c, d, X( 8), MD5_S11, MD5_T09)
  FF(d, a, b, c, X( 9), MD5_S12, MD5_T10)
  FF(c, d, a, b, X(10), MD5_S13, MD5_T11)
  FF(b, c, d, a, X(11), MD5_S14, MD5_T12)
  FF(a, b, c, d, X(12), MD5_S11, MD5_T13)
  FF(d, a, b, c, X(13), MD5_S12, MD5_T14)
  FF(c, d, a, b, X(14), MD5_S13, MD5_T15)
  FF(b, c, d, a, X(15), MD5_S14, MD5_T16)
  
  'Runde 2 Transformation
  GG(a, b, c, d, X( 1), MD5_S21, MD5_T17)
  GG(d, a, b, c, X( 6), MD5_S22, MD5_T18)
  GG(c, d, a, b, X(11), MD5_S23, MD5_T19)
  GG(b, c, d, a, X( 0), MD5_S24, MD5_T20)
  GG(a, b, c, d, X( 5), MD5_S21, MD5_T21)
  GG(d, a, b, c, X(10), MD5_S22, MD5_T22)
  GG(c, d, a, b, X(15), MD5_S23, MD5_T23)
  GG(b, c, d, a, X( 4), MD5_S24, MD5_T24)
  GG(a, b, c, d, X( 9), MD5_S21, MD5_T25)
  GG(d, a, b, c, X(14), MD5_S22, MD5_T26)
  GG(c, d, a, b, X( 3), MD5_S23, MD5_T27)
  GG(b, c, d, a, X( 8), MD5_S24, MD5_T28)
  GG(a, b, c, d, X(13), MD5_S21, MD5_T29)
  GG(d, a, b, c, X( 2), MD5_S22, MD5_T30)
  GG(c, d, a, b, X( 7), MD5_S23, MD5_T31)
  GG(b, c, d, a, X(12), MD5_S24, MD5_T32)
  
  'Runde 3 Transformation
  HH(a, b, c, d, X( 5), MD5_S31, MD5_T33)
  HH(d, a, b, c, X( 8), MD5_S32, MD5_T34)
  HH(c, d, a, b, X(11), MD5_S33, MD5_T35)
  HH(b, c, d, a, X(14), MD5_S34, MD5_T36)
  HH(a, b, c, d, X( 1), MD5_S31, MD5_T37)
  HH(d, a, b, c, X( 4), MD5_S32, MD5_T38)
  HH(c, d, a, b, X( 7), MD5_S33, MD5_T39)
  HH(b, c, d, a, X(10), MD5_S34, MD5_T40)
  HH(a, b, c, d, X(13), MD5_S31, MD5_T41)
  HH(d, a, b, c, X( 0), MD5_S32, MD5_T42)
  HH(c, d, a, b, X( 3), MD5_S33, MD5_T43)
  HH(b, c, d, a, X( 6), MD5_S34, MD5_T44)
  HH(a, b, c, d, X( 9), MD5_S31, MD5_T45)
  HH(d, a, b, c, X(12), MD5_S32, MD5_T46)
  HH(c, d, a, b, X(15), MD5_S33, MD5_T47)
  HH(b, c, d, a, X( 2), MD5_S34, MD5_T48)
  
  'Runde 4 Transformation
  II(a, b, c, d, X( 0), MD5_S41, MD5_T49)
  II(d, a, b, c, X( 7), MD5_S42, MD5_T50)
  II(c, d, a, b, X(14), MD5_S43, MD5_T51)
  II(b, c, d, a, X( 5), MD5_S44, MD5_T52)
  II(a, b, c, d, X(12), MD5_S41, MD5_T53)
  II(d, a, b, c, X( 3), MD5_S42, MD5_T54)
  II(c, d, a, b, X(10), MD5_S43, MD5_T55)
  II(b, c, d, a, X( 1), MD5_S44, MD5_T56)
  II(a, b, c, d, X( 8), MD5_S41, MD5_T57)
  II(d, a, b, c, X(15), MD5_S42, MD5_T58)
  II(c, d, a, b, X( 6), MD5_S43, MD5_T59)
  II(b, c, d, a, X(13), MD5_S44, MD5_T60)
  II(a, b, c, d, X( 4), MD5_S41, MD5_T61)
  II(d, a, b, c, X(11), MD5_S42, MD5_T62)
  II(c, d, a, b, X( 2), MD5_S43, MD5_T63)
  II(b, c, d, a, X( 9), MD5_S44, MD5_T64)
  
  'Füge die veränderten Werte zur aktuellen Checksum hinzu
  m_lMD5(0) += a
  m_lMD5(1) += b
  m_lMD5(2) += c
  m_lMD5(3) += d
End Sub

Constructor MD5Checksum
  'Initialisierung
  m_nCount(0) = 0
  m_nCount(1) = 0
  
  'Lade magic state Initialisierungskonstanten
  m_lMD5(0) = MD5_INIT_STATE_0
  m_lMD5(1) = MD5_INIT_STATE_1
  m_lMD5(2) = MD5_INIT_STATE_2
  m_lMD5(3) = MD5_INIT_STATE_3
End Constructor

Destructor MD5Checksum
  
End Destructor

Sub MD5Checksum.UIntegerToUByte(outpt As UByte Ptr, inpt As UInteger Ptr, nLength As UInteger)
  'Initialisierung
  Dim As UInteger i    'Index des Zeilarrays
  Dim As UInteger j    'Index des Quellarrays
  
  'transferiere die Daten durch shifting und kopieren
  While j < nLength
    outpt[ j ] = Cast(UByte, (inpt[i]       ))
    outpt[j+1] = Cast(UByte, (inpt[i] Shr  8))
    outpt[j+2] = Cast(UByte, (inpt[i] Shr 16))
    outpt[j+3] = Cast(UByte, (inpt[i] Shr 24))
    i += 1
    j += 4
  Wend
End Sub

Function MD5Checksum.Final() As String
  'Sichere Anzahl der Bits
  Dim As UByte bits(8)
  UIntegerToUByte(@bits(0), @m_nCount(0), 8)
  
  'Auffüllen bis 56 mod 64
  Dim As UInteger nIndex = Cast(UInteger, (m_nCount(0) Shr 3) And &H3f)
  Dim As UInteger nPadLen = IIf((nIndex < 56), (56 - nIndex), (120 - nIndex))
  Update(@PADDING(0), nPadLen)
  
  'Füge die Länge hinzu (vor dem Auffüllen)
  Update(@bits(0), 8)
  
  'Sichere final state in 'lpszMD5'
  Dim As UByte lpszMD5(16)
  UIntegerToUByte(@lpszMD5(0), @m_lMD5(0), 16)
  
  'Konvertiere die hexadezimale Checksum in einen String
  Dim As String strMD5
  For i As Integer = 0 To 15
    Dim As String Strn
    If lpszMD5(i) = 0 Then
      Strn = "00"
    ElseIf lpszMD5(i) <= 15 Then
      Strn = "0" + Str(Hex(lpszMD5(i)))
    Else
      Strn = Str(Hex(lpszMD5(i)))
    EndIf
    
    strMD5 += Strn
  Next
  
  Return strMD5
End Function

Sub MD5Checksum.Update(inpt As UByte Ptr, nInputLen As UInteger)
  'Anzahl der Bytes mod 64 berechnen
  Dim As UInteger nIndex = Cast(UInteger, ((m_nCount(0) Shr 3) And &H3f))
  
  'Anzahl der Bits aktualisieren
  m_nCount(0) += (nInputLen Shl 3)
  If (m_nCount(0) < (nInputLen Shl 3)) Then
    m_nCount(1) += 1
  EndIf
  m_nCount(1) += (nInputLen Shr 29)
  
  'Transformiere so oft wie möglich
  Dim As UInteger i = 0
  Dim As UInteger nPartLen = 64 - nIndex
  If (nInputLen >= nPartLen) Then
    memcpy(@m_lpszBuffer(nIndex), inpt, nPartLen)
    
    Transform(@m_lpszBuffer(0))
    
    i = nPartLen
    While i + 63 < nInputLen
      Transform(@inpt[i])
      i += 64
    Wend
    
    nIndex = 0
  Else
    i = 0
  EndIf
  
  'Übrig gebliebenen Input in Buffer
  memcpy(@m_lpszBuffer(nIndex), @inpt[i], nInputLen - i)
End Sub

Function MD5createHash(text As String) As String Export
  Dim As UInteger nLength = Len(text)
  If nLength = 0 Then
    Return "No text given"
  EndIf
  
  Dim As UByte buffer(16384)
  For i As Integer = 1 To nLength
    buffer(i - 1) = Asc(Mid(text, i ,1))
  Next
  
  Dim As MD5Checksum MD5
  MD5.Update(@buffer(0), nLength)
  
  Return MD5.Final()
End Function

Function MD5createFileHash(file As String) As String Export
  Dim As UInteger nLength = Len(file)
  If nLength = 0 Then
    Return "No file specified"
  EndIf
  
  Dim As Integer FFF = FreeFile
  If Open(file For Binary Access Read As #FFF) <> 0 Then
    Return "File not found/can't be opened"
  EndIf
  
  Dim As UInteger fileLength = Lof(FFF)
  If fileLength = 0 Then
    Close #FFF
    Return "Empty file"
  EndIf
  
  Dim As UByte buffer(16384)
  Dim As UInteger toBuffer
  Dim As MD5Checksum MD5
  Do Until fileLength = 0
    If fileLength >= 16384 Then
      fileLength -= 16384
      toBuffer = 16384
    Else
      toBuffer = fileLength
      fileLength = 0
    EndIf
    Get #FFF, , buffer(0), toBuffer
    MD5.Update(@buffer(0), toBuffer)
  Loop
  Close #FFF
  
  Return MD5.Final()
End Function
