md5.pas

来自「delphi框架可以学习, 写的很好的」· PAS 代码 · 共 298 行

UNIT md5;

INTERFACE

////////////////////////////////////////////
//  文件名 : AMD5.pas                     //
//   功能  : 与md5.asp计算结果相同        //
//   作者  : 由ScriptBaby改编自md5.asp    //
// 完成时间: 2004-07-21                   //
////////////////////////////////////////////

      //请转载者保留以上信息，谢谢//

USES
   SysUtils;

TYPE
   arrlongword = ARRAY OF longword;

TYPE
   sMd5 = CLASS
      CLASS FUNCTION RotateLeft(CONST lValue, Bits: longword): longword;
      CLASS FUNCTION md5(CONST sMessage: STRING; CONST sType: Boolean = false): STRING;
      CLASS FUNCTION ConvToWord(CONST sMessage: STRING): arrlongword; OVERLOAD;
      CLASS FUNCTION ConvToWord(CONST sMessage: WideString): arrlongword; OVERLOAD;
      CLASS FUNCTION WordToHex(CONST lValue: longword): STRING;
   END;

IMPLEMENTATION

CONST
   BITS_TO_A_BYTE = 8;
   BYTES_TO_A_WORD = 4;
   BITS_TO_A_WORD = 32;

   cAA = $67452301;
   cBB = $EFCDAB89;
   cCC = $98BADCFE;
   cDD = $10325476;

   MODULUS_BITS = 512;
   CONGRUENT_BITS = 448;

   { sMD5 }

CLASS FUNCTION sMd5.ConvToWord(CONST sMessage: WideString): arrlongword;
VAR
   lMessageLength,
      lNumberOfWords,
      lBytePosition,
      lByteCount,
      lWordCount: longword;
   lWordArray: arrlongword;

   { Function }
   FUNCTION Asc(CONST t: WideChar): Smallint;
   VAR
      s: STRING;
      a: Smallint;
   BEGIN
      s := t;

      a := Smallint(s[1]);
      CASE Length(s) OF
         2: BEGIN
               a := a SHL 8;
               a := a + Smallint(s[2]);
            END
      ELSE ;
      END;

      Result := a;
   END;

BEGIN
   lMessageLength := Length(sMessage);

   lNumberOfWords := (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) DIV BITS_TO_A_BYTE)) DIV (MODULUS_BITS DIV BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS DIV BITS_TO_A_WORD);

   SetLength(lWordArray, lNumberOfWords);

   lByteCount := 0;
   WHILE lByteCount < lMessageLength DO BEGIN
      lWordCount := lByteCount DIV BYTES_TO_A_WORD;
      lBytePosition := (lByteCount MOD BYTES_TO_A_WORD) * BITS_TO_A_BYTE;
      lWordArray[lWordCount] := lWordArray[lWordCount] OR longword(Asc(sMessage[lByteCount + 1]) SHL lBytePosition);
      lByteCount := lByteCount + 1;
   END;

   lWordCount := lByteCount DIV BYTES_TO_A_WORD;
   lBytePosition := (lByteCount MOD BYTES_TO_A_WORD) * BITS_TO_A_BYTE;

   lWordArray[lWordCount] := lWordArray[lWordCount] OR ($80 SHL lBytePosition);

   lWordArray[lNumberOfWords - 2] := lMessageLength SHL 3;
   lWordArray[lNumberOfWords - 1] := lMessageLength SHR 29;

   Result := lWordArray;

END;

CLASS FUNCTION sMd5.ConvToWord(CONST sMessage: STRING): arrlongword;
BEGIN
   Result := ConvToWord(WideString(sMessage));
END;

CLASS FUNCTION sMd5.md5(CONST sMessage: STRING;
   CONST sType: Boolean = false): STRING;
CONST
   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;
