MD5 encryptie

[Viperrr]

Kan iemand mij vertellen hoe ik een string kan encrypten met de zogenaamde MD5 methode???

 

[Withaar]

Wat Google al niet voor je kan doen;

http://www.google.nl/search?q=encrypten+MD5&ie=UTF-8&oe=UTF-8&hl=nl&btnG=Google+zoeken&lr=

 

[Viperrr]

Ik had al op meerdere manieren met Google gezicht, maar het ging steeds over Java(Wat ik niet snap) of over VB, maar dan was t al een programma dat je kon kopen ofzo...
Maar oke ik zal nog ff kijken

 

[Withaar]

In VBA... waarschijnlijk niet...

Ik denk dat je dat in VBA niet gaat lukken;

Technische details over PGP

PGP gebruikt een publieke sleutel encryptie-algoritme..
Daarin zijn er 2 sleutels, P() en G(). P() is je publieke sleutel,
G() je geheime-, of privesleutel.
Het RSA-algoritme werk zo : een text X, met RSA behandeld met P()
kan alleen met G() gelezen worden.
G(P(X))=X
Een text X, met RSA behandeld met G() kan alleen met P() gelezen
worden - hierop is ondertekenen gebaseerd :
P(G(X))=X
PGP codeert echter niet de hele text met RSA, dit zou veel te lang
duren. In plaats daarvan maakt PGP een willekeurige 128 bits sleutel
k, en gebruikt die om de text met IDEA te coderen.
IDEA(X,k) en P(k) zijn het gecodeerde bericht.
Door G(P(k))=k kan vervolgens IDEA(X,k) gedecodeerd worden.
(Omdat IDEA een heel ander algoritme is dan RSA zijn de 128 bits
voldoende : symmetrische encryptie is vanaf 112 bits veilig te
noemen, omdat bijvoorbeeld RSA van geheel andere mathematische
principes uitgaat als IDEA, heeft deze ook andere, grote sleutels,
minimaal 1024 om veilig te zijn, nodig.)
Onderteken gaat bijna net zo, alleen nu wordt er een zogenaamde MD5
hash van het bericht genomen, dit is een 128 bits getal dat voor
elk bericht uniek zou moeten zijn.. In werkelijkheid zijn er
natuurlijk "maar" 2 tot de 128de macht mogelijkheden van dat getal,
en hebben 2 berichten een kans van 2 tot de 64de om dezelfde MD5
hash te hebben.. MD5 is in principe net zo veilig als IDEA.
Een ondertekening van een bericht is G(MD5(X)), als je de publieke
sleutel van de ondertekenaar hebt krijg je dus P(G(MD5(X)))=MD5(X),
en MD5(X) kan je gemakkelijk zelf uitrekenen.
Sleutels worden net zo ondertekend, alleen wordt de ondertekening
in het sleutelbos (keyring) formaat opgeslagen.
Als je codeert en ondertekent stuur je IDEA(X+G(MD5(X)),k) en P(k)
De MD5 hash wordt dus ook met IDEA gecodeerd. Decoderen, en de
handtekening controleren gaat dan met G(P(k))=k P(G(MD5(X)))=X en
X decodeer (IDEA) je met k.
Als je het bericht aan meerdere mensen verstuurt dan wordt het
gecodeerde bericht IDEA(X,k) en P(k), P2(k), P3(k) etc..
Oftewel : voor elke publieke key wordt de willekeurige IDEA sessie
key k nog eens met RSA gecodeerd.

echter is is een angel in dit verhaal mbt de IDEA.

Op IDEA geldt internationaal een patent. Als je PGP bedrijfsmatig
wilt gebruiken, dan moet je bij Ascom-Systec AG in Zwitserland een
licentie kopen.

Bron

 

[Viperrr]

het mogelijk moeten zijn watn ik zou neit de eerste zijn geloof ik

 

[wake]

sorry dat ik deze oude post omhoog haal.

