Vfp Md 5 Hash Function

(Updated: 2009.03.06 04:51:19 AM)

Edit -Find- Recent Changes Categories Road Map [A-F] [G-P] [Q-Z] New Topic Home

There are several ways to accomplish an MD5 hash in VFP:

Use the Win32 Hash Cryptographic provider (Requires WinNT4, Win95OSR2+ or Win95 & IE3.02+)
Use the Fox Crypto FLL library
Craig SBoyd FREE library (encryption, hash) vfpencryption.fll
Code it all in VFP - buggy
http://www.crypto-central.com/html/main.html#hashx -- an ActiveX component
Code it all in VFP - buggy too

Is there a native VFP function for creating a hash of a file directly? For example, instead of hashMD5( tcData ) we would have hashFileMD5( tcFilepath ). This avoids breaking the 16MB maximum string length limitation in VFP with large files. -- John Clarke
No. VFP does not have a native Hash(). What it does have is a simple Checksum (16 & 32 bit). See Sys(2007) - Sys(2017) in help. -- Alex Feldstein
Alex, thanks for the suggestion. Clarification: I actually meant is there a function that exists in a VFP library (such as Craig's vfpencryption.fll) that would do this? Also, I *think* that the sys() calls you suggest are limited to a 16MB string hence the need to go to the file directly and avoid reading in an entire string. I want to get checksum values for files >100MB without having to register a dll or other non-VFP library. Craig's vfpencryption.fll is excellent and would do the trick except there is no hashFILE() function, just the hash(lcString) function which leaves me having to read in a string and break the 16MB string size limit. -- John Clarke

Johh, Craig's FLL already includes a HashFile function:
Function HASHFILE()

Signature: HashFile(cFileName[, nHashType])

Parameters:

cFileName - The fullpath and name of an existing file you wish to generate a message digest for

nHashType - The type of hash function to generate. There are currently 7 different hash functions supported

1 = SHA1 (a.k.a SHA160)
2 = SHA256
3 = SHA384
4 = SHA512 *Default
5 = MD5
6 = RIPEMD128
7 = RIPEMD256

Garry Bettle

Garry, thanks for the tip. For some reason, I didn't see the documentation for hashFile. Here's the link: update. This is exactly what I was looking for. However, I get intermittent but persistent "API call caused an exception" errors when attempting to hash three different files. I will take this issue to Craig's blog. -- John Clarke

The issue John Clarke describes above has since been fixed in both vfpencryption.fll and vfpencryption71.fll. Please contact me with any issues encountered in either library and they will be addressed in a timely fashion. -- Craig SBoyd

Use the Win32 Cryptographic API

Here is a another way to do it:

#include "c:\program files\microsoft [[Visual FoxPro]] 8\ffc\wincrypt.h"

* This routine takes a string as input
* and returns an MD5 hash value as a string.
*
* The calculation in implemented using the MS Crypto API and the RSA provider.


FUNCTION HashMD5(tcData)

  LOCAL lnStatus, lnErr, lhProv, lhHashObject, lnDataSize, lcHashValue, lnHashSize
  lhProv = 0
  lhHashObject = 0
  lnDataSize = LEN(tcData)
  lcHashValue = REPLICATE(CHR(0), 16)
  lnHashSize = LEN(lcHashValue)


  TRY

    DECLARE INTEGER GetLastError ;
      IN win32api AS GetLastError

    DECLARE INTEGER CryptAcquireContextA ;
      IN WIN32API AS CryptAcquireContext ;
      INTEGER @lhProvHandle, ;
      STRING  cContainer, ;
      STRING  cProvider, ;
      INTEGER nProvType, ;
      INTEGER nFlags

    * load a crypto provider
    lnStatus = CryptAcquireContext(@lhProv, 0, 0, dnPROV_RSA_FULL, dnCRYPT_VERIFYCONTEXT)
    IF lnStatus = 0
      THROW GetLastError()
    ENDIF

    DECLARE INTEGER CryptCreateHash ;
      IN WIN32API AS CryptCreateHash ;
      INTEGER hProviderHandle, ;
      INTEGER nALG_ID, ;
      INTEGER hKeyhandle, ;
      INTEGER nFlags, ;
      INTEGER @hCryptHashHandle

    * create a hash object that uses MD5 algorithm
    lnStatus = CryptCreateHash(lhProv, dnCALG_MD5, 0, 0, @lhHashObject)
    IF lnStatus = 0
      THROW GetLastError()
    ENDIF


    DECLARE INTEGER CryptHashData ;
      IN WIN32API AS CryptHashData ;
      INTEGER hHashHandle, ;
      STRING  @cData, ;
      INTEGER nDataLen, ;
      INTEGER nFlags

    * add the input data to the hash object
    lnStatus = CryptHashData(lhHashObject, tcData, lnDataSize, 0)
    IF lnStatus = 0
      THROW GetLastError()
    ENDIF


    DECLARE INTEGER CryptGetHashParam ;
      IN WIN32API AS CryptGetHashParam ;
      INTEGER hHashHandle, ;
      INTEGER nParam, ;
      STRING  @cHashValue, ;
      INTEGER @nHashSize, ;
      INTEGER nFlags

    * retrieve the hash value, if caller did not provide enough storage (16 bytes for MD5)
    * this will fail with dnERROR_MORE_DATA and lnHashSize will contain needed storage size
    lnStatus = CryptGetHashParam(lhHashObject, dnHP_HASHVAL, @lcHashValue, @lnHashSize, 0)
    IF lnStatus = 0
      THROW GetLastError()
    ENDIF


    DECLARE INTEGER CryptDestroyHash ;
      IN WIN32API AS CryptDestroyHash;
      INTEGER hKeyHandle

    * free the hash object
    lnStatus = CryptDestroyHash(lhHashObject)
    IF lnStatus = 0
      THROW GetLastError()
    ENDIF


    DECLARE INTEGER CryptReleaseContext ;
      IN WIN32API AS CryptReleaseContext ;
      INTEGER hProvHandle, ;
      INTEGER nReserved

    * release the crypto provider
    lnStatus = CryptReleaseContext(lhProv, 0)
    IF lnStatus = 0
      THROW GetLastError()
    ENDIF

  CATCH TO lnErr

    * clean up the hash object and release provider
    IF lhHashObject != 0
      CryptDestroyHash(lhHashObject)
    ENDIF


    IF lhProv != 0
      CryptReleaseContext(lhProv, 0)
    ENDIF

    ERROR("HashMD5 Failed")

  ENDTRY

  RETURN lcHashValue

ENDFUNC

- Albert Ballinger

All in VFP This is an attempt to convert a Java Script MD5 Hash function into VFP.
It compiles and runs and returns a result, but the result doesn't agree with another hash function on my computer, so I expect there are errors somewhere, so:

WARNING: This has Bugs!

If you care to, please compare it to MD5 hashes and show the results of your comparisons here, and maybe even try to fix the code! ;)
I think the source of the problem is that the Java Script > > operator propigates the sign bit, and the > > > operator does not, while VFP only gives us the BITRSHIFT() function, which I think does not propigate the sign.

