#include once "window9.bi"


'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(byval block As UByte Ptr)
  Declare Sub Update(byval inpt As UByte Ptr, byval nInputLen As ULong)
  Declare Function Final() As String
  
  Protected:
  'Nebenfunktionen
  Declare Sub UIntegerToUByte(byval outpt As UByte Ptr, byval inpt As ULong Ptr, byval nLength As ULong)
  Declare Sub UByteToUInteger(byval outpt As ULong Ptr, byval inpt As UByte Ptr, byval nLength As ULong)
  
  Private:
  As UByte m_lpszBuffer(64)  'Eingabepuffer
  As ULong m_nCount(2)    'Anzahl der bits, modulo 2^64 (lsb zuerst)
  As ULong m_lMD5(4)    'MD5 Prьfsumme
End Type


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

Sub MD5Checksum.Transform(byval block As UByte Ptr)
  'initialisiere die lokalen Daten mit der aktuellen checksum
  Dim As ULong a = m_lMD5(0)
  Dim As ULong b = m_lMD5(1)
  Dim As ULong c = m_lMD5(2)
  Dim As ULong d = m_lMD5(3)
  
  'Kopiert Bytes aus input 'Block' in ein Array von UIntegers 'X'
  Dim As ULong 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(byval outpt As UByte Ptr, byval inpt As ULong Ptr, byval nLength As ULong)
  'Initialisierung
  Dim As ULong i    'Index des Zeilarrays
  Dim As ULong 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 ULong nIndex = Cast(ULong, (m_nCount(0) Shr 3) And &H3f)
  Dim As ULong 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 ULong = 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(byval inpt As UByte Ptr, byval nInputLen As ULong)
  'Anzahl der Bytes mod 64 berechnen
  Dim As ULong nIndex = Cast(ULong, ((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 ULong i = 0
  Dim As ULong 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(ByRef text As String) As String Export
  Dim As ULong nLength = Len(text)
  If nLength = 0 Then
    Return "No text given"
  EndIf
  
  Dim As UByte buffer(16384)
  For i As ULong = 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(ByRef fileName As String) As String Export
  var nLength = Len(fileName)
  If nLength = 0 Then Return "No file specified"
  
  var hFile = FreeFile()
  If Open(fileName For Binary Access Read As #hFile) <> 0 Then
    Return "File not found/can't be opened"
  End If
  
  var fileLength = Lof(hFile)
  If fileLength = 0 Then
    Close #hFile
    Return "Empty file"
  End If
  
  Dim As UByte buffer(16384)
  Dim As ULong toBuffer
  Dim As MD5Checksum MD5
  Do Until fileLength = 0
    If fileLength >= 16384 Then
      fileLength -= 16384
      toBuffer = 16384
    Else
      toBuffer = fileLength
      fileLength = 0
    EndIf
    Get #hFile, , buffer(0), toBuffer
    MD5.Update(@buffer(0), toBuffer)
  Loop
  Close #hFile
  
  Return MD5.Final()
End Function