ik was op internet lang aan het zoek naar een md5 encrypte voor vba (in access). had alleen een buggie script gevonden. na een uurtje uitzoeken en prutsen heb ik nu een goede md5 encrypter gemaakt voor vba

dus voor de gene die dit via de zoekfunctie of google nog tegen komen hier is hij:

Option Explicit


Private Const BITS_TO_A_BYTE  As Long = 8
Private Const BYTES_TO_A_WORD As Long = 4
Private Const BITS_TO_A_WORD  As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE

Private m_lOnBits(0 To 30) As Long
Private m_l2Power(0 To 30) As Long

'*******************************************************************************
' Class_Initialize (SUB)
'
' DESCRIPTION:
' We will usually get quicker results by preparing arrays of bit patterns and
' powers of 2 ahead of time instead of calculating them every time, unless of
' course the methods are only ever getting called once per instantiation of the
' class.
'*******************************************************************************


'*******************************************************************************
' LShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' A left shift takes all the set binary bits and moves them left, in-filling
' with zeros in the vacated bits on the right. This function is equivalent to
' the << operator in Java and C++
'*******************************************************************************
Private Function LShift(ByVal lValue As Long, _
                        ByVal iShiftBits As Integer) As Long

    ' Could have done this with a loop calculating each value, but simply
    ' assigning the values is quicker - BITS SET FROM RIGHT
    m_lOnBits(0) = 1            ' 00000000000000000000000000000001
    m_lOnBits(1) = 3            ' 00000000000000000000000000000011
    m_lOnBits(2) = 7            ' 00000000000000000000000000000111
    m_lOnBits(3) = 15           ' 00000000000000000000000000001111
    m_lOnBits(4) = 31           ' 00000000000000000000000000011111
    m_lOnBits(5) = 63           ' 00000000000000000000000000111111
    m_lOnBits(6) = 127          ' 00000000000000000000000001111111
    m_lOnBits(7) = 255          ' 00000000000000000000000011111111
    m_lOnBits(8) = 511          ' 00000000000000000000000111111111
    m_lOnBits(9) = 1023         ' 00000000000000000000001111111111
    m_lOnBits(10) = 2047        ' 00000000000000000000011111111111
    m_lOnBits(11) = 4095        ' 00000000000000000000111111111111
    m_lOnBits(12) = 8191        ' 00000000000000000001111111111111
    m_lOnBits(13) = 16383       ' 00000000000000000011111111111111
    m_lOnBits(14) = 32767       ' 00000000000000000111111111111111
    m_lOnBits(15) = 65535       ' 00000000000000001111111111111111
    m_lOnBits(16) = 131071      ' 00000000000000011111111111111111
    m_lOnBits(17) = 262143      ' 00000000000000111111111111111111
    m_lOnBits(18) = 524287      ' 00000000000001111111111111111111
    m_lOnBits(19) = 1048575     ' 00000000000011111111111111111111
    m_lOnBits(20) = 2097151     ' 00000000000111111111111111111111
    m_lOnBits(21) = 4194303     ' 00000000001111111111111111111111
    m_lOnBits(22) = 8388607     ' 00000000011111111111111111111111
    m_lOnBits(23) = 16777215    ' 00000000111111111111111111111111
    m_lOnBits(24) = 33554431    ' 00000001111111111111111111111111
    m_lOnBits(25) = 67108863    ' 00000011111111111111111111111111
    m_lOnBits(26) = 134217727   ' 00000111111111111111111111111111
    m_lOnBits(27) = 268435455   ' 00001111111111111111111111111111
    m_lOnBits(28) = 536870911   ' 00011111111111111111111111111111
    m_lOnBits(29) = 1073741823  ' 00111111111111111111111111111111
    m_lOnBits(30) = 2147483647  ' 01111111111111111111111111111111
    
    ' NOTE: If you can guarantee that the Shift parameter will be in the
    ' range 1 to 30 you can safely strip of this first nested if structure for
    ' speed.
    '
    ' A shift of zero is no shift at all.
   
    If iShiftBits = 0 Then
        LShift = lValue
        Exit Function
        
    ' A shift of 31 will result in the right most bit becoming the left most
    ' bit and all other bits being cleared
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
        
    ' A shift of less than zero or more than 31 is undefined
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    ' If the left most bit that remains will end up in the negative bit
    ' position (&H80000000) we would end up with an overflow if we took the
    ' standard route. We need to strip the left most bit and add it back
    ' afterwards.
    If (lValue And m_l2Power(31 - iShiftBits)) Then
    
        ' (Value And OnBits(31 - (Shift + 1))) chops off the left most bits that
        ' we are shifting into, but also the left most bit we still want as this
        ' is going to end up in the negative bit marker position (&H80000000).
        ' After the multiplication/shift we Or the result with &H80000000 to
        ' turn the negative bit on.
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
            m_l2Power(iShiftBits)) Or &H80000000
    
    Else
    
        ' (Value And OnBits(31-Shift)) chops off the left most bits that we are
        ' shifting into so we do not get an overflow error when we do the
        ' multiplication/shift
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
            m_l2Power(iShiftBits))
        
    End If