The original Java Script code follows each VFP function, each line commented out with *!*

 * A VFP implementation of the RSA Data Security, Inc. MD5 Message Digest Algorithm, as defined in RFC 1321.
 * Converted by William GC Steinford from the JavaScript implementation:
 *   Copyright (C) Paul Johnston 1999 - 2000.
 *   Updated by Greg Holt 2000 - 2001.
 *   See http://pajhome.org.uk/site/legal.html for details.
 *

* Convert a 32-bit number to a hex string with ls-byte first
#DEFINE hex_chr "0123456789abcdef"
FUNCTION rhex(num)
*  This returns the string with ms-byte first... we could flip it around, or just use the one that works. What is faster?
*  RETURN PADL( SubStr(LOWER(TRANSFORM( num, '@0' )), 3), 8, '0' )
LOCAL lcStr, lnI
lcStr = ''
FOR lnI = 0 to 3
  lcStr = lcStr + SUBSTR(hex_chr,  BitAnd( BitRShift(num, lnI*8 + 4), 0x0F )+1, 1 ) ;
                + SUBSTR(hex_chr,  BitAnd( BitRShift(num, lnI*8    ), 0x0F )+1, 1 )
ENDFOR
RETURN lcStr
*!*   str = "";
*!*   for(j = 0; j <= 3; j++)
*!*     str += hex_chr.charAt((num >> (j * 8 + 4)) & 0x0F) +
*!*            hex_chr.charAt((num >> (j * 8)) & 0x0F);
*!*   return str;
*!* }
ENDFUNC

 * Convert a string to a sequence of 16-word blocks, stored as an array.
 * Append padding bits and the length, as described in the MD5 standard.
function str2blks_MD5(str, blks)
LOCAL nblk, lnI, idx
  nblk = BitRShift(len(str)+8,6) + 1
  DIMENSION blks[nblk * 16] && 1 based, not 0 Based!
  blks = 0                  && Clear array
  for lnI = 0 to len(str)-1
    * Correct for one based array
    idx = BitRShift(lnI,2)+1
    blks[idx] = BitOr(blks[idx], BitLShift(Asc(substr(str,lnI+1)), (lnI % 4) * 8 ) )
  endfor
  lnI = len(str)
  idx = BitRShift(lnI,2) + 1
  blks[idx] = BitOr( blks[idx], BitLShift(0x80,(lnI % 4) * 8) )
  blks[nblk * 16 - 2] = len(str) * 8
  return aLen(blks,2)

*!* {
*!*   nblk = ((str.length + 8) >> 6) + 1;
*!*   blks = new Array(nblk * 16);
*!*   for(i = 0; i < nblk * 16; i++) blks[i] = 0;
*!*   for(i = 0; i < str.length; i++)
*!*     blks[i >> 2] |= str.charCodeAt(i) << ((i % 4) * 8);
*!*   blks[i >> 2] |= 0x80 << ((i % 4) * 8);
*!*   blks[nblk * 16 - 2] = str.length * 8;
*!*   return blks;
*!* }
ENDFUNC

 * Add integers, wrapping at 2^32. This uses 16-bit operations internally
 * to work around bugs in some JS interpreters.
