unit uEncrypt;

interface

uses Classes, SysUtils, IdGlobal, Windows;

type
  TKeyByte = array[0..5] of Byte;
  TDesMode = (dmEncry, dmDecry);

  PChar16 = ^TChar16;
  TChar16 = array [0..15] of Char;

  TINT4 = array [0..3] of LongWord;
  PINT4 = ^TINT4;

  TMD5Code = class
  private
    FIniValue :TINT4;
    FX :array [0..15] of LongWord;
    FSrcCode: Pointer;
    FSrcCodeLen :Integer;
    FDesCode: TINT4;
    PBuffer :Pointer;
    function func_f(x, y, z: LongWord): LongWord;
    function func_g(x, y, z: LongWord): LongWord;
    function func_i(x, y, z: LongWord): LongWord;
    function func_h(x, y, z: LongWord): LongWord;
    function ROL(val: LongWord; shift: Byte): LongWord;
    function ROR(val: LongWord; shift: Byte): LongWord;

    procedure func_ff(var a :LongWord; b, c, d, x, s, ac: LongWord);
    procedure func_gg(var a :LongWord; b, c, d, x, s, ac: LongWord);
    procedure func_hh(var a :LongWord; b, c, d, x, s, ac: LongWord);
    procedure func_ii(var a :LongWord; b, c, d, x, s, ac: LongWord);
    procedure SetSrcCode(const Value: Pointer);
    procedure SetDesCode(const Value: TINT4);
    procedure MD5Transform(var a, b, c, d :LongWord);
    procedure SetSrcCodeLen(const Value: Integer);
  public
    constructor Create();
    destructor Destroy();
    procedure MD5_Encode();
    procedure HMAC_MD5_Encode(AKey :Pointer; AKeyLen :Integer);
    function GetHexValue(AValue :TINT4) :string;
    property SrcCode :Pointer read FSrcCode write SetSrcCode;
    property SrcCodeLen :Integer read FSrcCodeLen write SetSrcCodeLen;
    property DesCode :TINT4 read FDesCode write SetDesCode;
    class function MD5Encode(srcCode: string): string;
end;
 ////////MD5加密
const

  MD5_INI_VALUE :TINT4 = ($67452301, $EFCDAB89, $98BADCFE, $10325476);
  MD5_SINE: array[1..64] of LongWord = (
   { Round 1. }
    $D76AA478, $E8C7B756, $242070DB, $C1BDCEEE, $F57C0FAF, $4787C62A,
    $A8304613, $FD469501, $698098D8, $8B44F7AF, $FFFF5BB1, $895CD7BE,
    $6B901122, $FD987193, $A679438E, $49B40821,
   { Round 2. }
    $F61E2562, $C040B340, $265E5A51, $E9B6C7AA, $D62F105D, $02441453,
    $D8A1E681, $E7D3FBC8, $21E1CDE6, $C33707D6, $F4D50D87, $455A14ED,
    $A9E3E905, $FCEFA3F8, $676F02D9, $8D2A4C8A,
   { Round 3. }
    $FFFA3942, $8771F681, $6D9D6122, $FDE5380C, $A4BEEA44, $4BDECFA9,
    $F6BB4B60, $BEBFBC70, $289B7EC6, $EAA127FA, $D4EF3085, $04881D05,
    $D9D4D039, $E6DB99E5, $1FA27CF8, $C4AC5665,
   { Round 4. }
    $F4292244, $432AFF97, $AB9423A7, $FC93A039, $655B59C3, $8F0CCC92,
    $FFEFF47D, $85845DD1, $6FA87E4F, $FE2CE6E0, $A3014314, $4E0811A1,
    $F7537E82, $BD3AF235, $2AD7D2BB, $EB86D391
    );
{
  PADDING :array [0..63] of UCHAR =
  (
    $80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  );
}
  S11 :LongWord = 7;
  S12 :LongWord = 12;
  S13 :LongWord = 17;
  S14 :LongWord = 22;
  S21 :LongWord = 5;
  S22 :LongWord = 9;
  S23 :LongWord = 14;
  S24 :LongWord = 20;
  S31 :LongWord = 4;
  S32 :LongWord = 11;
  S33 :LongWord = 16;
  S34 :LongWord = 23;
  S41 :LongWord = 6;
  S42 :LongWord = 10;
  S43 :LongWord = 15;
  S44 :LongWord = 21;
  defKey = 'BASEOIL0';
  Key = 'BDKETSOP';
 ////////MD5加密
  //生成注冊碼
  function GFUN_GetKey(Input_Str: string): string;
  //加密函數
  function GFUN_Crypt(strText: string; intKey: longint=60): string;
  //解密函數
  function GFUN_Decrypt(strText: string; intKey: longint=60): string;
