encodestrfuns.pas

delphi下的破解MD5加密算法的源码

unit EncodeStrFuns;

interface
uses
  SysUtils,Windows;

Function Encode_16Byte(sMessage : String) : String;
Function Encode_32Byte(sMessage : String) : String;

implementation

Const
  BITS_TO_A_BYTE = 8;
  BYTES_TO_A_WORD = 4;
  BITS_TO_A_WORD = 32;
  m_lOnBits : array [0..30] of Uint =(1,3,7,15,31,63,127,255,511,1023,2047,
      4095,8191,16383,32767,65535,131071,262143,524287,1048575,2097151,4194303,
      8388607,16777215,33554431,67108863,134217727,268435455,536870911,1073741823,
      2147483647);

  m_l2Power : array [0..30] of Uint =(1,2,4,8,16,32,64,128,256,512,1024,2048,
      4096,8192,16384,32768,65536,131072,262144,524288,1048576,2097152,4194304,
      8388608,16777216,33554432,67108864,134217728,268435456,536870912,1073741824);

  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
  lWordArray : array of Uint;

Function EncodeEncy(SMessage:String ; Byte16 : Boolean = True) : String;
  Function LShift(lValue, iShiftBits : Uint) : Uint;
  begin
    If iShiftBits = 0 Then
      begin
        LShift := lValue;
        Exit;
      end
    Else If iShiftBits = 31 Then begin
      If (lValue And 1)<>0 Then
        Result := $80000000
      else Result := 0;
      Exit;
    end;
    
    If (lValue And m_l2Power[31 - iShiftBits])<>0 Then
        Result := ((lValue And m_lOnBits[31 - (iShiftBits + 1)]) * m_l2Power[iShiftBits]) Or $80000000
    Else begin
      Result := ((lValue And m_lOnBits[31 - iShiftBits]) * m_l2Power[iShiftBits]);
    end;
  End;

  Function RShift(lValue, iShiftBits : Uint) : Uint;
  begin
    If iShiftBits = 0 Then
      begin
        RShift := lValue;
        Exit;
      end
    Else If iShiftBits = 31 Then
      begin
        If (lValue And $80000000)<>0 Then
          RShift := 1
        Else
          RShift := 0;
        Exit;
      end;
   
    RShift := (lValue And $7FFFFFFE) div m_l2Power[iShiftBits];

    If (lValue And $80000000)<>0 Then
      Result := (Result Or ($40000000 div m_l2Power[iShiftBits - 1]));
  End;

  Function RotateLeft(lValue, iShiftBits:Uint) : Uint;
  begin
    Result := LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
  End;

  Function AddUnsigned(lX, lY : Uint) : Uint;
  var
    lX8 , lY8 ,lX4 , lY4 ,lResult: Uint;
  begin
      lX8 := lX And $80000000;
      lY8 := lY And $80000000;
      lX4 := lX And $40000000;
      lY4 := lY And $40000000;
 
      lResult := (lX And $3FFFFFFF) + (lY And $3FFFFFFF);
 
      If (lX4 And lY4)<>0 Then
          lResult := lResult Xor $80000000 Xor lX8 Xor lY8
      Else If (lX4 Or lY4)<>0 Then
        begin
          If (lResult And $40000000)<>0 Then
              lResult := lResult Xor $C0000000 Xor lX8 Xor lY8
          Else
              lResult := lResult Xor $40000000 Xor lX8 Xor lY8
        end
      Else
          lResult := lResult Xor lX8 Xor lY8;
      Result := lResult;
  End;


  Procedure ConvertToWordArray(SMessage : String);
  Const
    MODULUS_BITS = 512;
    CONGRUENT_BITS = 448;
  var
    lMessageLength , lNumberOfWords , lBytePosition , lByteCount: Uint;
    lWordCount : Uint;
  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 LShift(ord(sMessage[lByteCount + 1]), lBytePosition);
      lByteCount := lByteCount + 1
   end;
   Dec(lByteCount);
   lWordCount := lByteCount div BYTES_TO_A_WORD;
   lBytePosition := (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE;
   lWordArray[lWordCount] := lWordArray[lWordCount] Or LShift($80, lBytePosition);
   lWordArray[lNumberOfWords - 2] := LShift(lMessageLength, 3);
   lWordArray[lNumberOfWords - 1] := RShift(lMessageLength, 29);
  end;

  Function Encode_F(x, y, z:Uint):Uint;
  begin
    Result := (x And y) Or ((Not x) And z);
  End;
  Function Encode_G(x, y, z:Uint):Uint;
  begin
    Result := (x And z) Or (y And (Not z));
  End;
  Function Encode_H(x, y, z:Uint):Uint;
  begin
    Encode_H := (x Xor y Xor z);
  End;

  Function Encode_I(x, y, z:Uint):Uint;
  begin
    Encode_I := (y Xor (x Or (Not z)));
  End;


  Procedure Encode_FF(var a, b, c, d:Uint; x:Uint; s, ac:Uint);
  begin
    a := AddUnsigned(a, AddUnsigned(AddUnsigned(Encode_F(b, c, d), x), ac));
    a := RotateLeft(a, s);
    a := AddUnsigned(a, b);
  End;


  Procedure Encode_GG(var a, b, c, d:Uint; x:Uint; s, ac:Uint);
  begin
      a := AddUnsigned(a, AddUnsigned(AddUnsigned(Encode_G(b, c, d), Cardinal(x)), ac));
      a := RotateLeft(a, s);
      a := AddUnsigned(a, b);
  End;

  Procedure Encode_HH(var a, b, c, d:Uint; x:Uint; s, ac:Uint);
  begin
      a := AddUnsigned(a, AddUnsigned(AddUnsigned(Encode_H(b, c, d), Cardinal(x)), ac));
      a := RotateLeft(a, s);
      a := AddUnsigned(a, b);
  End;

  Procedure Encode_II(var a, b, c, d:Uint; x:Uint; s, ac:Uint);
  begin
      a := AddUnsigned(a, AddUnsigned(AddUnsigned(Encode_I(b, c, d), Cardinal(x)), ac));
      a := RotateLeft(a, s);
      a := AddUnsigned(a, b);
  End;

  Function WordToHex(lValue:Uint) : String;
  var
   lCount , lByte: Uint;
   S : String;
  begin
    Result := '';
    For lCount := 0 To 3 do begin
     lByte := RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits[BITS_TO_A_BYTE - 1];
     S := inttoHex(lByte,5);
     Result := Result + Copy(S,Length(S)-1,2);
    end
  End;



var
  a,b,c,d : Uint;
  AA,BB,CC,DD : Uint;
  K : integer;
begin
  Setlength(lWordArray,0);
  ConvertToWordArray(sMessage);
  a := $67452301;
  b := $EFCDAB89;
  c := $98BADCFE;
  d := $10325476;
  k := 0;
  while k<Length(lWordArray) do begin
    AA := a;
    BB := b;
    CC := c;
    DD := d;
    Encode_FF( a, b, c, d, lWordArray[k + 0], S11, $D76AA478);  //Add
    Encode_FF( a, b, c, d, lWordArray[k + 0], S11, $D76AA478);
    Encode_FF( d, a, b, c, lWordArray[k + 1], S12, $E8C7B756);
    Encode_FF( c, d, a, b, lWordArray[k + 2], S13, $242070D0);  //Last B-0
    Encode_FF( b, c, d, a, lWordArray[k + 3], S14, $C1BDCEEE);
    Encode_FF( a, b, c, d, lWordArray[k + 4], S11, $F57C0FAF);
    Encode_FF( d, a, b, c, lWordArray[k + 5], S12, $4787C62A);
    Encode_FF( d, a, b, c, lWordArray[k + 5], S12, $4787C62A);  //Add
    Encode_FF( c, d, a, b, lWordArray[k + 6], S13, $A8304613);
    Encode_FF( b, c, d, a, lWordArray[k + 7], S14, $FD469501);
    Encode_FF( a, b, c, d, lWordArray[k + 8], S11, $698098D2);  //Last 8-2
    Encode_FF( d, a, b, c, lWordArray[k + 9], S12, $8B44F7AF);
    Encode_FF( c, d, a, b, lWordArray[k + 10], S13, $FFFF5BB1);
    Encode_FF( c, d, a, b, lWordArray[k + 10], S13, $FFFF5BB1);  //Add
    Encode_FF( b, c, d, a, lWordArray[k + 11], S14, $895CD7BE);
    Encode_FF( a, b, c, d, lWordArray[k + 12], S11, $6B901122);
    Encode_FF( d, a, b, c, lWordArray[k + 13], S12, $FD987193);
    Encode_FF( c, d, a, b, lWordArray[k + 14], S13, $A679438E);
    Encode_FF( c, d, a, b, lWordArray[k + 14], S13, $A679438E);  //Add
    Encode_FF( b, c, d, a, lWordArray[k + 15], S14, $49B40821);

    Encode_GG( a, b, c, d, lWordArray[k + 1], S21, $F61E2562);
//Del    Encode_GG( d, a, b, c, lWordArray[k + 6], S22, $C040B340);
    Encode_GG( c, d, a, b, lWordArray[k + 11], S23, $265E5A51);
    Encode_GG( b, c, d, a, lWordArray[k + 0], S24, $E9B6C7AA);
    Encode_GG( a, b, c, d, lWordArray[k + 5], S21, $D62F105D);
    Encode_GG( d, a, b, c, lWordArray[k + 10], S22, $2441453);
    Encode_GG( c, d, a, b, lWordArray[k + 15], S23, $D8A1E681);
    Encode_GG( b, c, d, a, lWordArray[k + 4], S24, $E7D3FBC8);
    Encode_GG( a, b, c, d, lWordArray[k + 9], S21, $21E1CDE6);
    Encode_GG( d, a, b, c, lWordArray[k + 14], S22, $C33707D6);
    Encode_GG( d, a, b, c, lWordArray[k + 14], S22, $C33707D6);  //Add
    Encode_GG( c, d, a, b, lWordArray[k + 3], S23, $F4D50D87);
    Encode_GG( b, c, d, a, lWordArray[k + 8], S24, $455A14ED);
    Encode_GG( a, b, c, d, lWordArray[k + 13], S21, $A9E3E905);
    Encode_GG( a, b, c, d, lWordArray[k + 13], S21, $A9E3E905);  //Add
    Encode_GG( d, a, b, c, lWordArray[k + 2], S22, $FCEFA3F8);
    Encode_GG( c, d, a, b, lWordArray[k + 7], S23, $676F02D9);
    Encode_GG( b, c, d, a, lWordArray[k + 12], S24, $8D2A4C8A);

    Encode_HH( a, b, c, d, lWordArray[k + 5], S31, $FFFA3942);
    Encode_HH( d, a, b, c, lWordArray[k + 8], S32, $8771F681);
    Encode_HH( c, d, a, b, lWordArray[k + 11], S33, $6D9D6122);
    Encode_HH( b, c, d, a, lWordArray[k + 14], S34, $FDE5380C);
    Encode_HH( a, b, c, d, lWordArray[k + 1], S31, $A4BEEA44);
//Del    Encode_HH( d, a, b, c, lWordArray[k + 4], S32, $4BDECFA9);
    Encode_HH( c, d, a, b, lWordArray[k + 7], S33, $F6BB4B60);
    Encode_HH( b, c, d, a, lWordArray[k + 10], S34, $BEBFBC70);
    Encode_HH( a, b, c, d, lWordArray[k + 13], S31, $289B7EC6);
    Encode_HH( d, a, b, c, lWordArray[k + 0], S32, $EAA127FA);
    Encode_HH( d, a, b, c, lWordArray[k + 0], S32, $EAA127FA);  //Add
    Encode_HH( c, d, a, b, lWordArray[k + 3], S33, $D4EF3085);
    Encode_HH( b, c, d, a, lWordArray[k + 6], S34, $4881D05);
    Encode_HH( a, b, c, d, lWordArray[k + 9], S31, $D9D4D039);
    Encode_HH( d, a, b, c, lWordArray[k + 12], S32, $E6DB99E5);
    Encode_HH( c, d, a, b, lWordArray[k + 15], S33, $1FA27CF8);
    Encode_HH( b, c, d, a, lWordArray[k + 2], S34, $C4AC5665);

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

    a := AddUnsigned(a, AA);
    b := AddUnsigned(b, BB);
    c := AddUnsigned(c, CC);
    d := AddUnsigned(d, DD);
    k := k + 16;
  end;
  if Byte16 then
    Result :=LowerCase(WordToHex(B) + WordToHex(C))
  else
    Result := LowerCase(WordToHex(a) + WordToHex(b) + WordToHex(c) +WordToHex(d));
End;

Function Encode_16Byte(sMessage : String) : String;
begin
  Result := EncodeEncy(sMessage);
End;

Function Encode_32Byte(sMessage : String) : String;
begin
  Result := EncodeEncy(sMessage,False);
End;

end.