function add(x, y)
LOCAL lsw, msw
  lsw = BitAnd(x,0xFFFF) + BitAnd(y,0xFFFF)
  msw = BitRShift(x,16) + BitRSHift(y,16) + BitRShift(lsw,16)
  return BitOr( BitLShift(msw,16), BitAnd(lsw,0xFFFF) )
*!* {
*!*   var lsw = (x & 0xFFFF) + (y & 0xFFFF);
*!*   var msw = (x >> 16) + (y >> 16) + (lsw >> 16);
*!*   return (msw << 16) | (lsw & 0xFFFF);
*!* }
ENDFUNC

 * Bitwise rotate a 32-bit number to the left
function rol(num, cnt)
  return BitOr(  BitLShift(num,cnt), BitRShift(num,32-cnt) )
*!* {
*!*   return (num << cnt) | (num >>> (32 - cnt));
*!* }
ENDFUNC

 * These functions implement the basic operation for each round of the
 * algorithm.
function cmn(q, a, b, x, s, t)
  return add(rol(add(add(a, q), add(x, t)), s), b)
*!* {
*!*  return add(rol(add(add(a, q), add(x, t)), s), b);
*!* }
ENDFUNC
function ff(a, b, c, d, x, s, t)
  return cmn( BitOr(bitand(b,c), BitAnd(bitNot(b),d)), a, b, x, s, t)
*!* {
*!*   return cmn((b & c) | ((~b) & d), a, b, x, s, t);
*!* }
ENDFUNC
function gg(a, b, c, d, x, s, t)
  return cmn( bitor(bitand(b, d), Bitand(c, bitnot(d))), a, b, x, s, t)
*!* {
*!*   return cmn((b & d) | (c & (~d)), a, b, x, s, t);
*!* }
ENDFUNC
function hh(a, b, c, d, x, s, t)
  return cmn(b ^ (c ^ d), a, b, x, s, t)
*!* {
*!*   return cmn(b ^ c ^ d, a, b, x, s, t);
*!* }
ENDFUNC
function ii(a, b, c, d, x, s, t)
  return cmn(c ^ bitor(b, bitnot(d)), a, b, x, s, t)
*!* {
*!*   return cmn(c ^ (b | (~d)), a, b, x, s, t);
*!* }
ENDFUNC

 * Take a string and return the hex representation of its MD5.
