1 1 1 1 1 1 1 1 1 1 Rating 5.00 (2 Votes)

Problemstellung:

Für 32Bit und 64Bit Office Versionen

Wie kann ich einen String mit MD5 verschlüsseln?

Folgenden Code in ein neues Modul kopieren.

Private lngTrack As Long
 Private arrLongConversion(4) As Long
 Private arrSplit64(63) As Byte
 Private Const OFFSET_4 = 4294967296#
 Private Const MAXINT_4 = 2147483647
 Private Const S11 = 7
 Private Const S12 = 12
 Private Const S13 = 17
 Private Const S14 = 22
 Private Const S21 = 5
 Private Const S22 = 9
 Private Const S23 = 14
 Private Const S24 = 20
 Private Const S31 = 4
 Private Const S32 = 11
 Private Const S33 = 16
 Private Const S34 = 23
 Private Const S41 = 6
 Private Const S42 = 10
 Private Const S43 = 15
 Private Const S44 = 21
 
Private Function MD5Round(strRound As String, a As Long, b As Long, _
                           C As Long, d As Long, x As Long, S As Long, _
                           ac As Long) As Long
     Select Case strRound
     Case Is = "FF"
         a = MD5LongAdd4(a, (b And C) Or (Not (b) And d), x, ac)
         a = MD5Rotate(a, S)
         a = MD5LongAdd(a, b)
     Case Is = "GG"
         a = MD5LongAdd4(a, (b And d) Or (C And Not (d)), x, ac)
         a = MD5Rotate(a, S)
         a = MD5LongAdd(a, b)
     Case Is = "HH"
         a = MD5LongAdd4(a, b Xor C Xor d, x, ac)
         a = MD5Rotate(a, S)
         a = MD5LongAdd(a, b)
     Case Is = "II"
         a = MD5LongAdd4(a, C Xor (b Or Not (d)), x, ac)
         a = MD5Rotate(a, S)
         a = MD5LongAdd(a, b)
     End Select
 End Function
 
Private Function MD5Rotate(lngValue As Long, lngBits As Long) As Long
     Dim lngSign As Long
     Dim lngI As Long
     lngBits = (lngBits Mod 32)
     If lngBits = 0 Then MD5Rotate = lngValue: Exit Function
     For lngI = 1 To lngBits
         lngSign = lngValue And &HC0000000
         lngValue = (lngValue And &H3FFFFFFF) * 2
         lngValue = lngValue Or ((lngSign < 0) And 1) Or _
                    (CBool(lngSign And &H40000000) And &H80000000)
     Next
     MD5Rotate = lngValue
 End Function
 