VAR
   k: integer;
   AA, BB, CC, DD, a, b, c, d: longword;
   x: arrlongword;
   s: STRING;

   { functions }

   FUNCTION md5_F(CONST x, y, z: longword): longword;
   BEGIN
      Result := (x AND y) OR ((NOT x) AND z);
   END;

   FUNCTION md5_G(CONST x, y, z: longword): longword;
   BEGIN
      Result := (x AND z) OR (y AND (NOT z));
   END;

   FUNCTION md5_H(CONST x, y, z: longword): longword;
   BEGIN
      Result := (x XOR y XOR z);
   END;

   FUNCTION md5_I(CONST x, y, z: longword): longword;
   BEGIN
      Result := (y XOR (x OR (NOT z)));
   END;

   PROCEDURE md5_FF(VAR a: longword; CONST b, c, d, x, s, ac: longword);
   BEGIN
      a := a + md5_F(b, c, d) + x + ac;
      a := RotateLeft(a, s);
      a := a + b;
   END;

   PROCEDURE md5_GG(VAR a: longword; CONST b, c, d, x, s, ac: longword);
   BEGIN
      a := a + md5_G(b, c, d) + x + ac;
      a := RotateLeft(a, s);
      a := a + b;
   END;

   PROCEDURE md5_HH(VAR a: longword; CONST b, c, d, x, s, ac: longword);
   BEGIN
      a := a + md5_H(b, c, d) + x + ac;
      a := RotateLeft(a, s);
      a := a + b;
   END;

   PROCEDURE md5_II(VAR a: longword; CONST b, c, d, x, s, ac: longword);
   BEGIN
      a := a + md5_I(b, c, d) + x + ac;
      a := RotateLeft(a, s);
      a := a + b;
   END;