function MD5(str)
LOCAL a,b,c,d,x[1]len_x,i, olda,oldb,oldc,oldd
  len_x = str2blks_MD5(str,@x)
  a =  1732584193
  b = -271733879
  c = -1732584194
  d =  271733878

  i = 0
  do while i<=len_x && correct for 0 based array
    i = i + 1  && correct for 0 based array
    olda = a
    oldb = b
    oldc = c
    oldd = d

    a = ff(a, b, c, d, x[i+ 0], 7 , -680876936)
    d = ff(d, a, b, c, x[i+ 1], 12, -389564586)
    c = ff(c, d, a, b, x[i+ 2], 17,  606105819)
    b = ff(b, c, d, a, x[i+ 3], 22, -1044525330)
    a = ff(a, b, c, d, x[i+ 4], 7 , -176418897)
    d = ff(d, a, b, c, x[i+ 5], 12,  1200080426)
    c = ff(c, d, a, b, x[i+ 6], 17, -1473231341)
    b = ff(b, c, d, a, x[i+ 7], 22, -45705983)
    a = ff(a, b, c, d, x[i+ 8], 7 ,  1770035416)
    d = ff(d, a, b, c, x[i+ 9], 12, -1958414417)
    c = ff(c, d, a, b, x[i+10], 17, -42063)
    b = ff(b, c, d, a, x[i+11], 22, -1990404162)
    a = ff(a, b, c, d, x[i+12], 7 ,  1804603682)
    d = ff(d, a, b, c, x[i+13], 12, -40341101)
    c = ff(c, d, a, b, x[i+14], 17, -1502002290)
    b = ff(b, c, d, a, x[i+15], 22,  1236535329)

    a = gg(a, b, c, d, x[i+ 1], 5 , -165796510)
    d = gg(d, a, b, c, x[i+ 6], 9 , -1069501632)
    c = gg(c, d, a, b, x[i+11], 14,  643717713)
    b = gg(b, c, d, a, x[i+ 0], 20, -373897302)
    a = gg(a, b, c, d, x[i+ 5], 5 , -701558691)
    d = gg(d, a, b, c, x[i+10], 9 ,  38016083)
    c = gg(c, d, a, b, x[i+15], 14, -660478335)
    b = gg(b, c, d, a, x[i+ 4], 20, -405537848)
    a = gg(a, b, c, d, x[i+ 9], 5 ,  568446438)
    d = gg(d, a, b, c, x[i+14], 9 , -1019803690)
    c = gg(c, d, a, b, x[i+ 3], 14, -187363961)
    b = gg(b, c, d, a, x[i+ 8], 20,  1163531501)
    a = gg(a, b, c, d, x[i+13], 5 , -1444681467)
    d = gg(d, a, b, c, x[i+ 2], 9 , -51403784)
    c = gg(c, d, a, b, x[i+ 7], 14,  1735328473)
    b = gg(b, c, d, a, x[i+12], 20, -1926607734)

    a = hh(a, b, c, d, x[i+ 5], 4 , -378558)
    d = hh(d, a, b, c, x[i+ 8], 11, -2022574463)
    c = hh(c, d, a, b, x[i+11], 16,  1839030562)
    b = hh(b, c, d, a, x[i+14], 23, -35309556)
    a = hh(a, b, c, d, x[i+ 1], 4 , -1530992060)
    d = hh(d, a, b, c, x[i+ 4], 11,  1272893353)
    c = hh(c, d, a, b, x[i+ 7], 16, -155497632)
    b = hh(b, c, d, a, x[i+10], 23, -1094730640)
    a = hh(a, b, c, d, x[i+13], 4 ,  681279174)
    d = hh(d, a, b, c, x[i+ 0], 11, -358537222)
    c = hh(c, d, a, b, x[i+ 3], 16, -722521979)
    b = hh(b, c, d, a, x[i+ 6], 23,  76029189)
    a = hh(a, b, c, d, x[i+ 9], 4 , -640364487)
    d = hh(d, a, b, c, x[i+12], 11, -421815835)
    c = hh(c, d, a, b, x[i+15], 16,  530742520)
    b = hh(b, c, d, a, x[i+ 2], 23, -995338651)

    a = ii(a, b, c, d, x[i+ 0], 6 , -198630844)
    d = ii(d, a, b, c, x[i+ 7], 10,  1126891415)
    c = ii(c, d, a, b, x[i+14], 15, -1416354905)
    b = ii(b, c, d, a, x[i+ 5], 21, -57434055)
    a = ii(a, b, c, d, x[i+12], 6 ,  1700485571)
    d = ii(d, a, b, c, x[i+ 3], 10, -1894986606)
    c = ii(c, d, a, b, x[i+10], 15, -1051523)
    b = ii(b, c, d, a, x[i+ 1], 21, -2054922799)
    a = ii(a, b, c, d, x[i+ 8], 6 ,  1873313359)
    d = ii(d, a, b, c, x[i+15], 10, -30611744)
    c = ii(c, d, a, b, x[i+ 6], 15, -1560198380)
    b = ii(b, c, d, a, x[i+13], 21,  1309151649)
    a = ii(a, b, c, d, x[i+ 4], 6 , -145523070)
    d = ii(d, a, b, c, x[i+11], 10, -1120210379)
    c = ii(c, d, a, b, x[i+ 2], 15,  718787259)
    b = ii(b, c, d, a, x[i+ 9], 21, -343485551)

    a = add(a, olda)
    b = add(b, oldb)
    c = add(c, oldc)
    d = add(d, oldd)

    i = i + 15
  ENDDO
  return rhex(a) + rhex(b) + rhex(c) + rhex(d)