Private Function TRID() As String
     Dim sngNum As Single, lngnum As Long
     Dim strResult As String
 
    sngNum = Rnd(2147483648#)
     strResult = CStr(sngNum)
     strResult = Replace(strResult, "0.", "")
     strResult = Replace(strResult, ".", "")
     strResult = Replace(strResult, "E-", "")
     TRID = strResult
 End Function
 
Private Function MD564Split(lngLength As Long, bytBuffer() As Byte) As String
     Dim lngBytesTotal As Long, lngBytesToAdd As Long
     Dim intLoop As Integer, intLoop2 As Integer, lngTrace As Long
     Dim intInnerLoop As Integer, intLoop3 As Integer
 
    lngBytesTotal = lngTrack Mod 64
     lngBytesToAdd = 64 - lngBytesTotal
     lngTrack = (lngTrack + lngLength)
     If lngLength >= lngBytesToAdd Then
         For intLoop = 0 To lngBytesToAdd - 1
             arrSplit64(lngBytesTotal + intLoop) = bytBuffer(intLoop)
         Next intLoop
         MD5Conversion arrSplit64
         lngTrace = (lngLength) Mod 64
         For intLoop2 = lngBytesToAdd To lngLength - intLoop - lngTrace Step 64
             For intInnerLoop = 0 To 63
                 arrSplit64(intInnerLoop) = bytBuffer(intLoop2 + intInnerLoop)
             Next intInnerLoop
             MD5Conversion arrSplit64
         Next intLoop2
         lngBytesTotal = 0
     Else
         intLoop2 = 0
     End If
     For intLoop3 = 0 To lngLength - intLoop2 - 1
         arrSplit64(lngBytesTotal + intLoop3) = bytBuffer(intLoop2 + intLoop3)
     Next intLoop3
 End Function
 
Private Function MD5StringArray(strInput As String) As Byte()
     Dim intLoop As Integer
     Dim bytBuffer() As Byte
     ReDim bytBuffer(Len(strInput))
 
    For intLoop = 0 To Len(strInput) - 1
         bytBuffer(intLoop) = Asc(Mid(strInput, intLoop + 1, 1))
     Next intLoop
     MD5StringArray = bytBuffer
 End Function
 
Private Sub MD5Conversion(bytBuffer() As Byte)
     Dim x(16) As Long, a As Long
     Dim b As Long, C As Long
     Dim d As Long
 
    a = arrLongConversion(1)
     b = arrLongConversion(2)
     C = arrLongConversion(3)
     d = arrLongConversion(4)
     MD5Decode 64, x, bytBuffer
     MD5Round "FF", a, b, C, d, x(0), S11, -680876936
     MD5Round "FF", d, a, b, C, x(1), S12, -389564586
     MD5Round "FF", C, d, a, b, x(2), S13, 606105819
     MD5Round "FF", b, C, d, a, x(3), S14, -1044525330
     MD5Round "FF", a, b, C, d, x(4), S11, -176418897
     MD5Round "FF", d, a, b, C, x(5), S12, 1200080426
     MD5Round "FF", C, d, a, b, x(6), S13, -1473231341
     MD5Round "FF", b, C, d, a, x(7), S14, -45705983
     MD5Round "FF", a, b, C, d, x(8), S11, 1770035416
     MD5Round "FF", d, a, b, C, x(9), S12, -1958414417
     MD5Round "FF", C, d, a, b, x(10), S13, -42063
     MD5Round "FF", b, C, d, a, x(11), S14, -1990404162
     MD5Round "FF", a, b, C, d, x(12), S11, 1804603682
     MD5Round "FF", d, a, b, C, x(13), S12, -40341101
     MD5Round "FF", C, d, a, b, x(14), S13, -1502002290
     MD5Round "FF", b, C, d, a, x(15), S14, 1236535329
     MD5Round "GG", a, b, C, d, x(1), S21, -165796510
     MD5Round "GG", d, a, b, C, x(6), S22, -1069501632
     MD5Round "GG", C, d, a, b, x(11), S23, 643717713
     MD5Round "GG", b, C, d, a, x(0), S24, -373897302
     MD5Round "GG", a, b, C, d, x(5), S21, -701558691
     MD5Round "GG", d, a, b, C, x(10), S22, 38016083
     MD5Round "GG", C, d, a, b, x(15), S23, -660478335
     MD5Round "GG", b, C, d, a, x(4), S24, -405537848
     MD5Round "GG", a, b, C, d, x(9), S21, 568446438
     MD5Round "GG", d, a, b, C, x(14), S22, -1019803690
     MD5Round "GG", C, d, a, b, x(3), S23, -187363961
     MD5Round "GG", b, C, d, a, x(8), S24, 1163531501
     MD5Round "GG", a, b, C, d, x(13), S21, -1444681467
     MD5Round "GG", d, a, b, C, x(2), S22, -51403784
     MD5Round "GG", C, d, a, b, x(7), S23, 1735328473
     MD5Round "GG", b, C, d, a, x(12), S24, -1926607734
     MD5Round "HH", a, b, C, d, x(5), S31, -378558
     MD5Round "HH", d, a, b, C, x(8), S32, -2022574463
     MD5Round "HH", C, d, a, b, x(11), S33, 1839030562
     MD5Round "HH", b, C, d, a, x(14), S34, -35309556
     MD5Round "HH", a, b, C, d, x(1), S31, -1530992060
     MD5Round "HH", d, a, b, C, x(4), S32, 1272893353
     MD5Round "HH", C, d, a, b, x(7), S33, -155497632
     MD5Round "HH", b, C, d, a, x(10), S34, -1094730640
     MD5Round "HH", a, b, C, d, x(13), S31, 681279174
     MD5Round "HH", d, a, b, C, x(0), S32, -358537222
     MD5Round "HH", C, d, a, b, x(3), S33, -722521979
     MD5Round "HH", b, C, d, a, x(6), S34, 76029189
     MD5Round "HH", a, b, C, d, x(9), S31, -640364487
     MD5Round "HH", d, a, b, C, x(12), S32, -421815835
     MD5Round "HH", C, d, a, b, x(15), S33, 530742520
     MD5Round "HH", b, C, d, a, x(2), S34, -995338651
     MD5Round "II", a, b, C, d, x(0), S41, -198630844
     MD5Round "II", d, a, b, C, x(7), S42, 1126891415
     MD5Round "II", C, d, a, b, x(14), S43, -1416354905
     MD5Round "II", b, C, d, a, x(5), S44, -57434055
     MD5Round "II", a, b, C, d, x(12), S41, 1700485571
     MD5Round "II", d, a, b, C, x(3), S42, -1894986606
     MD5Round "II", C, d, a, b, x(10), S43, -1051523
     MD5Round "II", b, C, d, a, x(1), S44, -2054922799
     MD5Round "II", a, b, C, d, x(8), S41, 1873313359
     MD5Round "II", d, a, b, C, x(15), S42, -30611744
     MD5Round "II", C, d, a, b, x(6), S43, -1560198380
     MD5Round "II", b, C, d, a, x(13), S44, 1309151649
     MD5Round "II", a, b, C, d, x(4), S41, -145523070
     MD5Round "II", d, a, b, C, x(11), S42, -1120210379
     MD5Round "II", C, d, a, b, x(2), S43, 718787259
     MD5Round "II", b, C, d, a, x(9), S44, -343485551
     arrLongConversion(1) = MD5LongAdd(arrLongConversion(1), a)
     arrLongConversion(2) = MD5LongAdd(arrLongConversion(2), b)
     arrLongConversion(3) = MD5LongAdd(arrLongConversion(3), C)
     arrLongConversion(4) = MD5LongAdd(arrLongConversion(4), d)
 End Sub
 
Private Function MD5LongAdd(lngVal1 As Long, lngVal2 As Long) As Long
     Dim lngHighWord As Long
     Dim lngLowWord As Long
     Dim lngOverflow As Long
     lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&)
     lngOverflow = lngLowWord \ 65536
     lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + _
                    ((lngVal2 And &HFFFF0000) \ 65536) + _
                    lngOverflow) And &HFFFF&
     MD5LongAdd = MD5LongConversion((lngHighWord * 65536#) + _
                                    (lngLowWord And &HFFFF&))
 End Function
Private Function MD5LongAdd4(lngVal1 As Long, lngVal2 As Long, _
                              lngVal3 As Long, lngVal4 As Long) As Long
     Dim lngHighWord As Long
     Dim lngLowWord As Long
     Dim lngOverflow As Long
 
    lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&) + _
                  (lngVal3 And &HFFFF&) + (lngVal4 And &HFFFF&)
     lngOverflow = lngLowWord \ 65536
     lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + _
                    ((lngVal2 And &HFFFF0000) \ 65536) + _
                    ((lngVal3 And &HFFFF0000) \ 65536) + _
                    ((lngVal4 And &HFFFF0000) \ 65536) + _
                    lngOverflow) And &HFFFF&
     MD5LongAdd4 = MD5LongConversion((lngHighWord * 65536#) + _
                                     (lngLowWord And &HFFFF&))
 End Function
 
Private Sub MD5Decode(intLength As Integer, lngOutBuffer() As Long, _
                       bytInBuffer() As Byte)
     Dim intDblIndex As Integer
     Dim intByteIndex As Integer
     Dim dblSum As Double
 
    intDblIndex = 0
     For intByteIndex = 0 To intLength - 1 Step 4
         dblSum = bytInBuffer(intByteIndex) + _
                  bytInBuffer(intByteIndex + 1) * 256# + _
                  bytInBuffer(intByteIndex + 2) * 65536# + _
                  bytInBuffer(intByteIndex + 3) * 16777216#
         lngOutBuffer(intDblIndex) = MD5LongConversion(dblSum)
         intDblIndex = (intDblIndex + 1)
     Next intByteIndex
 End Sub
 
Private Function MD5LongConversion(dblValue As Double) As Long
     If dblValue < 0 Or dblValue >= OFFSET_4 Then Error 6
     If dblValue <= MAXINT_4 Then
         MD5LongConversion = dblValue
     Else
         MD5LongConversion = dblValue - OFFSET_4
     End If
 End Function
 
Private Sub MD5Finish()
     Dim dblBits As Double
     Dim arrPadding(72) As Byte
     Dim lngBytesBuffered As Long
 
    arrPadding(0) = &H80
     dblBits = lngTrack * 8
     lngBytesBuffered = lngTrack Mod 64
     If lngBytesBuffered <= 56 Then
         MD564Split (56 - lngBytesBuffered), arrPadding
     Else
         MD564Split (120 - lngTrack), arrPadding
     End If
     arrPadding(0) = MD5LongConversion(dblBits) And &HFF&
     arrPadding(1) = MD5LongConversion(dblBits) \ 256 And &HFF&
     arrPadding(2) = MD5LongConversion(dblBits) \ 65536 And &HFF&
     arrPadding(3) = MD5LongConversion(dblBits) \ 16777216 And &HFF&
     arrPadding(4) = 0
     arrPadding(5) = 0
     arrPadding(6) = 0
     arrPadding(7) = 0
     MD564Split 8, arrPadding
 End Sub
 
Private Function MD5StringChange(lngnum As Long) As String
     Dim bytA As Byte
     Dim bytB As Byte
     Dim bytC As Byte
     Dim bytD As Byte
 
    bytA = lngnum And &HFF&
     If bytA < 16 Then
         MD5StringChange = "0" & Hex(bytA)
     Else
         MD5StringChange = Hex(bytA)
     End If
     bytB = (lngnum And &HFF00&) \ 256
     If bytB < 16 Then
         MD5StringChange = MD5StringChange & "0" & Hex(bytB)
     Else
         MD5StringChange = MD5StringChange & Hex(bytB)
     End If
     bytC = (lngnum And &HFF0000) \ 65536
     If bytC < 16 Then
         MD5StringChange = MD5StringChange & "0" & Hex(bytC)
     Else
         MD5StringChange = MD5StringChange & Hex(bytC)
     End If
     If lngnum < 0 Then
         bytD = ((lngnum And &H7F000000) \ 16777216) Or &H80&
     Else
         bytD = (lngnum And &HFF000000) \ 16777216
     End If
     If bytD < 16 Then
         MD5StringChange = MD5StringChange & "0" & Hex(bytD)
     Else
         MD5StringChange = MD5StringChange & Hex(bytD)
     End If
 End Function
 
Private Function MD5Value() As String
     MD5Value = LCase(MD5StringChange(arrLongConversion(1)) & _
                      MD5StringChange(arrLongConversion(2)) & _
                      MD5StringChange(arrLongConversion(3)) & _
                      MD5StringChange(arrLongConversion(4)))
 End Function
 
Public Function FnsCalculateMD5(strMessage As String) As String
     Dim bytBuffer() As Byte
 
    bytBuffer = MD5StringArray(strMessage)
     MD5Start
     MD564Split Len(strMessage), bytBuffer
     MD5Finish
     FnsCalculateMD5 = MD5Value
 End Function
 
Private Sub MD5Start()
     lngTrack = 0
     arrLongConversion(1) = MD5LongConversion(1732584193#)
     arrLongConversion(2) = MD5LongConversion(4023233417#)
     arrLongConversion(3) = MD5LongConversion(2562383102#)
     arrLongConversion(4) = MD5LongConversion(271733878#)
 End Sub

Aufruf z.B.:

MsgBox FnsCalculateMD5("TommyK")

Ergebnis:


 

Ähnliche Artikel

You have no rights to post comments

Login Form

Neueste Artikel

SQL zu VBA Konverter
26. Oktober 2018
Problemstellung: Nur für 32Bit Office Versionen Gibt es eine Möglichkeit SQL-Code einer Abfrage so zu konvertieren das der Code in VBA genutzt werden kann? Lösung: Bis Access 2010 gibt das Tool...
1.png6.png4.png7.png4.png4.png1.png
Heute86
Gestern205
Diese Woche1307
Dieser Monat1813
Total1647441

  • IP: 18.207.160.209
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

1
Online

10. November 2024

Letzte Kommentare

  • Berechnen von Zeiträumen als Abfragekriterium

    elmard 02.02.2021 21:02
    1000 Dank
    für diese Datenbankanwendung! Eine sehr gute Umsetzung mit den vielen Möglichkeiten des Datums.

    Weiterlesen...

     
  • SQL zu VBA Konverter

    Tommy Admin 03.11.2019 16:33
    RE: SQL zu VBA Konverter
    Hallo Elmard, danke für die Info. :lol:

    Weiterlesen...

     
  • SQL zu VBA Konverter

    elmard 03.11.2019 14:49
    Bei SmartTools neue Version 4.0
    Dieses Tool liegt inzwischen in der Version 4 vor und läuft nun auch von A2013 und A2016 sowie im ...

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    TommyK 27.02.2019 06:52
    Workshop
    Hallo mpegjunkie, danke für Dein Feedback. Schön das Dir Workshop weiter hilft. :D

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    mpegjunkie 26.02.2019 20:10
    Perfekter Workshop
    Hallo Tommy, perfekter Workshop, toll und umfassend erläutert. Jetzt nutze ich diese Controls auch.

    Weiterlesen...