End Function

'*******************************************************************************
' RShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' The right shift of an unsigned long integer involves shifting all the set bits
' to the right and in-filling on the left with zeros. This function is
' equivalent to the >>> operator in Java or the >> operator in C++ when used on
' an unsigned long.
'*******************************************************************************
Private Function RShift(ByVal lValue As Long, _
                        ByVal iShiftBits As Integer) As Long
    
    ' Could have done this with a loop calculating each value, but simply
    ' assigning the values is quicker - POWERS OF 2
    
    m_l2Power(0) = 1            ' 00000000000000000000000000000001
    m_l2Power(1) = 2            ' 00000000000000000000000000000010
    m_l2Power(2) = 4            ' 00000000000000000000000000000100
    m_l2Power(3) = 8            ' 00000000000000000000000000001000
    m_l2Power(4) = 16           ' 00000000000000000000000000010000
    m_l2Power(5) = 32           ' 00000000000000000000000000100000
    m_l2Power(6) = 64           ' 00000000000000000000000001000000
    m_l2Power(7) = 128          ' 00000000000000000000000010000000
    m_l2Power(8) = 256          ' 00000000000000000000000100000000
    m_l2Power(9) = 512          ' 00000000000000000000001000000000
    m_l2Power(10) = 1024        ' 00000000000000000000010000000000
    m_l2Power(11) = 2048        ' 00000000000000000000100000000000
    m_l2Power(12) = 4096        ' 00000000000000000001000000000000
    m_l2Power(13) = 8192        ' 00000000000000000010000000000000
    m_l2Power(14) = 16384       ' 00000000000000000100000000000000
    m_l2Power(15) = 32768       ' 00000000000000001000000000000000
    m_l2Power(16) = 65536       ' 00000000000000010000000000000000
    m_l2Power(17) = 131072      ' 00000000000000100000000000000000
    m_l2Power(18) = 262144      ' 00000000000001000000000000000000
    m_l2Power(19) = 524288      ' 00000000000010000000000000000000
    m_l2Power(20) = 1048576     ' 00000000000100000000000000000000
    m_l2Power(21) = 2097152     ' 00000000001000000000000000000000
    m_l2Power(22) = 4194304     ' 00000000010000000000000000000000
    m_l2Power(23) = 8388608     ' 00000000100000000000000000000000
    m_l2Power(24) = 16777216    ' 00000001000000000000000000000000
    m_l2Power(25) = 33554432    ' 00000010000000000000000000000000
    m_l2Power(26) = 67108864    ' 00000100000000000000000000000000
    m_l2Power(27) = 134217728   ' 00001000000000000000000000000000
    m_l2Power(28) = 268435456   ' 00010000000000000000000000000000
    m_l2Power(29) = 536870912   ' 00100000000000000000000000000000
    m_l2Power(30) = 1073741824  ' 01000000000000000000000000000000
    
    
    ' NOTE: If you can guarantee that the Shift parameter will be in the
    ' range 1 to 30 you can safely strip of this first nested if structure for
    ' speed.
    '
    ' A shift of zero is no shift at all
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
        
    ' A shift of 31 will clear all bits and move the left most bit to the right
    ' most bit position
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
        
    ' A shift of less than zero or more than 31 is undefined
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    ' We do not care about the top most bit or the final bit, the top most bit
    ' will be taken into account in the next stage, the final bit (whether it
    ' is an odd number or not) is being shifted into, so we do not give a jot
    ' about it
    
    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    ' If the top most bit (&H80000000) was set we need to do things differently
    ' as in a normal VB signed long integer the top most bit is used to indicate
    ' the sign of the number, when it is set it is a negative number, so just
    ' deviding by a factor of 2 as above would not work.
    ' NOTE: (lValue And  &H80000000) is equivalent to (lValue < 0), you could
    ' get a very marginal speed improvement by changing the test to (lValue < 0)
    If (lValue And &H80000000) Then
        ' We take the value computed so far, and then add the left most negative
        ' bit after it has been shifted to the right the appropriate number of
        ' places
        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function