*!* {
*!*   x = str2blks_MD5(str);
*!*   var a =  1732584193;
*!*   var b = -271733879;
*!*   var c = -1732584194;
*!*   var d =  271733878;
*!*
*!*   for(i = 0; i < x.length; i += 16)
*!*   {
*!*     var olda = a;
*!*     var oldb = b;
*!*     var oldc = c;
*!*     var oldd = d;

*!*     a = ff(a, b, c, d, x[i+ 0], 7 , -680876936);
*!*     d = ff(d, a, b, c, x[i+ 1], 12, -389564586);
*!*     c = ff(c, d, a, b, x[i+ 2], 17,  606105819);
*!*     b = ff(b, c, d, a, x[i+ 3], 22, -1044525330);
*!*     a = ff(a, b, c, d, x[i+ 4], 7 , -176418897);
*!*     d = ff(d, a, b, c, x[i+ 5], 12,  1200080426);
*!*     c = ff(c, d, a, b, x[i+ 6], 17, -1473231341);
*!*     b = ff(b, c, d, a, x[i+ 7], 22, -45705983);
*!*     a = ff(a, b, c, d, x[i+ 8], 7 ,  1770035416);
*!*     d = ff(d, a, b, c, x[i+ 9], 12, -1958414417);
*!*     c = ff(c, d, a, b, x[i+10], 17, -42063);
*!*     b = ff(b, c, d, a, x[i+11], 22, -1990404162);
*!*     a = ff(a, b, c, d, x[i+12], 7 ,  1804603682);
*!*     d = ff(d, a, b, c, x[i+13], 12, -40341101);
*!*     c = ff(c, d, a, b, x[i+14], 17, -1502002290);
*!*     b = ff(b, c, d, a, x[i+15], 22,  1236535329);

*!*     a = gg(a, b, c, d, x[i+ 1], 5 , -165796510);
*!*     d = gg(d, a, b, c, x[i+ 6], 9 , -1069501632);
*!*     c = gg(c, d, a, b, x[i+11], 14,  643717713);
*!*     b = gg(b, c, d, a, x[i+ 0], 20, -373897302);
*!*     a = gg(a, b, c, d, x[i+ 5], 5 , -701558691);
*!*     d = gg(d, a, b, c, x[i+10], 9 ,  38016083);
*!*     c = gg(c, d, a, b, x[i+15], 14, -660478335);
*!*     b = gg(b, c, d, a, x[i+ 4], 20, -405537848);
*!*     a = gg(a, b, c, d, x[i+ 9], 5 ,  568446438);
*!*     d = gg(d, a, b, c, x[i+14], 9 , -1019803690);
*!*     c = gg(c, d, a, b, x[i+ 3], 14, -187363961);
*!*     b = gg(b, c, d, a, x[i+ 8], 20,  1163531501);
*!*     a = gg(a, b, c, d, x[i+13], 5 , -1444681467);
*!*     d = gg(d, a, b, c, x[i+ 2], 9 , -51403784);
*!*     c = gg(c, d, a, b, x[i+ 7], 14,  1735328473);
*!*     b = gg(b, c, d, a, x[i+12], 20, -1926607734);
*!*

*!*     a = hh(a, b, c, d, x[i+ 5], 4 , -378558);
*!*     d = hh(d, a, b, c, x[i+ 8], 11, -2022574463);
*!*     c = hh(c, d, a, b, x[i+11], 16,  1839030562);
*!*     b = hh(b, c, d, a, x[i+14], 23, -35309556);
*!*     a = hh(a, b, c, d, x[i+ 1], 4 , -1530992060);
*!*     d = hh(d, a, b, c, x[i+ 4], 11,  1272893353);
*!*     c = hh(c, d, a, b, x[i+ 7], 16, -155497632);
*!*     b = hh(b, c, d, a, x[i+10], 23, -1094730640);
*!*     a = hh(a, b, c, d, x[i+13], 4 ,  681279174);
*!*     d = hh(d, a, b, c, x[i+ 0], 11, -358537222);
*!*     c = hh(c, d, a, b, x[i+ 3], 16, -722521979);
*!*     b = hh(b, c, d, a, x[i+ 6], 23,  76029189);
*!*     a = hh(a, b, c, d, x[i+ 9], 4 , -640364487);
*!*     d = hh(d, a, b, c, x[i+12], 11, -421815835);
*!*     c = hh(c, d, a, b, x[i+15], 16,  530742520);
*!*     b = hh(b, c, d, a, x[i+ 2], 23, -995338651);

*!*     a = ii(a, b, c, d, x[i+ 0], 6 , -198630844);
*!*     d = ii(d, a, b, c, x[i+ 7], 10,  1126891415);
*!*     c = ii(c, d, a, b, x[i+14], 15, -1416354905);
*!*     b = ii(b, c, d, a, x[i+ 5], 21, -57434055);
*!*     a = ii(a, b, c, d, x[i+12], 6 ,  1700485571);
*!*     d = ii(d, a, b, c, x[i+ 3], 10, -1894986606);
*!*     c = ii(c, d, a, b, x[i+10], 15, -1051523);
*!*     b = ii(b, c, d, a, x[i+ 1], 21, -2054922799);
*!*     a = ii(a, b, c, d, x[i+ 8], 6 ,  1873313359);
*!*     d = ii(d, a, b, c, x[i+15], 10, -30611744);
*!*     c = ii(c, d, a, b, x[i+ 6], 15, -1560198380);
*!*     b = ii(b, c, d, a, x[i+13], 21,  1309151649);
*!*     a = ii(a, b, c, d, x[i+ 4], 6 , -145523070);
*!*     d = ii(d, a, b, c, x[i+11], 10, -1120210379);
*!*     c = ii(c, d, a, b, x[i+ 2], 15,  718787259);
*!*     b = ii(b, c, d, a, x[i+ 9], 21, -343485551);

*!*     a = add(a, olda);
*!*     b = add(b, oldb);
*!*     c = add(c, oldc);
*!*     d = add(d, oldd);
*!*   }
*!*   return rhex(a) + rhex(b) + rhex(c) + rhex(d);
*!* }

ENDFUNC

All in VFP

MD5 CLASS - good for production use, no bugs.



DEFINE CLASS MD5 AS Custom OLEPUBLIC
**********************************************************************************************************************
* Written in VFP by GILLES Patrick (C) IKOONET SARL www.ikoonet.com
* Une impl�mention en Visual Foxpro de l'algorithme MD5 message digest tel que definis dans le RFC 1321 par R. RIVEST
* de la soci�t?RSA DATA SECURTY & MIT Laboratory for Computer Science
* A VFP implementation of the RSA Data Security, Inc. MD5 Message Digest Algorithm, as defined in RFC 1321.
**********************************************************************************************************************
* Usage (sample)
* SET PROCEDURE TO mdigest5
* MD5=CREATEOBJECT("MD5")
* MD5.tohash="abc"
* ? MD5.compute()
*******************************
tohash=""
DIMENSION SinusArray(64)
#DEFINE MAX_UINT 4294967296
#DEFINE NUMBEROFBIT 8 && UNICODE 16 (unicode not tested)