//DES
  function EncryStr(Str, Key: string): string;
  function DecryStr(Str, Key: string): string;
  function EncryStrHex(Str, Key: string): string;
  function DecryStrHex(StrHex, Key: string): string;
  
const
  BitIP: array[0..63] of Byte =
    (57, 49, 41, 33, 25, 17,  9,  1,
     59, 51, 43, 35, 27, 19, 11,  3,
     61, 53, 45, 37, 29, 21, 13,  5,
     63, 55, 47, 39, 31, 23, 15,  7,
     56, 48, 40, 32, 24, 16,  8,  0,
     58, 50, 42, 34, 26, 18, 10,  2,
     60, 52, 44, 36, 28, 20, 12,  4,
     62, 54, 46, 38, 30, 22, 14,  6 );

  BitCP: array[0..63] of Byte =
    ( 39,  7, 47, 15, 55, 23, 63, 31,
      38,  6, 46, 14, 54, 22, 62, 30,
      37,  5, 45, 13, 53, 21, 61, 29,
      36,  4, 44, 12, 52, 20, 60, 28,
      35,  3, 43, 11, 51, 19, 59, 27,
      34,  2, 42, 10, 50, 18, 58, 26,
      33,  1, 41,  9, 49, 17, 57, 25,
      32,  0, 40,  8, 48, 16, 56, 24 );

  BitExp: array[0..47] of Integer =
    ( 31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 8, 9,10,
      11,12,11,12,13,14,15,16,15,16,17,18,19,20,19,20,
      21,22,23,24,23,24,25,26,27,28,27,28,29,30,31,0  );

  BitPM: array[0..31] of Byte =
    ( 15, 6,19,20,28,11,27,16, 0,14,22,25, 4,17,30, 9,
       1, 7,23,13,31,26, 2, 8,18,12,29, 5,21,10, 3,24 );

  sBox: array[0..7] of array[0..63] of Byte =
    ( ( 14,  4, 13,  1,  2, 15, 11,  8,  3, 10,  6, 12,  5,  9,  0,  7,
         0, 15,  7,  4, 14,  2, 13,  1, 10,  6, 12, 11,  9,  5,  3,  8,
         4,  1, 14,  8, 13,  6,  2, 11, 15, 12,  9,  7,  3, 10,  5,  0,
        15, 12,  8,  2,  4,  9,  1,  7,  5, 11,  3, 14, 10,  0,  6, 13 ),

      ( 15,  1,  8, 14,  6, 11,  3,  4,  9,  7,  2, 13, 12,  0,  5, 10,
         3, 13,  4,  7, 15,  2,  8, 14, 12,  0,  1, 10,  6,  9, 11,  5,
         0, 14,  7, 11, 10,  4, 13,  1,  5,  8, 12,  6,  9,  3,  2, 15,
        13,  8, 10,  1,  3, 15,  4,  2, 11,  6,  7, 12,  0,  5, 14,  9 ),

      ( 10,  0,  9, 14,  6,  3, 15,  5,  1, 13, 12,  7, 11,  4,  2,  8,
        13,  7,  0,  9,  3,  4,  6, 10,  2,  8,  5, 14, 12, 11, 15,  1,
        13,  6,  4,  9,  8, 15,  3,  0, 11,  1,  2, 12,  5, 10, 14,  7,
         1, 10, 13,  0,  6,  9,  8,  7,  4, 15, 14,  3, 11,  5,  2, 12 ),

      (  7, 13, 14,  3,  0,  6,  9, 10,  1,  2,  8,  5, 11, 12,  4, 15,
        13,  8, 11,  5,  6, 15,  0,  3,  4,  7,  2, 12,  1, 10, 14,  9,
        10,  6,  9,  0, 12, 11,  7, 13, 15,  1,  3, 14,  5,  2,  8,  4,
         3, 15,  0,  6, 10,  1, 13,  8,  9,  4,  5, 11, 12,  7,  2, 14 ),

      (  2, 12,  4,  1,  7, 10, 11,  6,  8,  5,  3, 15, 13,  0, 14,  9,
        14, 11,  2, 12,  4,  7, 13,  1,  5,  0, 15, 10,  3,  9,  8,  6,
         4,  2,  1, 11, 10, 13,  7,  8, 15,  9, 12,  5,  6,  3,  0, 14,
        11,  8, 12,  7,  1, 14,  2, 13,  6, 15,  0,  9, 10,  4,  5,  3 ),

      ( 12,  1, 10, 15,  9,  2,  6,  8,  0, 13,  3,  4, 14,  7,  5, 11,
        10, 15,  4,  2,  7, 12,  9,  5,  6,  1, 13, 14,  0, 11,  3,  8,
         9, 14, 15,  5,  2,  8, 12,  3,  7,  0,  4, 10,  1, 13, 11,  6,
         4,  3,  2, 12,  9,  5, 15, 10, 11, 14,  1,  7,  6,  0,  8, 13 ),

      (  4, 11,  2, 14, 15,  0,  8, 13,  3, 12,  9,  7,  5, 10,  6,  1,
        13,  0, 11,  7,  4,  9,  1, 10, 14,  3,  5, 12,  2, 15,  8,  6,
         1,  4, 11, 13, 12,  3,  7, 14, 10, 15,  6,  8,  0,  5,  9,  2,
         6, 11, 13,  8,  1,  4, 10,  7,  9,  5,  0, 15, 14,  2,  3, 12 ),

      ( 13,  2,  8,  4,  6, 15, 11,  1, 10,  9,  3, 14,  5,  0, 12,  7,
         1, 15, 13,  8, 10,  3,  7,  4, 12,  5,  6, 11,  0, 14,  9,  2,
         7, 11,  4,  1,  9, 12, 14,  2,  0,  6, 10, 13, 15,  3,  5,  8,
         2,  1, 14,  7,  4, 10,  8, 13, 15, 12,  9,  0,  3,  5,  6, 11 ) );

  BitPMC1: array[0..55] of Byte =
    ( 56, 48, 40, 32, 24, 16,  8,
       0, 57, 49, 41, 33, 25, 17,
       9,  1, 58, 50, 42, 34, 26,
      18, 10,  2, 59, 51, 43, 35,
      62, 54, 46, 38, 30, 22, 14,
       6, 61, 53, 45, 37, 29, 21,
      13,  5, 60, 52, 44, 36, 28,
      20, 12,  4, 27, 19, 11,  3 );

  BitPMC2: array[0..47] of Byte =
    ( 13, 16, 10, 23,  0,  4,
       2, 27, 14,  5, 20,  9,
      22, 18, 11,  3, 25,  7,
      15,  6, 26, 19, 12,  1,
      40, 51, 30, 36, 46, 54,
      29, 39, 50, 44, 32, 47,
      43, 48, 38, 55, 33, 52,
      45, 41, 49, 35, 28, 31 );