BEGIN

   { MD5 }
   x := ConvToWord(sMessage);

   a := cAA;
   b := cBB;
   c := cCC;
   d := cDD;

   k := 0;
   REPEAT
      AA := a;
      BB := b;
      CC := c;
      DD := d;

      md5_FF(a, b, c, d, x[k + 0], S11, $D76AA478);
      md5_FF(d, a, b, c, x[k + 1], S12, $E8C7B756);
      md5_FF(c, d, a, b, x[k + 2], S13, $242070DB);
      md5_FF(b, c, d, a, x[k + 3], S14, $C1BDCEEE);
      md5_FF(a, b, c, d, x[k + 4], S11, $F57C0FAF);
      md5_FF(d, a, b, c, x[k + 5], S12, $4787C62A);
      md5_FF(c, d, a, b, x[k + 6], S13, $A8304613);
      md5_FF(b, c, d, a, x[k + 7], S14, $FD469501);
      md5_FF(a, b, c, d, x[k + 8], S11, $698098D8);
      md5_FF(d, a, b, c, x[k + 9], S12, $8B44F7AF);
      md5_FF(c, d, a, b, x[k + 10], S13, $FFFF5BB1);
      md5_FF(b, c, d, a, x[k + 11], S14, $895CD7BE);
      md5_FF(a, b, c, d, x[k + 12], S11, $6B901122);
      md5_FF(d, a, b, c, x[k + 13], S12, $FD987193);
      md5_FF(c, d, a, b, x[k + 14], S13, $A679438E);
      md5_FF(b, c, d, a, x[k + 15], S14, $49B40821);

      md5_GG(a, b, c, d, x[k + 1], S21, $F61E2562);
      md5_GG(d, a, b, c, x[k + 6], S22, $C040B340);
      md5_GG(c, d, a, b, x[k + 11], S23, $265E5A51);
      md5_GG(b, c, d, a, x[k + 0], S24, $E9B6C7AA);
      md5_GG(a, b, c, d, x[k + 5], S21, $D62F105D);
      md5_GG(d, a, b, c, x[k + 10], S22, $2441453);
      md5_GG(c, d, a, b, x[k + 15], S23, $D8A1E681);
      md5_GG(b, c, d, a, x[k + 4], S24, $E7D3FBC8);
      md5_GG(a, b, c, d, x[k + 9], S21, $21E1CDE6);
      md5_GG(d, a, b, c, x[k + 14], S22, $C33707D6);
      md5_GG(c, d, a, b, x[k + 3], S23, $F4D50D87);
      md5_GG(b, c, d, a, x[k + 8], S24, $455A14ED);
      md5_GG(a, b, c, d, x[k + 13], S21, $A9E3E905);
      md5_GG(d, a, b, c, x[k + 2], S22, $FCEFA3F8);
      md5_GG(c, d, a, b, x[k + 7], S23, $676F02D9);
      md5_GG(b, c, d, a, x[k + 12], S24, $8D2A4C8A);
      md5_HH(a, b, c, d, x[k + 5], S31, $FFFA3942);
      md5_HH(d, a, b, c, x[k + 8], S32, $8771F681);
      md5_HH(c, d, a, b, x[k + 11], S33, $6D9D6122);
      md5_HH(b, c, d, a, x[k + 14], S34, $FDE5380C);
      md5_HH(a, b, c, d, x[k + 1], S31, $A4BEEA44);
      md5_HH(d, a, b, c, x[k + 4], S32, $4BDECFA9);
      md5_HH(c, d, a, b, x[k + 7], S33, $F6BB4B60);
      md5_HH(b, c, d, a, x[k + 10], S34, $BEBFBC70);
      md5_HH(a, b, c, d, x[k + 13], S31, $289B7EC6);
      md5_HH(d, a, b, c, x[k + 0], S32, $EAA127FA);
      md5_HH(c, d, a, b, x[k + 3], S33, $D4EF3085);
      md5_HH(b, c, d, a, x[k + 6], S34, $4881D05);
      md5_HH(a, b, c, d, x[k + 9], S31, $D9D4D039);
      md5_HH(d, a, b, c, x[k + 12], S32, $E6DB99E5);
      md5_HH(c, d, a, b, x[k + 15], S33, $1FA27CF8);
      md5_HH(b, c, d, a, x[k + 2], S34, $C4AC5665);

      md5_II(a, b, c, d, x[k + 0], S41, $F4292244);
      md5_II(d, a, b, c, x[k + 7], S42, $432AFF97);
      md5_II(c, d, a, b, x[k + 14], S43, $AB9423A7);
      md5_II(b, c, d, a, x[k + 5], S44, $FC93A039);
      md5_II(a, b, c, d, x[k + 12], S41, $655B59C3);
      md5_II(d, a, b, c, x[k + 3], S42, $8F0CCC92);
      md5_II(c, d, a, b, x[k + 10], S43, $FFEFF47D);
      md5_II(b, c, d, a, x[k + 1], S44, $85845DD1);
      md5_II(a, b, c, d, x[k + 8], S41, $6FA87E4F);
      md5_II(d, a, b, c, x[k + 15], S42, $FE2CE6E0);
      md5_II(c, d, a, b, x[k + 6], S43, $A3014314);
      md5_II(b, c, d, a, x[k + 13], S44, $4E0811A1);
      md5_II(a, b, c, d, x[k + 4], S41, $F7537E82);
      md5_II(d, a, b, c, x[k + 11], S42, $BD3AF235);
      md5_II(c, d, a, b, x[k + 2], S43, $2AD7D2BB);
      md5_II(b, c, d, a, x[k + 9], S44, $EB86D391);

      a := a + AA;
      b := b + BB;
      c := c + CC;
      d := d + DD;

      k := k + 16;
   UNTIL k > High(x);

   IF sType THEN BEGIN
      s := WordToHex(a) + WordToHex(b) + WordToHex(c) + WordToHex(d)
   END
   ELSE BEGIN
      s := WordToHex(b) + WordToHex(c);
   END;

   Result := StrLower(PAnsiChar(s));
END;

CLASS FUNCTION sMd5.RotateLeft(CONST lValue, Bits: longword): longword;
BEGIN
   Result := (lValue SHL Bits) OR (lValue SHR (32 - Bits));
END;

CLASS FUNCTION sMd5.WordToHex(CONST lValue: longword): STRING;
VAR
   s: STRING;
BEGIN
   s := inttohex(lValue, 8);
   Result := s[7] + s[8] + s[5] + s[6] + s[3] + s[4] + s[1] + s[2];
END;

END.