'*******************************************************************************
' RShiftSigned (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    -
' (In) - iShiftBits - Integer -
'
' RETURN VALUE:
' Long -
'
' DESCRIPTION:
' The right shift of a signed long integer involves shifting all the set bits to
' the right and in-filling on the left with the sign bit (0 if positive, 1 if
' negative. This function is equivalent to the >> operator in Java or the >>
' operator in C++ when used on a signed long integer. Not used in this class,
' but included for completeness.
'*******************************************************************************
Private Function RShiftSigned(ByVal lValue As Long, _
                              ByVal iShiftBits As Integer) As Long
    
    ' NOTE: If you can guarantee that the Shift parameter will be in the
    ' range 1 to 30 you can safely strip of this first nested if structure for
    ' speed.
    '
    ' A shift of zero is no shift at all
    If iShiftBits = 0 Then
        RShiftSigned = lValue
        Exit Function
    
    ' A shift of 31 will clear all bits if the left most bit was zero, and will
    ' set all bits if the left most bit was 1 (a negative indicator)
    ElseIf iShiftBits = 31 Then
        
        ' NOTE: (lValue And  &H80000000) is equivalent to (lValue < 0), you
        ' could get a very marginal speed improvement by changing the test to
        ' (lValue < 0)
        If (lValue And &H80000000) Then
            RShiftSigned = -1
        Else
            RShiftSigned = 0
        End If
        Exit Function
    
    ' A shift of less than zero or more than 31 is undefined
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    ' We get the same result by dividing by the appropriate power of 2 and
    ' rounding in the negative direction
    RShiftSigned = Int(lValue / m_l2Power(iShiftBits))
End Function

'*******************************************************************************
' RotateLeft (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - Value to act on
' (In) - iShiftBits - Integer - Bits to move by
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Rotates the bits in a long integer to the left, those bits falling off the
' left edge are put back on the right edge
'*******************************************************************************
Private Function RotateLeft(ByVal lValue As Long, _
                            ByVal iShiftBits As Integer) As Long
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

'*******************************************************************************
' AddUnsigned (FUNCTION)
'
' PARAMETERS:
' (In) - lX - Long - First value
' (In) - lY - Long - Second value
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Adds two potentially large unsigned numbers without overflowing
'*******************************************************************************
Private Function AddUnsigned(ByVal lX As Long, _
                             ByVal lY As Long) As Long
    Dim lX4     As Long
    Dim lY4     As Long
    Dim lX8     As Long
    Dim lY8     As Long
    Dim lResult As Long
 
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000
 
    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
 
    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If
 
    AddUnsigned = lResult
End Function

'*******************************************************************************
' F (FUNCTION)
'
' DESCRIPTION:
' MD5's F function
'*******************************************************************************
Private Function F(ByVal x As Long, _
                   ByVal y As Long, _
                   ByVal z As Long) As Long
    F = (x And y) Or ((Not x) And z)
End Function