var
  subKey: array[0..15] of TKeyByte;

//DES


implementation

{ TMD5Code }

constructor TMD5Code.Create;
begin

end;

destructor TMD5Code.Destroy;
begin

end;

procedure TMD5Code.MD5_Encode;
type
  TMD5_CTX = packed record
    Count64 : Comp;    //64 bits 表示原始數據的長度
    Buffer :array [0..4159] of UCHAR;
end;
var
  a, b, c, d: LongWord;
  i, iBytesToFill :Integer;
  Context :TMD5_CTX;
  Index: Longint;
begin
  Move(FSrcCode^, Context.Buffer, FSrcCodeLen);
  Context.Count64 := FSrcCodeLen * 8;
  Context.Buffer[FSrcCodeLen] := $80;     
  Inc(FSrcCodeLen);

  while (FSrcCodeLen mod 64)<>56 do
  begin
   Context.Buffer[FSrcCodeLen] := 0;
   Inc(FSrcCodeLen);
  end;
  
  Move(Context.Count64, Context.Buffer[FSrcCodeLen], SizeOf(Context.Count64));

  Index := 0;
  Inc(FSrcCodeLen, 8);
  repeat
    Move(Context.Buffer[Index], FX, 64);
    MD5Transform(a, b, c, d);
    Inc(Index,64);
  until Index = FSrcCodeLen;

  PINT4(@FDesCode)^[0] :=FIniValue[0];
  PINT4(@FDesCode)^[1] :=FIniValue[1];
  PINT4(@FDesCode)^[2] :=FIniValue[2];
  PINT4(@FDesCode)^[3] :=FIniValue[3];
  
  FIniValue :=MD5_INI_VALUE;
end;