PROCEDURE init
  LOCAL I
  FOR I = 1 TO 64
    this.SinusArray(I)=TRANSFORM(MAX_UINT*ABS(SIN(I)),"@0")
    this.SinusArray(I)=BITAND(EVALUATE(this.SinusArray(I)),0xFFFFFFFF) &&CAST
  ENDFOR
RETURN .T.

PROCEDURE bourre
  LOCAL NBR_BIT_BOURRE, BOURRAGE
  Bourrage = CHR(128)+REPLICATE(CHR(0),63)
  NBR_BIT_BOURRE=(448-(LEN(THIS.TOHASH)*NUMBEROFBIT)%512)/NUMBEROFBIT
  IF (LEN(THIS.TOHASH)*NUMBEROFBIT)%512>=448
    NBR_BIT_BOURRE=(448+((512-LEN(THIS.TOHASH)*NUMBEROFBIT)%512))/NUMBEROFBIT
  ENDIF

RETURN LEFT(bourrage,NBR_BIT_BOURRE)


PROCEDURE acompleter
  LOCAL retour,decalage
  decalage=TRANSFORM(LEN(this.tohash)* NUMBEROFBIT,"@0")
  retour=""
  retour=retour+CHR(EVALUATE("0x"+SUBSTR(decalage,9,2)))
  retour=retour+CHR(EVALUATE("0x"+SUBSTR(decalage,7,2)))
  retour=retour+CHR(EVALUATE("0x"+SUBSTR(decalage,5,2)))
  retour=retour+CHR(EVALUATE("0x"+SUBSTR(decalage,3,2)))
  retour=retour+REPLICATE(CHR(0),4)
RETURN RETOUR


PROCEDURE MD5_F
LPARAMETERS x,y,z
RETURN BITOR(BITAND(X,Y),BITAND(BITNOT(X),Z))

PROCEDURE MD5_G
LPARAMETERS x,y,z
RETURN BITOR(BITAND(X,Z),BITAND(Y,BITNOT(Z)))

PROCEDURE MD5_H
LPARAMETERS x,y,z
RETURN BITXOR(X,Y,Z)

PROCEDURE MD5_I
LPARAMETERS x,y,z
RETURN BITXOR(Y,BITOR(X,BITNOT(Z)))

PROCEDURE ROTATE_LEFT
LPARAMETERS pivot, npivot
RETURN BITOR(BITLSHIFT(pivot,npivot),BITRSHIFT(pivot,32-Npivot))

procedure ronde1
LPARAMETERS PA,PB,PC,PD,PE,PF,PG
RETURN PB+this.ROTATE_LEFT(PA+this.MD5_F(PB,PC,PD)+PE+PG,PF)

procedure ronde2
LPARAMETERS PA,PB,PC,PD,PE,PF,PG
RETURN PB+this.ROTATE_LEFT(PA+this.MD5_G(PB,PC,PD)+PE+PG,PF)

PROCEDURE ronde3
LPARAMETERS PA,PB,PC,PD,PE,PF,PG
RETURN PB+this.ROTATE_LEFT(PA+this.MD5_H(PB,PC,PD)+PE+PG,PF)

PROCEDURE ronde4
LPARAMETERS PA,PB,PC,PD,PE,PF,PG
RETURN PB+this.ROTATE_LEFT(PA+this.MD5_I(PB,PC,PD)+PE+PG,PF)