'*******************************************************************************
' G (FUNCTION)
'
' DESCRIPTION:
' MD5's G function
'*******************************************************************************
Private Function G(ByVal x As Long, _
                   ByVal y As Long, _
                   ByVal z As Long) As Long
    G = (x And z) Or (y And (Not z))
End Function

'*******************************************************************************
' H (FUNCTION)
'
' DESCRIPTION:
' MD5's H function
'*******************************************************************************
Private Function H(ByVal x As Long, _
                   ByVal y As Long, _
                   ByVal z As Long) As Long
    H = (x Xor y Xor z)
End Function

'*******************************************************************************
' I (FUNCTION)
'
' DESCRIPTION:
' MD5's I function
'*******************************************************************************
Private Function I(ByVal x As Long, _
                   ByVal y As Long, _
                   ByVal z As Long) As Long
    I = (y Xor (x Or (Not z)))
End Function

'*******************************************************************************
' FF (SUB)
'
' DESCRIPTION:
' MD5's FF procedure
'*******************************************************************************
Private Sub FF(a As Long, _
               ByVal b As Long, _
               ByVal c As Long, _
               ByVal d As Long, _
               ByVal x As Long, _
               ByVal s As Long, _
               ByVal ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

'*******************************************************************************
' GG (SUB)
'
' DESCRIPTION:
' MD5's GG procedure
'*******************************************************************************
Private Sub GG(a As Long, _
               ByVal b As Long, _
               ByVal c As Long, _
               ByVal d As Long, _
               ByVal x As Long, _
               ByVal s As Long, _
               ByVal ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

'*******************************************************************************
' HH (SUB)
'
' DESCRIPTION:
' MD5's HH procedure
'*******************************************************************************
Private Sub HH(a As Long, _
               ByVal b As Long, _
               ByVal c As Long, _
               ByVal d As Long, _
               ByVal x As Long, _
               ByVal s As Long, _
               ByVal ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

'*******************************************************************************
' II (SUB)
'
' DESCRIPTION:
' MD5's II procedure
'*******************************************************************************
Private Sub II(a As Long, _
               ByVal b As Long, _
               ByVal c As Long, _
               ByVal d As Long, _
               ByVal x As Long, _
               ByVal s As Long, _
               ByVal ac As Long)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

'*******************************************************************************
' ConvertToWordArray (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sMessage - String - String message
'
' RETURN VALUE:
' Long() - Converted message as long array
'
' DESCRIPTION:
' Takes the string message and puts it in a long array with padding according to
' the MD5 rules.
'*******************************************************************************
Private Function ConvertToWordArray(sMessage As String) As Long()


    Dim lMessageLength  As Long
    Dim lNumberOfWords  As Long
    Dim lWordArray()    As Long
    Dim lBytePosition   As Long
    Dim lByteCount      As Long
    Dim lWordCount      As Long
    
    Const MODULUS_BITS      As Long = 512
    Const CONGRUENT_BITS    As Long = 448
    
    lMessageLength = Len(sMessage)

    ' Get padded number of words. Message needs to be congruent to 448 bits,
    ' modulo 512 bits. If it is exactly congruent to 448 bits, modulo 512 bits
    ' it must still have another 512 bits added. 512 bits = 64 bytes
    ' (or 16 * 4 byte words), 448 bits = 56 bytes. This means lMessageSize must
    ' be a multiple of 16 (i.e. 16 * 4 (bytes) * 8 (bits))
    lNumberOfWords = (((lMessageLength + _
        ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
        (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
        (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)
    
    
    ' Combine each block of 4 bytes (ascii code of character) into one long
    ' value and store in the message. The high-order (most significant) bit of
    ' each byte is listed first. However, the low-order (least significant) byte
    ' is given first in each word.
    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
        ' Each word is 4 bytes
        lWordCount = lByteCount \ BYTES_TO_A_WORD

        ' The bytes are put in the word from the right most edge
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
        lWordArray(lWordCount) = lWordArray(lWordCount) Or _
            LShift(AscB(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
        lByteCount = lByteCount + 1
        
    Loop


    ' Terminate according to MD5 rules with a 1 bit, zeros and the length in
    ' bits stored in the last two words
    lWordCount = lByteCount \ BYTES_TO_A_WORD
    

    
    lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE



    ' Add a terminating 1 bit, all the rest of the bits to the end of the
    ' word array will default to zero
    lWordArray(lWordCount) = lWordArray(lWordCount) Or _
        LShift(&H80, lBytePosition)


    ' We put the length of the message in bits into the last two words, to get
    ' the length in bits we need to multiply by 8 (or left shift 3). This left
    ' shifted value is put in the first word. Any bits shifted off the left edge
    ' need to be put in the second word, we can work out which bits by shifting
    ' right the length by 29 bits.
    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
        
    ConvertToWordArray = lWordArray
End Function

'*******************************************************************************
' WordToHex (FUNCTION)
'
' PARAMETERS:
' (In) - lValue - Long - Long value to convert
'
' RETURN VALUE:
' String - Hex value to return
'
' DESCRIPTION:
' Takes a long integer and due to the bytes reverse order it extracts the
' individual bytes and converts them to hex appending them for an overall hex
' value
'*******************************************************************************
Private Function WordToHex(ByVal lValue As Long) As String

    Dim lByte As Long
    Dim lCount As Long
    
    For lCount = 0 To 3
        lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And _
            m_lOnBits(BITS_TO_A_BYTE - 1)
        WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
    Next
End Function

'*******************************************************************************
' MD5 (FUNCTION)
'
' PARAMETERS:
' (In/Out) - sMessage - String - String to be digested
'
' RETURN VALUE:
' String - The MD5 digest
'
' DESCRIPTION:
' This function takes a string message and generates an MD5 digest for it.
' sMessage can be up to the VB string length limit of 2^31 (approx. 2 billion)
' characters.
'
' NOTE: Due to the way in which the string is processed the routine assumes a
' single byte character set. VB passes unicode (2-byte) character strings, the
' ConvertToWordArray function uses on the first byte for each character. This
' has been done this way for ease of use, to make the routine truely portable
' you could accept a byte array instead, it would then be up to the calling
' routine to make sure that the byte array is generated from their string in
' a manner consistent with the string type.
'*******************************************************************************
Public Function ENCRYPT(sMessage As String) As String

    Dim x() As Long
    Dim k   As Long
    Dim AA  As Long
    Dim BB  As Long
    Dim CC  As Long
    Dim DD  As Long
    Dim a   As Long
    Dim b   As Long
    Dim c   As Long
    Dim d   As Long
    
    Const S11 As Long = 7
    Const S12 As Long = 12
    Const S13 As Long = 17
    Const S14 As Long = 22
    Const S21 As Long = 5
    Const S22 As Long = 9
    Const S23 As Long = 14
    Const S24 As Long = 20
    Const S31 As Long = 4
    Const S32 As Long = 11
    Const S33 As Long = 16
    Const S34 As Long = 23
    Const S41 As Long = 6
    Const S42 As Long = 10
    Const S43 As Long = 15
    Const S44 As Long = 21


    ' Steps 1 and 2.  Append padding bits and length and convert to words
    x = ConvertToWordArray(sMessage)


    ' Step 3.  Initialise
    a = &H67452301
    b = &HEFCDAB89
    c = &H98BADCFE
    d = &H10325476


    ' Step 4.  Process the message in 16-word blocks
    For k = 0 To UBound(x) Step 16
        AA = a
        BB = b
        CC = c
        DD = d
    
    
        ' The hex number on the end of each of the following procedure calls is
        ' an element from the 64 element table constructed with
        ' T(i) = Int(4294967296 * Abs(Sin(i))) where i is 1 to 64.
        '
        ' However, for speed we don't want to calculate the value every time.
        FF a, b, c, d, x(k + 0), S11, &HD76AA478
        FF d, a, b, c, x(k + 1), S12, &HE8C7B756
        FF c, d, a, b, x(k + 2), S13, &H242070DB
        FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
        FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
        FF d, a, b, c, x(k + 5), S12, &H4787C62A
        FF c, d, a, b, x(k + 6), S13, &HA8304613
        FF b, c, d, a, x(k + 7), S14, &HFD469501
        FF a, b, c, d, x(k + 8), S11, &H698098D8
        FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
        FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
        FF b, c, d, a, x(k + 11), S14, &H895CD7BE
        FF a, b, c, d, x(k + 12), S11, &H6B901122
        FF d, a, b, c, x(k + 13), S12, &HFD987193
        FF c, d, a, b, x(k + 14), S13, &HA679438E
        FF b, c, d, a, x(k + 15), S14, &H49B40821
    
        GG a, b, c, d, x(k + 1), S21, &HF61E2562
        GG d, a, b, c, x(k + 6), S22, &HC040B340
        GG c, d, a, b, x(k + 11), S23, &H265E5A51
        GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
        GG a, b, c, d, x(k + 5), S21, &HD62F105D
        GG d, a, b, c, x(k + 10), S22, &H2441453
        GG c, d, a, b, x(k + 15), S23, &HD8A1E681
        GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
        GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
        GG d, a, b, c, x(k + 14), S22, &HC33707D6
        GG c, d, a, b, x(k + 3), S23, &HF4D50D87
        GG b, c, d, a, x(k + 8), S24, &H455A14ED
        GG a, b, c, d, x(k + 13), S21, &HA9E3E905
        GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
        GG c, d, a, b, x(k + 7), S23, &H676F02D9
        GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
            
        HH a, b, c, d, x(k + 5), S31, &HFFFA3942
        HH d, a, b, c, x(k + 8), S32, &H8771F681
        HH c, d, a, b, x(k + 11), S33, &H6D9D6122
        HH b, c, d, a, x(k + 14), S34, &HFDE5380C
        HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
        HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
        HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
        HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
        HH a, b, c, d, x(k + 13), S31, &H289B7EC6
        HH d, a, b, c, x(k + 0), S32, &HEAA127FA
        HH c, d, a, b, x(k + 3), S33, &HD4EF3085
        HH b, c, d, a, x(k + 6), S34, &H4881D05
        HH a, b, c, d, x(k + 9), S31, &HD9D4D039
        HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
        HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
        HH b, c, d, a, x(k + 2), S34, &HC4AC5665
    
        II a, b, c, d, x(k + 0), S41, &HF4292244
        II d, a, b, c, x(k + 7), S42, &H432AFF97
        II c, d, a, b, x(k + 14), S43, &HAB9423A7
        II b, c, d, a, x(k + 5), S44, &HFC93A039
        II a, b, c, d, x(k + 12), S41, &H655B59C3
        II d, a, b, c, x(k + 3), S42, &H8F0CCC92
        II c, d, a, b, x(k + 10), S43, &HFFEFF47D
        II b, c, d, a, x(k + 1), S44, &H85845DD1
        II a, b, c, d, x(k + 8), S41, &H6FA87E4F
        II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
        II c, d, a, b, x(k + 6), S43, &HA3014314
        II b, c, d, a, x(k + 13), S44, &H4E0811A1
        II a, b, c, d, x(k + 4), S41, &HF7537E82
        II d, a, b, c, x(k + 11), S42, &HBD3AF235
        II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
        II b, c, d, a, x(k + 9), S44, &HEB86D391
    
        a = AddUnsigned(a, AA)
        b = AddUnsigned(b, BB)
        c = AddUnsigned(c, CC)
        d = AddUnsigned(d, DD)
    Next
    
    
    ' Step 5.  Output the 128 bit digest
    ENCRYPT = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
    
    
End Function

Public Function MD5(sString As String) As String

' Run the encryption twice to make sure you alwasy get a good encryption (access bug)
ENCRYPT (sString)
MD5 = ENCRYPT(sString)

End Function

aanroepen: MD5("hier jou string")



---

Bo Pennings