function TMD5Code.func_f(x, y, z: LongWord): LongWord;
begin
  Result := (x and y) or ((not x) and z);
end;

procedure TMD5Code.func_ff(var a :LongWord; b, c, d, x, s, ac: LongWord);
begin
  a := b + ROL((a + func_f(b, c, d) + x + ac), s);
end;

function TMD5Code.func_g(x, y, z: LongWord): LongWord;
begin
  Result := (x and z) or (y and (not z));
end;

procedure TMD5Code.func_gg(var a :LongWord; b, c, d, x, s, ac: LongWord);
begin
  a := b + ROL((a + func_g(b, c, d) + x + ac), s);
end;

function TMD5Code.func_h(x, y, z: LongWord): LongWord;
begin
  Result := x xor y xor z;
end;

procedure TMD5Code.func_hh(var a :LongWord; b, c, d, x, s, ac: LongWord);
begin
  a := b + ROL((a + func_h(b, c, d) + x + ac), s);
end;

function TMD5Code.func_i(x, y, z: LongWord): LongWord;
begin
  Result := y xor (x or (not z));
end;

procedure TMD5Code.func_ii(var a :LongWord; b, c, d, x, s, ac: LongWord);
begin
  a := b + ROL((a + func_i(b, c, d) + x + ac), s);
end;

function TMD5Code.GetHexValue(AValue: TINT4): string;
var
  PC:PChar;
begin
  PC :=AllocMem(32);
  BinToHex(@AValue, PC, SizeOf(AValue));
  Result :=PC;
  if Length(Result)>32 then
    Result :=Copy(Result, 1, 32);

  Finalize(PC);
  FreeMem(PC);
end;