PROCEDURE compute
  LOCAL tocompute,CPT_I,CPT_J,CPT_L,TMP_STRING,AA,BB,CC,DD,a,b,c,d,aa,bb,cc,dd
  A=BITAND(0x67452301,0xFFFFFFFF)
  B=BITAND(0xEFCDAB89,0xFFFFFFFF)
  C=BITAND(0x98BADCFE,0xFFFFFFFF)
  D=BITAND(0x10325476,0xFFFFFFFF)

  DIMENSION T_X(16)
  tocompute=this.tohash+this.bourre()+this.acompleter()
  lentocompute=LEN(tocompute)/64
  OldA=A
  OldB=B
  OldC=C
  OldD=D
  FOR CPT_I=0 TO lentocompute-1
    FOR CPT_J=0 TO 15
      T_X(CPT_J+1)=""
      T_X(CPT_J+1)=T_X(CPT_J+1)+RIGHT(TRANSFORM(ASC(SUBSTR(tocompute,(CPT_I*64)+(CPT_J*4)+4,1)),"@0"),2)
      T_X(CPT_J+1)=T_X(CPT_J+1)+RIGHT(TRANSFORM(ASC(SUBSTR(tocompute,(CPT_I*64)+(CPT_J*4)+3,1)),"@0"),2)
      T_X(CPT_J+1)=T_X(CPT_J+1)+RIGHT(TRANSFORM(ASC(SUBSTR(tocompute,(CPT_I*64)+(CPT_J*4)+2,1)),"@0"),2)
      T_X(CPT_J+1)=T_X(CPT_J+1)+RIGHT(TRANSFORM(ASC(SUBSTR(tocompute,(CPT_I*64)+(CPT_J*4)+1,1)),"@0"),2)

      T_X(CPT_J+1)=BITAND(EVALUATE("0x"+T_X(CPT_J+1)),0xFFFFFFFF) && CAST
      *? TRANSFORM(T_X(CPT_J+1),"@0")
      *?
    ENDFOR

    OldA=A
    OldB=B
    OldC=C
    OldD=D

    && Ronde1
    a=this.ronde1(a,b,c,d,T_X( 1), 7,this.sinusarray( 1))
    d=this.ronde1(d,a,b,c,T_X( 2),12,this.sinusarray( 2))
    c=this.ronde1(c,d,a,b,T_X( 3),17,this.sinusarray( 3))
    b=this.ronde1(b,c,d,a,T_X( 4),22,this.sinusarray( 4))

    a=this.ronde1(a,b,c,d,T_X( 5), 7,this.sinusarray( 5))
    d=this.ronde1(d,a,b,c,T_X( 6),12,this.sinusarray( 6))
    c=this.ronde1(c,d,a,b,T_X( 7),17,this.sinusarray( 7))
    b=this.ronde1(b,c,d,a,T_X( 8),22,this.sinusarray( 8))

    a=this.ronde1(a,b,c,d,T_X( 9), 7,this.sinusarray( 9))
    d=this.ronde1(d,a,b,c,T_X(10),12,this.sinusarray(10))
    c=this.ronde1(c,d,a,b,T_X(11),17,this.sinusarray(11))
    b=this.ronde1(b,c,d,a,T_X(12),22,this.sinusarray(12))

    a=this.ronde1(a,b,c,d,T_X(13), 7,this.sinusarray(13))
    d=this.ronde1(d,a,b,c,T_X(14),12,this.sinusarray(14))
    c=this.ronde1(c,d,a,b,T_X(15),17,this.sinusarray(15))
    b=this.ronde1(b,c,d,a,T_X(16),22,this.sinusarray(16))
    && ronde 2
    a=this.ronde2(a,b,c,d,T_X( 2), 5,this.sinusarray(17))
    d=this.ronde2(d,a,b,c,T_X( 7), 9,this.sinusarray(18))
    c=this.ronde2(c,d,a,b,T_X(12),14,this.sinusarray(19))
    b=this.ronde2(b,c,d,a,T_X( 1),20,this.sinusarray(20))

    a=this.ronde2(a,b,c,d,T_X( 6), 5,this.sinusarray(21))
    d=this.ronde2(d,a,b,c,T_X(11), 9,this.sinusarray(22))
    c=this.ronde2(c,d,a,b,T_X(16),14,this.sinusarray(23))
    b=this.ronde2(b,c,d,a,T_X( 5),20,this.sinusarray(24))

    a=this.ronde2(a,b,c,d,T_X(10), 5,this.sinusarray(25))
    d=this.ronde2(d,a,b,c,T_X(15), 9,this.sinusarray(26))
    c=this.ronde2(c,d,a,b,T_X( 4),14,this.sinusarray(27))
    b=this.ronde2(b,c,d,a,T_X( 9),20,this.sinusarray(28))

    a=this.ronde2(a,b,c,d,T_X(14), 5,this.sinusarray(29))
    d=this.ronde2(d,a,b,c,T_X( 3), 9,this.sinusarray(30))
    c=this.ronde2(c,d,a,b,T_X( 8),14,this.sinusarray(31))
    b=this.ronde2(b,c,d,a,T_X(13),20,this.sinusarray(32))

    && ronde 3
    a=this.ronde3(a,b,c,d,T_X( 6), 4,this.sinusarray(33))
    d=this.ronde3(d,a,b,c,T_X( 9),11,this.sinusarray(34))
    c=this.ronde3(c,d,a,b,T_X(12),16,this.sinusarray(35))
    b=this.ronde3(b,c,d,a,T_X(15),23,this.sinusarray(36))

    a=this.ronde3(a,b,c,d,T_X( 2), 4,this.sinusarray(37))
    d=this.ronde3(d,a,b,c,T_X( 5),11,this.sinusarray(38))
    c=this.ronde3(c,d,a,b,T_X( 8),16,this.sinusarray(39))
    b=this.ronde3(b,c,d,a,T_X(11),23,this.sinusarray(40))

    a=this.ronde3(a,b,c,d,T_X(14), 4,this.sinusarray(41))
    d=this.ronde3(d,a,b,c,T_X( 1),11,this.sinusarray(42))
    c=this.ronde3(c,d,a,b,T_X( 4),16,this.sinusarray(43))
    b=this.ronde3(b,c,d,a,T_X( 7),23,this.sinusarray(44))

    a=this.ronde3(a,b,c,d,T_X(10), 4,this.sinusarray(45))
    d=this.ronde3(d,a,b,c,T_X(13),11,this.sinusarray(46))
    c=this.ronde3(c,d,a,b,T_X(16),16,this.sinusarray(47))
    b=this.ronde3(b,c,d,a,T_X( 3),23,this.sinusarray(48))

    && ronde 4
    a=this.ronde4(a,b,c,d,T_X( 1), 6,this.sinusarray(49))
    d=this.ronde4(d,a,b,c,T_X( 8),10,this.sinusarray(50))
    c=this.ronde4(c,d,a,b,T_X(15),15,this.sinusarray(51))
    b=this.ronde4(b,c,d,a,T_X( 6),21,this.sinusarray(52))

    a=this.ronde4(a,b,c,d,T_X(13), 6,this.sinusarray(53))
    d=this.ronde4(d,a,b,c,T_X( 4),10,this.sinusarray(54))
    c=this.ronde4(c,d,a,b,T_X(11),15,this.sinusarray(55))
    b=this.ronde4(b,c,d,a,T_X( 2),21,this.sinusarray(56))

    a=this.ronde4(a,b,c,d,T_X( 9), 6,this.sinusarray(57))
    d=this.ronde4(d,a,b,c,T_X(16),10,this.sinusarray(58))
    c=this.ronde4(c,d,a,b,T_X( 7),15,this.sinusarray(59))
    b=this.ronde4(b,c,d,a,T_X(14),21,this.sinusarray(60))

    a=this.ronde4(a,b,c,d,T_X( 5), 6,this.sinusarray(61))
    d=this.ronde4(d,a,b,c,T_X(12),10,this.sinusarray(62))
    c=this.ronde4(c,d,a,b,T_X( 3),15,this.sinusarray(63))
    b=this.ronde4(b,c,d,a,T_X(10),21,this.sinusarray(64))

	&&-- this was wrong, as lead to numeric overfolow when
	&&-- string tocompute is larger than 2KB
