Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Pop3/Smtp/Imap MD5 sources for APOP, SASL/Digest-MD5 and SASL/CRAM-MD5

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Pop3/Smtp/Imap MD5 sources for APOP, SASL/Digest-MD5 and SASL/CRAM-MD5



    Hello,

    the following PowerBASIC/DOS source code includes the MD5 sources
    for secure authentication with Pop3-APOP, Pop3-Auth, Smtp-Auth and
    Imap-Auth.

    Code:
    File: MD5-TEST.BAS
    '*************************************************************************
    '
    ' UKAD-Paket   : MD5-Implementationen (internal Testroutines)
    ' used by      : POP3 APOP
    '                POP3 AUTH/SASL (Digest-MD5 and CRAM-MD5)
    '                SMTP AUTH/SASL (Digest-MD5 and CRAM-MD5)
    '                IMAP AUTH/SASL (Digest-MD5 and CRAM-MD5)
    ' Version      : 2.05g
    ' Compilation  : Thomas Gohel ( mailto:gohel@basicguru.comgohel@basicguru.com</A> )
    ' Homepage     : http://www.gohel.de/ukad 
    '
    '*************************************************************************
    
    $COMPILE EXE
    $DIM ALL                                    ' alle Variablen deklarieren (gut f³r Tipfehler)
    $ERROR ALL ON
    $DEBUG MAP OFF
    $STACK 4096                                 ' Important!!
    $INCLUDE "MD5.INC"                          ' MD5 Routines
    
    CALL PBMain
    
    '-------------------------------------------------------------------------------------------
    ' Test routines for MD5 (used for APOP/Digest-MD5, RFC 1321)
    '-------------------------------------------------------------------------------------------
    SUB MD5_Test()
    
            DIM   MD5_ctx_Test AS LOCAL MD5_CTX     '
            DIM   sText        AS LOCAL STRING      '
            DIM   szTest       AS LOCAL ASCIIZ * 33 '
    
            PRINT
            PRINT "Testing examples from RFC 1321 (used by APOP/Digest-MD5)"
    
    
            ' Test 1
    
            sText = ""
    
            CALL MD5_Init(VARPTR32(MD5_ctx_Test))    ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText) )
            szTest = MD5_Digest(VARPTR32(md5_ctx_Test))
            IF szTest = "d41d8cd98f00b204e9800998ecf8427e" THEN
                PRINT "Test 1: Ok    - "; szTest
            ELSE
                PRINT "Test 1: False - "; szTest
            END IF
    
            ' Test 2
            sText = "a"
            CALL MD5_Init( VARPTR32(MD5_ctx_Test))   ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText))
            szTest = MD5_Digest(VARPTR32(MD5_ctx_Test))
            IF szTest = "0cc175b9c0f1b6a831c399e269772661" THEN
                PRINT "Test 2: Ok    - "; szTest
            ELSE
                PRINT "Test 2: False - "; szTest
            END IF
    
            ' Test 3
            sText = "abc"
            CALL MD5_Init(VARPTR32(MD5_ctx_Test))     ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText))
            szTest = MD5_Digest(VARPTR32(MD5_ctx_Test))
            IF szTest = "900150983cd24fb0d6963f7d28e17f72" THEN
                PRINT "Test 3: Ok    - "; szTest
            ELSE
                PRINT "Test 3: False - "; szTest
            END IF
    
            ' Test 4
            sText = "message digest"
            CALL MD5_Init(VARPTR32(MD5_ctx_Test))     ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText))
            szTest = MD5_Digest(VARPTR32(MD5_ctx_Test))
    
            IF szTest = "f96b697d7cb7938d525a2f31aaf161d0" THEN
                PRINT "Test 4: Ok    - "; szTest
            ELSE
                PRINT "Test 4: False - "; szTest
            END IF
    
            ' Test 5
            sText = "abcdefghijklmnopqrstuvwxyz"
            CALL MD5_Init(VARPTR32(MD5_ctx_Test))     ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText))
            szTest = MD5_Digest(VARPTR32(MD5_ctx_Test))
            IF szTest = "c3fcd3d76192e4007dfb496cca67e13b" THEN
                PRINT "Test 5: Ok    - "; szTest
            ELSE
                PRINT "Test 5: False - "; szTest
            END IF
    
            ' Test 6
            sText = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
            CALL MD5_Init(VARPTR32(MD5_ctx_Test))     ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText))
            szTest = MD5_Digest(VARPTR32(MD5_ctx_Test))
            IF szTest =  "d174ab98d277d9f5a5611c2c9f419d9f" THEN
                PRINT "Test 6: Ok    - "; szTest
            ELSE
                PRINT "Test 6: False - "; szTest
            END IF
    
            ' Test 7
            sText = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
            CALL MD5_Init(VARPTR32(MD5_ctx_Test))     ' call md5_Init each time to calculate a new digest
            CALL MD5_Update(VARPTR32(MD5_ctx_Test), sText, LEN(sText))
            szTest = MD5_Digest(VARPTR32(MD5_ctx_Test))
            IF szTest = "57edf4a22be3c955ac49da2e2107b67a" THEN
                PRINT "Test 7: Ok    - "; szTest
            ELSE
                PRINT "Test 7: False - "; szTest
            END IF
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    ' Test routines for HMAC-MD5 (used for SASL/CRAM-MD5, RFC 2104)
    '-------------------------------------------------------------------------------------------
    SUB CRAM_MD5_Test()
    
            DIM   szText       AS STRING      '
            DIM   szKey        AS STRING
            DIM   szTest       AS STRING      '
            DIM   i            AS INTEGER     '
    
            PRINT "Testing examples from RFC 2104 (used by SASL/CRAM-MD5)"
    
            ' Test 1
            szKey = STRING$(16, &h0B)
            szText = "Hi There"
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "9294727a3638bb1c13f48ef8158bfc9d" THEN
                PRINT "Test 1: Ok    - "; szTest
            ELSE
                PRINT "Test 1: False - "; szTest
            END IF
    
            ' Test 2
            szKey  = "Jefe"
            szText = "what do ya want for nothing?"
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "750c783e6ab0b503eaa86e310a5db738" THEN
                PRINT "Test 2: Ok    - "; szTest
            ELSE
                PRINT "Test 2: False - "; szTest
            END IF
    
            ' Test 3
            szKey  = STRING$(16, &hAA)
            szText = STRING$(50, &hDD)
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "56be34521d144c88dbb8c733f0e8b3f6" THEN
                PRINT "Test 3: Ok    - "; szTest
            ELSE
                PRINT "Test 3: False - "; szTest
            END IF
    
            PRINT
            PRINT "Testing examples from RFC 2202 (used by SASL/CRAM-MD5)"
    
            ' Test 4
            szKey = ""
            FOR i% = 1 TO 25
               szKey = szKey + CHR$(i%)
            NEXT i%
            szText =  STRING$(50, &hCD)
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "697eaf0aca3a3aea3a75164746ffaa79" THEN
                PRINT "Test 4: Ok    - "; szTest
            ELSE
                PRINT "Test 4: False - "; szTest
            END IF
    
            ' Test 5
            szKey  = STRING$(16, &h0C)
            szText = "Test With Truncation"
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "56461ef2342edc00f9bab995690efd4c" THEN
                PRINT "Test 5: Ok    - "; szTest
            ELSE
                PRINT "Test 5: False - "; szTest
            END IF
    
            ' Test 6
            szKey  = STRING$(80, &hAA)
            szText = "Test Using Larger Than Block-Size Key - Hash Key First"
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" THEN
                PRINT "Test 6: Ok    - "; szTest
            ELSE
                PRINT "Test 6: False - "; szTest
            END IF
    
            ' Test 7
            szKey  = STRING$(80, &hAA)
            szText = "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
            szTest = Get_CRAM_MD5(szText, szKey)
            IF szTest = "6f630fad67cda0ee1fb1f562db3aa53e" THEN
                PRINT "Test 7: Ok    - "; szTest
            ELSE
                PRINT "Test 7: False - "; szTest
            END IF
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    ' Test routines for SASL/DIGEST-MD5 (used for SASL/DIGEST-MD5, RFC 2831)
    '-------------------------------------------------------------------------------------------
    SUB DIGEST_MD5_Test()
    
            DIM szTest       AS LOCAL STRING
            DIM A1           AS LOCAL STRING      '
            DIM A2           AS LOCAL STRING      '
    
            PRINT "Testing examples from RFC 2831 (used by SASL/DIGEST-MD5)"
    
            ' Test 1
            A1 = Get_String_MD5("chris:elwood.innosoft.com:secret") + ":OA6MG9tEQGm2hh:OA6MHXh6VqTrRk"
            A2 = "AUTHENTICATE:imap/elwood.innosoft.com"
            szTest = Get_Digest_MD5(Get_Digest_MD5(A1) + ":OA6MG9tEQGm2hh:00000001:OA6MHXh6VqTrRk:" + _
                     "auth:" + Get_Digest_MD5(A2))
            IF szTest = "d388dad90d4bbd760a152321f2143af7" THEN
                PRINT "Test 1: Ok    - "; szTest
            ELSE
                PRINT "Test 1: False - "; szTest
            END IF
    
    END SUB
    
    
    FUNCTION PBMAIN() AS LONG
    
            CLS
            PRINT
    
            CALL MD5_Test()
            PRINT
            CALL CRAM_MD5_Test()
            PRINT
            CALL DIGEST_MD5_Test()
    
    
    END FUNCTION
    Code:
    File: MD5.INC
    '************************************************************************
    '
    ' UKAD Paket   : MD5-Implementationen (MD5, DIGEST-MD5, CRAM-MD5)
    ' Version      : 2.05g
    ' Compilation  : Thomas Gohel ( mailto:gohel@basicguru.comgohel@basicguru.com</A> )
    ' Last Files at: http://www.gohel.de 
    ' Last Updates : see directly in the sources
    '
    '************************************************************************
    '
    ' Original code notice:
    '
    ' This code implements the MD5 message-digest algorithm. The algorithm is
    ' due TO Ron Rivest.  This code was written by Colin Plumb IN 1993, no
    ' copyright is claimed. This code is IN the public domain; DO WITH it what
    ' you wish.
    '
    ' Equivalent code is available FROM RSA DATA Security, Inc. This code has
    ' been tested against that, AND is equivalent, except that you don't need to
    ' include two pages OF legalese WITH every copy.
    '
    ' TO compute the message digest of a chunk of bytes, DECLARE an MD5Context
    ' structure, pass it TO MD5Init, CALL MD5Update AS needed ON buffers full
    ' OF bytes, AND THEN CALL MD5Final, which will fill a supplied 16-BYTE
    ' ARRAY WITH the digest.
    '
    ' 10.04.2000 - Translated to PowerBASIC/DLL32 by Florent Heyworth
    ' 10.12.2000 - Translated to PowerBASIC/CC by Thomas Gohel
    '              Add support for CRAM-MD5 for SMTP AUTH (RFC 2104)
    ' 26.12.2001 - Add support for PowerBASIC/DLL v6.10 and PowerBASIC/CC v2.10
    ' 24.02.2002 - Translated to PowerBASIC/DOS v3.50
    ' 28.02.2002 - fixed problem with SASL/DIGEST-MD5 (RFC 2831)
    '
    '************************************************************************
    
    %NULL = 0
    
    DECLARE FUNCTION Get_Digest_MD5(BYVAL szText AS STRING) AS STRING
    DECLARE FUNCTION Get_String_MD5(BYVAL szText AS STRING) AS STRING
    DECLARE FUNCTION Get_CRAM_MD5(BYVAL sText AS STRING, BYVAL sKey AS STRING) AS STRING
    DECLARE SUB MD5_MoveMemory (BYVAL pDestination AS DWORD, BYVAL pSource AS DWORD, BYVAL cbLength AS LONG)
    DECLARE SUB MD5_FillMemory (BYVAL pDestination AS DWORD, BYVAL cbLength AS LONG, BYVAL bFill AS BYTE)
    DECLARE SUB MD5_ZeroMemory (BYVAL pDestination AS DWORD, BYVAL cbLength AS LONG)
    
    '-------------------------------------------------------------------------------------------
    ' Win32-Memory-API
    '-------------------------------------------------------------------------------------------
    SUB MD5_MoveMemory (BYVAL pDestination AS DWORD, BYVAL pSource AS DWORD,  BYVAL cbLength AS LONG)
    
            DIM pDest        AS BYTE PTR          '
            DIM pSour        AS BYTE PTR
            DIM i            AS LOCAL LONG
            DIM bFill        AS LOCAL BYTE
    
            pDest = pDestination
            pSour = pSource
    
            FOR i& = 1 TO cbLength
                bFill = @pSour
                @pDest = bFill
                INCR pSour
                INCR pDest
            NEXT i&
    
    END SUB
    
    SUB MD5_FillMemory (BYVAL pDestination AS DWORD, BYVAL cbLength AS LONG, BYVAL bFill AS BYTE)
    
            DIM i            AS LONG              '
            DIM pDest        AS BYTE PTR
            pDest = pDestination
            FOR i& = 1 TO cbLength
                @pDest = bFill
               INCR pDest
            NEXT i&
    
    END SUB
    
    SUB MD5_ZeroMemory (BYVAL pDestination AS DWORD, BYVAL cbLength AS LONG)
    
            MD5_FillMemory pDestination, cbLength, 0
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    ' Constants FOR MD5_Transform routine
    '-------------------------------------------------------------------------------------------
    
    %S11 = 7
    %S12 = 12
    %S13 = 17
    %S14 = 22
    %S21 = 5
    %S22 = 9
    %S23 = 14
    %S24 = 20
    %S31 = 4
    %S32 = 11
    %S33 = 16
    %S34 = 23
    %S41 = 6
    %S42 = 10
    %S43 = 15
    %S44 = 21
    
    TYPE MD5_CTX
            lState(4)    AS DWORD        ' state (ABCD)
            lCount(2)    AS DWORD        ' number of bits modulo 2^64 (lsp first)
            bBuf         AS STRING * 64  ' input buffer
    END TYPE
    
    '-------------------------------------------------------------------------------------------
    ' PB really should have BUILT-IN function for shift instead of SHIFT LEFT|RIGHT semantics....
    '-------------------------------------------------------------------------------------------
    FUNCTION MD5_ShiftRight(BYVAL lThis AS LONG, BYVAL lBits AS LONG) AS LONG
    
            SHIFT RIGHT lThis, lBits
            FUNCTION = lThis
    
    END FUNCTION
    
    FUNCTION MD5_ShiftLeft(BYVAL lThis AS LONG, BYVAL lBits AS LONG) AS LONG
    
            SHIFT LEFT lThis, lBits
            FUNCTION = lThis
    
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------
    '
    '-------------------------------------------------------------------------------------------
    SUB MD5_Init(BYVAL dwContext AS DWORD)
    
            'MD5 initialization. Begins an MD5 operation, writing a new context
            DIM tContext     AS LOCAL MD5_CTX PTR '
    
            tContext = dwContext
    
            @tContext.lCount(0) = 0
            @tContext.lCount(1) = 0
    
            ' Load magic initialization constants.
            @tContext.lState(0) = &H67452301
            @tContext.lState(1) = &HEFCDAB89
            @tContext.lState(2) = &H98BADCFE
            @tContext.lState(3) = &H10325476
    
    END SUB
    
    SUB MD5_Transform (BYVAL dwcBuf AS DWORD, BYVAL dwBuf AS DWORD)
    
            DIM a            AS LOCAL DWORD       '
            DIM b            AS LOCAL DWORD       '
            DIM c            AS LOCAL DWORD       '
            DIM d            AS LOCAL DWORD       '
            DIM bBuf         AS LOCAL LONG PTR    '
            DIM tContext     AS LOCAL MD5_CTX PTR
    
            bBuf = dwBuf
            tContext = dwcBuf
            a = @tContext.lState(0)
            b = @tContext.lState(1)
            c = @tContext.lState(2)
            d = @tContext.lState(3)
    
            ' ROUND 1
            a = a + ((((b)) AND ((c))) OR ((NOT (b)) AND ((d)))) + (@bBuf[ 0]) +&Hd76aa478
            ROTATE LEFT a, %S11: a = a + b
            d = d + ((((a)) AND ((b))) OR ((NOT (a)) AND ((c)))) + (@bBuf[ 1]) +&He8c7b756
            ROTATE LEFT d, %S12: d = d + a
            c = c + ((((d)) AND ((a))) OR ((NOT (d)) AND ((b)))) + (@bBuf[ 2]) +&H242070db
            ROTATE LEFT c, %S13: c = c + d
            b = b + ((((c)) AND ((d))) OR ((NOT (c)) AND ((a)))) + (@bBuf[ 3]) +&Hc1bdceee
            ROTATE LEFT b, %S14: b = b + c
            '
            a = a + ((((b)) AND ((c))) OR ((NOT (b)) AND ((d)))) + (@bBuf[ 4]) +&Hf57c0faf
            ROTATE LEFT a, %S11: a = a + b
            d = d + ((((a)) AND ((b))) OR ((NOT (a)) AND ((c)))) + (@bBuf[ 5]) +&H4787c62a
            ROTATE LEFT d, %S12: d = d + a
            c = c + ((((d)) AND ((a))) OR ((NOT (d)) AND ((b)))) + (@bBuf[ 6]) +&Ha8304613
            ROTATE LEFT c, %S13: c = c + d
            b = b + ((((c)) AND ((d))) OR ((NOT (c)) AND ((a)))) + (@bBuf[ 7]) +&Hfd469501
            ROTATE LEFT b, %S14: b = b + c
            '
            a = a + ((((b)) AND ((c))) OR ((NOT (b)) AND ((d)))) + (@bBuf[ 8]) +&H698098d8
            ROTATE LEFT a, %S11: a = a + b
            d = d + ((((a)) AND ((b))) OR ((NOT (a)) AND ((c)))) + (@bBuf[ 9]) +&H8b44f7af
            ROTATE LEFT d, %S12: d = d + a
            c = c + ((((d)) AND ((a))) OR ((NOT (d)) AND ((b)))) + (@bBuf[10]) +&Hffff5bb1
            ROTATE LEFT c, %S13: c = c + d
            b = b + ((((c)) AND ((d))) OR ((NOT (c)) AND ((a)))) + (@bBuf[11]) +&H895cd7be
            ROTATE LEFT b, %S14: b = b + c
            '
            a = a + ((((b)) AND ((c))) OR ((NOT (b)) AND ((d)))) + (@bBuf[12]) +&H6b901122
            ROTATE LEFT a, %S11: a = a + b
            d = d + ((((a)) AND ((b))) OR ((NOT (a)) AND ((c)))) + (@bBuf[13]) +&Hfd987193
            ROTATE LEFT d, %S12: d = d + a
            c = c + ((((d)) AND ((a))) OR ((NOT (d)) AND ((b)))) + (@bBuf[14]) +&Ha679438e
            ROTATE LEFT c, %S13: c = c + d
            b = b + ((((c)) AND ((d))) OR ((NOT (c)) AND ((a)))) + (@bBuf[15]) +&H49b40821
            ROTATE LEFT b, %S14: b = b + c
    
            ' ROUND 2
            a = a + ((((b)) AND ((d))) OR (((c)) AND (NOT (d)))) + (@bBuf[ 1]) +&Hf61e2562
            ROTATE LEFT a, %S21: a = a + b
            d = d + ((((a)) AND ((c))) OR (((b)) AND (NOT (c)))) + (@bBuf[ 6]) +&Hc040b340
            ROTATE LEFT d, %S22: d = d + a
            c = c + ((((d)) AND ((b))) OR (((a)) AND (NOT (b)))) + (@bBuf[11]) +&H265e5a51
            ROTATE LEFT c, %S23: c = c + d
            b = b + ((((c)) AND ((a))) OR (((d)) AND (NOT (a)))) + (@bBuf[ 0]) +&He9b6c7aa
            ROTATE LEFT b, %S24: b = b + c
            '
            a = a + ((((b)) AND ((d))) OR (((c)) AND (NOT (d)))) + (@bBuf[ 5]) +&Hd62f105d
            ROTATE LEFT a, %S21: a = a + b
            d = d + ((((a)) AND ((c))) OR (((b)) AND (NOT (c)))) + (@bBuf[10]) +&H2441453
            ROTATE LEFT d, %S22: d = d + a
            c = c + ((((d)) AND ((b))) OR (((a)) AND (NOT (b)))) + (@bBuf[15]) +&Hd8a1e681
            ROTATE LEFT c, %S23: c = c + d
            b = b + ((((c)) AND ((a))) OR (((d)) AND (NOT (a)))) + (@bBuf[ 4]) +&He7d3fbc8
            ROTATE LEFT b, %S24: b = b + c
            '
            a = a + ((((b)) AND ((d))) OR (((c)) AND (NOT (d)))) + (@bBuf[ 9]) +&H21e1cde6
            ROTATE LEFT a, %S21: a = a + b
            d = d + ((((a)) AND ((c))) OR (((b)) AND (NOT (c)))) + (@bBuf[14]) +&Hc33707d6
            ROTATE LEFT d, %S22: d = d + a
            c = c + ((((d)) AND ((b))) OR (((a)) AND (NOT (b)))) + (@bBuf[ 3]) +&Hf4d50d87
            ROTATE LEFT c, %S23: c = c + d
            b = b + ((((c)) AND ((a))) OR (((d)) AND (NOT (a)))) + (@bBuf[ 8]) +&H455a14ed
            ROTATE LEFT b, %S24: b = b + c
            '
            a = a + ((((b)) AND ((d))) OR (((c)) AND (NOT (d)))) + (@bBuf[13]) +&Ha9e3e905
            ROTATE LEFT a, %S21: a = a + b
            d = d + ((((a)) AND ((c))) OR (((b)) AND (NOT (c)))) + (@bBuf[ 2]) +&Hfcefa3f8
            ROTATE LEFT d, %S22: d = d + a
            c = c + ((((d)) AND ((b))) OR (((a)) AND (NOT (b)))) + (@bBuf[ 7]) +&H676f02d9
            ROTATE LEFT c, %S23: c = c + d
            b = b + ((((c)) AND ((a))) OR (((d)) AND (NOT (a)))) + (@bBuf[12]) +&H8d2a4c8a
            ROTATE LEFT b, %S24: b = b + c
    
    
            ' ROUND 3
            a = a + (((b)) XOR ((c)) XOR ((d))) + (@bBuf[ 5]) +&Hfffa3942
            ROTATE LEFT a, %S31: a = a + b
            d = d + (((a)) XOR ((b)) XOR ((c))) + (@bBuf[ 8]) +&H8771f681
            ROTATE LEFT d, %S32: d = d + a
            c = c + (((d)) XOR ((a)) XOR ((b))) + (@bBuf[11]) +&H6d9d6122
            ROTATE LEFT c, %S33: c = c + d
            b = b + (((c)) XOR ((d)) XOR ((a))) + (@bBuf[14]) +&Hfde5380c
            ROTATE LEFT b, %S34: b = b + c
            '
            a = a + (((b)) XOR ((c)) XOR ((d))) + (@bBuf[ 1]) +&Ha4beea44
            ROTATE LEFT a, %S31: a = a + b
            d = d + (((a)) XOR ((b)) XOR ((c))) + (@bBuf[ 4]) +&H4bdecfa9
            ROTATE LEFT d, %S32: d = d + a
            c = c + (((d)) XOR ((a)) XOR ((b))) + (@bBuf[ 7]) +&Hf6bb4b60
            ROTATE LEFT c, %S33: c = c + d
            b = b + (((c)) XOR ((d)) XOR ((a))) + (@bBuf[10]) +&Hbebfbc70
            ROTATE LEFT b, %S34: b = b + c
            '
            a = a + (((b)) XOR ((c)) XOR ((d))) + (@bBuf[13]) +&H289b7ec6
            ROTATE LEFT a, %S31: a = a + b
            d = d + (((a)) XOR ((b)) XOR ((c))) + (@bBuf[ 0]) +&Heaa127fa
            ROTATE LEFT d, %S32: d = d + a
            c = c + (((d)) XOR ((a)) XOR ((b))) + (@bBuf[ 3]) +&Hd4ef3085
            ROTATE LEFT c, %S33: c = c + d
            b = b + (((c)) XOR ((d)) XOR ((a))) + (@bBuf[ 6]) +&H4881d05
            ROTATE LEFT b, %S34: b = b + c
            '
            a = a + (((b)) XOR ((c)) XOR ((d))) + (@bBuf[ 9]) +&Hd9d4d039
            ROTATE LEFT a, %S31: a = a + b
            d = d + (((a)) XOR ((b)) XOR ((c))) + (@bBuf[12]) +&He6db99e5
            ROTATE LEFT d, %S32: d = d + a
            c = c + (((d)) XOR ((a)) XOR ((b))) + (@bBuf[15]) +&H1fa27cf8
            ROTATE LEFT c, %S33: c = c + d
            b = b + (((c)) XOR ((d)) XOR ((a))) + (@bBuf[ 2]) +&Hc4ac5665
            ROTATE LEFT b, %S34: b = b + c
    
            ' ROUND 4
            a = a + (((c)) XOR (((b)) OR (NOT (d)))) + (@bBuf[ 0]) +&Hf4292244
            ROTATE LEFT a, %S41: a = a + b
            d = d + (((b)) XOR (((a)) OR (NOT (c)))) + (@bBuf[ 7]) +&H432aff97
            ROTATE LEFT d, %S42: d = d + a
            c = c + (((a)) XOR (((d)) OR (NOT (b)))) + (@bBuf[14]) +&Hab9423a7
            ROTATE LEFT c, %S43: c = c + d
            b = b + (((d)) XOR (((c)) OR (NOT (a)))) + (@bBuf[ 5]) +&Hfc93a039
            ROTATE LEFT b, %S44: b = b + c
            '
            a = a + (((c)) XOR (((b)) OR (NOT (d)))) + (@bBuf[12]) +&H655b59c3
            ROTATE LEFT a, %S41: a = a + b
            d = d + (((b)) XOR (((a)) OR (NOT (c)))) + (@bBuf[ 3]) +&H8f0ccc92
            ROTATE LEFT d, %S42: d = d + a
            c = c + (((a)) XOR (((d)) OR (NOT (b)))) + (@bBuf[10]) +&Hffeff47d
            ROTATE LEFT c, %S43: c = c + d
            b = b + (((d)) XOR (((c)) OR (NOT (a)))) + (@bBuf[ 1]) +&H85845dd1
            ROTATE LEFT b, %S44: b = b + c
            '
            a = a + (((c)) XOR (((b)) OR (NOT (d)))) + (@bBuf[ 8]) +&H6fa87e4f
            ROTATE LEFT a, %S41: a = a + b
            d = d + (((b)) XOR (((a)) OR (NOT (c)))) + (@bBuf[15]) +&Hfe2ce6e0
            ROTATE LEFT d, %S42: d = d + a
            c = c + (((a)) XOR (((d)) OR (NOT (b)))) + (@bBuf[ 6]) +&Ha3014314
            ROTATE LEFT c, %S43: c = c + d
            b = b + (((d)) XOR (((c)) OR (NOT (a)))) + (@bBuf[13]) +&H4e0811a1
            ROTATE LEFT b, %S44: b = b + c
            '
            a = a + (((c)) XOR (((b)) OR (NOT (d)))) + (@bBuf[ 4]) +&Hf7537e82
            ROTATE LEFT a, %S41: a = a + b
            d = d + (((b)) XOR (((a)) OR (NOT (c)))) + (@bBuf[11]) +&Hbd3af235
            ROTATE LEFT d, %S42: d = d + a
            c = c + (((a)) XOR (((d)) OR (NOT (b)))) + (@bBuf[ 2]) +&H2ad7d2bb
            ROTATE LEFT c, %S43: c = c + d
            b = b + (((d)) XOR (((c)) OR (NOT (a)))) + (@bBuf[ 9]) +&Heb86d391
            ROTATE LEFT b, %S44: b = b + c
    
            @tContext.lState(0) = @tContext.lState(0) + a
            @tContext.lState(1) = @tContext.lState(1) + b
            @tContext.lState(2) = @tContext.lState(2) + c
            @tContext.lState(3) = @tContext.lState(3) + d
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    ' Update context TO reflect the concatenation of another buffer full of bytes
    '-------------------------------------------------------------------------------------------
    SUB MD5_Update(pCtx AS DWORD, sBuf AS STRING, BYVAL dwLen AS DWORD)
    
            DIM t            AS LOCAL DWORD       '
            DIM p            AS LOCAL BYTE PTR    '
            DIM ctx          AS LOCAL MD5_CTX PTR '
            DIM bBuf         AS LOCAL STRING PTR * 300
            DIM dBuf         AS LOCAL STRING * 300
    
            dBuf = sBuf
            ctx  = pCtx
            bBuf = VARPTR32(dBuf)
    
            ' Update bitcount
            t = @ctx.lCount(0)
            @ctx.lCount(0) = t + MD5_ShiftLeft(dwLen, 3)
            IF @ctx.lCount(0) < t THEN
                INCR @ctx.lCount(1)                ' carry from low to high
            END IF
    
            @ctx.lCount(1) = @ctx.lCount(1) + MD5_ShiftRight(dwLen, 29)
    
            t = (MD5_ShiftRight(t, 3) AND &H3F)    ' Bytes already IN shsInfo -> DATA
    
            ' handle any leading odd-sized chunks
            IF ISTRUE(t) THEN
                p = VARPTR32(@ctx.bBuf)
                p = p + t
                t = 64 - t
                IF dwLen < t THEN
                    CALL MD5_MoveMemory(p, bBuf, dwLen)
                    EXIT SUB
                END IF
                CALL MD5_MoveMemory(p, bBuf, t)
                CALL MD5_Transform(ctx, VARPTR32(@ctx.bBuf))
                bBuf = bBuf + t
                dwLen = dwLen - t
            END IF
    
            ' Process DATA IN 64-BYTE chunks
            DO WHILE (dwLen => 64)
                CALL MD5_MoveMemory(VARPTR32(@ctx.bBuf), bBuf, 64)
                CALL MD5_Transform(ctx, VARPTR32(@ctx.bBuf) )
                bBuf = bBuf + 64
                dwLen = dwLen - 64
            LOOP
            'handle any remaining bytes of data
            CALL MD5_MoveMemory(VARPTR32(@ctx.bBuf), bBuf, dwLen)
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    ' Final wrapup - pad TO 64-BYTE boundary WITH the BIT pattern
    ' 1 0* (64-BIT count of bits processed, MSB-first)
    '-------------------------------------------------------------------------------------------
    SUB MD5_Final(dwDigest AS STRING * 16, pCtx AS DWORD)
    
            DIM lCount       AS LOCAL DWORD       '
            DIM p            AS LOCAL BYTE PTR    '
            DIM bBuffer      AS LOCAL BYTE PTR    '
            DIM ctx          AS LOCAL MD5_CTX PTR '
    
            ctx = pCtx
            bBuffer = VARPTR32(@ctx.bBuf)
    
            ' Compute number of bytes MOD 64
            lCount = (MD5_ShiftRight(@ctx.lCount(0), 3) AND &H3F)
    
            ' set the first char of padding to &H80.  This is safe since there is
            ' always AT least one BYTE free
            p = VARPTR32(@ctx.bBuf)
            p = p + lCount
            @p = &H80
            INCR p
    
            ' Bytes of padding needed TO make 64 bytes
            lCount = 64 - 1 - lCount
    
            ' Pad out TO 56 MOD 64
            IF lCount < 8 THEN
                ' two lots of padding: pad the first block to 64 bytes
                CALL MD5_FillMemory(p, lCount, 0)
                CALL MD5_Transform(ctx, VARPTR32(@ctx.bBuf))
                CALL MD5_FillMemory(VARPTR32(@ctx.bBuf), 56, 0)
            ELSE
                ' pad block to 56 bytes
                CALL MD5_FillMemory(p, (lCount - 8), 0)
            END IF
    
            ' append length IN bits and transform
            MID$(@ctx.bBuf, 57,4) = MKL$(@ctx.lCount(0))   ' Offset 1 bei Strings
            MID$(@ctx.bBuf, 61,4) = MKL$(@ctx.lCount(1))
            CALL MD5_Transform(ctx, VARPTR32(@ctx.bBuf))
            'CALL MD5_MoveMemory(dwDigest, VARPTR32(@ctx.lState(0)), 16)
            dwDigest = MKDWD$(@ctx.lState(0)) + MKDWD$(@ctx.lState(1)) + MKDWD$(@ctx.lState(2)) + MKDWD$(@ctx.lState(3))
    
            'CALL FillMemory(ctx, SIZEOF(@ctx), 0)
            @ctx.lState(1) = 0                ' alte Datenfelder l÷schen
            @ctx.lState(2) = 0                '
            @ctx.lState(3) = 0                '
            @ctx.lState(4) = 0                '
            @ctx.lCount(1) = 0                '
            @ctx.lCount(2) = 0                '
            @ctx.bBuf      = STRING$(64, 0)   ' Ersatz
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    ' Creates Native-String
    '-------------------------------------------------------------------------------------------
    FUNCTION MD5_String(BYVAL dwContext AS DWORD) AS STRING
    
            ' returns the MD5 digest as a hex string
            DIM pContext     AS LOCAL MD5_CTX PTR '
            DIM szDigest     AS LOCAL STRING * 16 '
    
            pContext = dwContext
    
            CALL MD5_Final(szDigest, pContext)
    
            FUNCTION = szDigest
    
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------
    ' Creates 32Byte Hex-String
    '-------------------------------------------------------------------------------------------
    FUNCTION MD5_Digest(BYVAL dwContext AS DWORD) AS STRING
    
            ' returns the MD5 digest as a hex string
            DIM sHex         AS LOCAL STRING      '
            DIM pContext     AS LOCAL MD5_CTX PTR '
            DIM szDigest     AS LOCAL STRING * 16 '
            DIM bDigest      AS LOCAL BYTE PTR    '
            DIM sCheck       AS LOCAL STRING      '
            DIM i            AS LOCAL LONG        '
            DIM Temp         AS LOCAL STRING      '
    
            bDigest = VARPTR32(szDigest)
            pContext = dwContext
    
            CALL MD5_Final(szDigest, pContext)
    
            IF bDigest <> %NULL THEN
                FOR i& = 0 TO 15
                    Temp$ =RIGHT$("000" + HEX$(@bDigest[i&]), 2)
                    sHex = sHex + Temp$
                NEXT i&
            END IF
            FUNCTION = LCASE$(sHex)
    
    END FUNCTION
    
    
    '-------------------------------------------------------------------------------------------
    ' Routines for MD5 (used for SASL/Digest-MD5, RFC 1321)
    '-------------------------------------------------------------------------------------------
    FUNCTION Get_String_MD5(BYVAL sText AS STRING) AS STRING
    
            DIM MD5_Ctx_Digest AS LOCAL MD5_CTX     '
    
            CALL MD5_Init(VARPTR32(MD5_Ctx_Digest))
            CALL MD5_Update(VARPTR32(MD5_Ctx_Digest), sText, LEN(sText) )
            FUNCTION = MD5_String(VARPTR32(MD5_Ctx_Digest))
    
    END FUNCTION
    
    
    '-------------------------------------------------------------------------------------------
    ' Routines for MD5 (used for Digest-MD5, RFC 1321)
    '-------------------------------------------------------------------------------------------
    FUNCTION Get_Digest_MD5(BYVAL sText AS STRING) AS STRING
    
            DIM MD5_Ctx_Digest AS LOCAL MD5_CTX     '
    
            CALL MD5_Init(VARPTR32(MD5_Ctx_Digest))
    
            CALL MD5_Update(VARPTR32(MD5_Ctx_Digest), sText, LEN(sText))
            FUNCTION = MD5_Digest(VARPTR32(MD5_Ctx_Digest))
    
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------
    ' Routines for HMAC-MD5 (used for CRAM-MD5, RFC 2104)
    '-------------------------------------------------------------------------------------------
    FUNCTION Get_CRAM_MD5(BYVAL sText AS STRING, BYVAL sKey AS STRING) AS STRING
    
            DIM sKeyLen      AS LOCAL INTEGER     '
            DIM MD5_Context  AS LOCAL MD5_CTX
            DIM Temp_Ctx     AS LOCAL MD5_CTX
            DIM ipad         AS LOCAL STRING      ' inner padding - key XORd WITH ipad
            DIM opad         AS LOCAL STRING      ' outer padding - key XORd WITH opad
            DIM p_ipad       AS LOCAL BYTE PTR    '
            DIM p_opad       AS LOCAL BYTE PTR
            DIM sDigest      AS LOCAL STRING      ' byte array with digest
            DIM szDigest     AS LOCAL STRING * 16
            DIM sTk          AS LOCAL STRING * 16 ' unsigned char tk[16]
            DIM i            AS LONG            '
    
            ipad    = STRING$(64, 0)              ' Strings m³ssen immer gef³llt sein!
            opad    = STRING$(64, 0)
            sDigest = STRING$(16, 0)
    
            '* IF key is longer than 64 bytes RESET it TO key=MD5(key)
            IF LEN(sKey) > 64 THEN
                CALL MD5_Init(VARPTR32(Temp_Ctx))
                CALL MD5_Update(VARPTR32(Temp_Ctx), sKey, LEN(sKey))
                CALL MD5_Final(sTk, VARPTR32(Temp_Ctx))
                sKey     = sTk
                sKeyLen  = 16
                ipad     = sTk + STRING$(64-LEN(sTk), 0)
                opad     = sTk + STRING$(64-LEN(sTk), 0)
            ELSE
                ipad     = sKey + STRING$(64-LEN(sKey), 0)
                opad     = sKey + STRING$(64-LEN(sKey), 0)
            END IF
    
            p_ipad = STRPTR32(ipad)
            p_opad = STRPTR32(opad)
    
            FOR i& = 0 TO 63
                 @p_ipad[i] = @p_ipad[i] XOR &h36
                 @p_opad[i] = @p_opad[i] XOR &h5c
            NEXT i%
    
            '*
            '* perform inner MD5
            '*
            CALL MD5_Init(VARPTR32(MD5_Context))                       '* init context FOR 1st
            CALL MD5_Update(VARPTR32(MD5_Context), ipad, 64)           '* start WITH inner pad
            CALL MD5_Update(VARPTR32(MD5_Context), sText, LEN(sText))  '* THEN text OF datagram
            CALL MD5_Final(szDigest, VARPTR32(MD5_Context))            '* finish UP 1st pass
            sDigest = szDigest
            '*
            '* perform outer MD5
            '*
            CALL MD5_Init(VARPTR32(MD5_Context))                       '* init context FOR 2nd
            CALL MD5_Update(VARPTR32(MD5_Context), opad, 64)           '* start WITH outer pad
            CALL MD5_Update(VARPTR32(MD5_Context), sDigest, 16)        '* THEN results OF 1st
    
            FUNCTION = MD5_Digest(VARPTR32(MD5_Context))
    
    END FUNCTION
    Regards,

    --------------
    / h o m a s
    ------------------
    email : support@gohel.de / mailto:gohel@basicguru.comgohel@basicguru.com</A> (PGP-Key available)
    www : www.gohel.de / http://pbsound.basicguru.com (PowerBASIC)
    fax/bbs: +49-30-47300910 (VFC, V34+, X75, ISDN, CCB, 9600-128000bps)
    ## CrossPoint [XP2] v3.31.003 Beta DOS/16 R/C2478, via PBNEWS v0.14g
    http://www.gohel.de - http://www.gohel.net - http://www.pbhq.com
Working...
X