procedure TMD5Code.MD5Transform(var a, b, c, d :LongWord);
begin
  a :=FIniValue[0];
  b :=FIniValue[1];
  c :=FIniValue[2];
  d :=FIniValue[3];

  //* Round 1 */
  func_ff(a, b, c, d, FX[ 0], S11, $d76aa478); //* 1 */
  func_ff(d, a, b, c, FX[ 1], S12, $e8c7b756); //* 2 */
  func_ff(c, d, a, b, FX[ 2], S13, $242070db); //* 3 */
  func_ff(b, c, d, a, FX[ 3], S14, $c1bdceee); //* 4 */
  func_ff(a, b, c, d, FX[ 4], S11, $f57c0faf); //* 5 */
  func_ff(d, a, b, c, FX[ 5], S12, $4787c62a); //* 6 */
  func_ff(c, d, a, b, FX[ 6], S13, $a8304613); //* 7 */
  func_ff(b, c, d, a, FX[ 7], S14, $fd469501); //* 8 */
  func_ff(a, b, c, d, FX[ 8], S11, $698098d8); //* 9 */
  func_ff(d, a, b, c, FX[ 9], S12, $8b44f7af); //* 10 */
  func_ff(c, d, a, b, FX[10], S13, $ffff5bb1); //* 11 */
  func_ff(b, c, d, a, FX[11], S14, $895cd7be); //* 12 */
  func_ff(a, b, c, d, FX[12], S11, $6b901122); //* 13 */
  func_ff(d, a, b, c, FX[13], S12, $fd987193); //* 14 */
  func_ff(c, d, a, b, FX[14], S13, $a679438e); //* 15 */
  func_ff(b, c, d, a, FX[15], S14, $49b40821); //* 16 */

  //* Round 2 */
  func_gg(a, b, c, d, FX[ 1], S21, $f61e2562); //* 17 */
  func_gg(d, a, b, c, FX[ 6], S22, $c040b340); //* 18 */
  func_gg(c, d, a, b, FX[11], S23, $265e5a51); //* 19 */
  func_gg(b, c, d, a, FX[ 0], S24, $e9b6c7aa); //* 20 */
  func_gg(a, b, c, d, FX[ 5], S21, $d62f105d); //* 21 */
  func_gg(d, a, b, c, FX[10], S22,  $2441453); //* 22 */
  func_gg(c, d, a, b, FX[15], S23, $d8a1e681); //* 23 */
  func_gg(b, c, d, a, FX[ 4], S24, $e7d3fbc8); //* 24 */
  func_gg(a, b, c, d, FX[ 9], S21, $21e1cde6); //* 25 */
  func_gg(d, a, b, c, FX[14], S22, $c33707d6); //* 26 */
  func_gg(c, d, a, b, FX[ 3], S23, $f4d50d87); //* 27 */
  func_gg(b, c, d, a, FX[ 8], S24, $455a14ed); //* 28 */
  func_gg(a, b, c, d, FX[13], S21, $a9e3e905); //* 29 */
  func_gg(d, a, b, c, FX[ 2], S22, $fcefa3f8); //* 30 */
  func_gg(c, d, a, b, FX[ 7], S23, $676f02d9); //* 31 */
  func_gg(b, c, d, a, FX[12], S24, $8d2a4c8a); //* 32 */

  //* Round 3 */
  func_hh(a, b, c, d, FX[ 5], S31, $fffa3942); //* 33 */
  func_hh(d, a, b, c, FX[ 8], S32, $8771f681); //* 34 */
  func_hh(c, d, a, b, FX[11], S33, $6d9d6122); //* 35 */
  func_hh(b, c, d, a, FX[14], S34, $fde5380c); //* 36 */
  func_hh(a, b, c, d, FX[ 1], S31, $a4beea44); //* 37 */
  func_hh(d, a, b, c, FX[ 4], S32, $4bdecfa9); //* 38 */
  func_hh(c, d, a, b, FX[ 7], S33, $f6bb4b60); //* 39 */
  func_hh(b, c, d, a, FX[10], S34, $bebfbc70); //* 40 */
  func_hh(a, b, c, d, FX[13], S31, $289b7ec6); //* 41 */
  func_hh(d, a, b, c, FX[ 0], S32, $eaa127fa); //* 42 */
  func_hh(c, d, a, b, FX[ 3], S33, $d4ef3085); //* 43 */
  func_hh(b, c, d, a, FX[ 6], S34,  $4881d05); //* 44 */
  func_hh(a, b, c, d, FX[ 9], S31, $d9d4d039); //* 45 */
  func_hh(d, a, b, c, FX[12], S32, $e6db99e5); //* 46 */
  func_hh(c, d, a, b, FX[15], S33, $1fa27cf8); //* 47 */
  func_hh(b, c, d, a, FX[ 2], S34, $c4ac5665); //* 48 */

  //* Round 4 */
  func_ii(a, b, c, d, FX[ 0], S41, $f4292244); //* 49 */
  func_ii(d, a, b, c, FX[ 7], S42, $432aff97); //* 50 */
  func_ii(c, d, a, b, FX[14], S43, $ab9423a7); //* 51 */
  func_ii(b, c, d, a, FX[ 5], S44, $fc93a039); //* 52 */
  func_ii(a, b, c, d, FX[12], S41, $655b59c3); //* 53 */
  func_ii(d, a, b, c, FX[ 3], S42, $8f0ccc92); //* 54 */
  func_ii(c, d, a, b, FX[10], S43, $ffeff47d); //* 55 */
  func_ii(b, c, d, a, FX[ 1], S44, $85845dd1); //* 56 */
  func_ii(a, b, c, d, FX[ 8], S41, $6fa87e4f); //* 57 */
  func_ii(d, a, b, c, FX[15], S42, $fe2ce6e0); //* 58 */
  func_ii(c, d, a, b, FX[ 6], S43, $a3014314); //* 59 */
  func_ii(b, c, d, a, FX[13], S44, $4e0811a1); //* 60 */
  func_ii(a, b, c, d, FX[ 4], S41, $f7537e82); //* 61 */
  func_ii(d, a, b, c, FX[11], S42, $bd3af235); //* 62 */
  func_ii(c, d, a, b, FX[ 2], S43, $2ad7d2bb); //* 63 */
  func_ii(b, c, d, a, FX[ 9], S44, $eb86d391); //* 64 */

  FIniValue[0] :=FIniValue[0] + a;
  FIniValue[1] :=FIniValue[1] + b;
  FIniValue[2] :=FIniValue[2] + c;
  FIniValue[3] :=FIniValue[3] + d;
end;

procedure TMD5Code.SetDesCode(const Value: TINT4);
begin
  FDesCode := Value;
end;

procedure TMD5Code.SetSrcCode(const Value: Pointer);
var
  S :string;
begin
  if Value = nil then FSrcCode :=@S;
  FSrcCode := Value;
  FIniValue :=MD5_INI_VALUE;
  FSrcCodeLen :=Length(PChar(FSrcCode));
end;

procedure TMD5Code.SetSrcCodeLen(const Value: Integer);
begin
  FSrcCodeLen := Value;
end;

procedure TMD5Code.HMAC_MD5_Encode(AKey :Pointer; AKeyLen :Integer);
var