*!*	    a=a+olda
*!*	    b=b+oldb
*!*	    c=c+oldC
*!*	    d=d+oldd
	&&-- now it's OK
    a=bitand(a+olda,0xFFFFFFFF)  &&-- cut to 32bit unsigned integer 
    b=bitand(b+oldb,0xFFFFFFFF)
    c=bitand(c+oldC,0xFFFFFFFF)
    d=bitand(d+oldd,0xFFFFFFFF)
  ENDFOR
  a=TRANSFORM(BITAND(a,0xFFFFFFFF),"@0") && cast
  b=TRANSFORM(BITAND(b,0xFFFFFFFF),"@0") && cast
  c=TRANSFORM(BITAND(c,0xFFFFFFFF),"@0") && cast
  d=TRANSFORM(BITAND(d,0xFFFFFFFF),"@0") && cast
  a=SUBSTR(a,9,2)+SUBSTR(a,7,2)+SUBSTR(a,5,2)+SUBSTR(a,3,2)
  b=SUBSTR(b,9,2)+SUBSTR(b,7,2)+SUBSTR(b,5,2)+SUBSTR(b,3,2)
  c=SUBSTR(c,9,2)+SUBSTR(c,7,2)+SUBSTR(c,5,2)+SUBSTR(c,3,2)
  d=SUBSTR(d,9,2)+SUBSTR(d,7,2)+SUBSTR(d,5,2)+SUBSTR(d,3,2)

RETURN a+b+c+d

PROCEDURE testsuite
&& return true if all the reference value are true
  LOCAL test
  test=.T.
  this.tohash=""
  IF LOWER(this.compute())#"d41d8cd98f00b204e9800998ecf8427e"
    RETURN this.tohash
  ENDIF
  this.tohash="a"
  IF LOWER(this.compute())#"0cc175b9c0f1b6a831c399e269772661"
    RETURN this.tohash
  ENDIF
  this.tohash="abc"
  IF LOWER(this.compute())#"900150983cd24fb0d6963f7d28e17f72"
    RETURN this.tohash
  ENDIF
  this.tohash="message digest"
  IF LOWER(this.compute())#"f96b697d7cb7938d525a2f31aaf161d0"
    RETURN this.tohash
  ENDIF
  this.tohash="abcdefghijklmnopqrstuvwxyz"
  IF LOWER(this.compute())#"c3fcd3d76192e4007dfb496cca67e13b"
    RETURN this.tohash
  ENDIF
  this.tohash="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
  IF LOWER(this.compute())#"d174ab98d277d9f5a5611c2c9f419d9f"
    RETURN this.tohash
  ENDIF
  this.tohash="12345678901234567890123456789012345678901234567890123456789012345678901234567890"
  IF LOWER(this.compute())#"57edf4a22be3c955ac49da2e2107b67a"
    RETURN this.tohash
  ENDIF
  RETURN test

ENDDEFINE