unit Class_QQTEA;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

{
'QQ TEA-16 Encrypt/Decrypt Class Moudle
'
'由于 www.souker.com 盜用我的源代碼騙錢
'決定陸續公布所有源代碼
'
'Author:  iceboy [366tian]
'         icediy@163.com
'         bbs.366tian.net
'         QQ: 41785691
'
'Thank you:
'         Roy
'         Fish
'         Hisol
'
'And also LumaQQ's source code
'         clsTea's source code
'         clsAES's source code
'         API-Guide
'         Thinking in Java
'         etc.
'

}
Type
   PMyByte=^TMYByte;
   TMYByte=Array [0..500] of byte;
   TQQTEA=Class
   private
     FCurrLen:Integer;

     m_lOnBits:Array [0..30] of integer;
     m_l2Power:Array [0..30] of integer;
     //Plain,PrePlain,OutKey:Array of Byte;
     Plain    :TMYByte;     //指向當前的明文塊
     prePlain :TMYByte;    //指向前面一個明文塊
     OutKey   :TMYByte;    //輸出的密文或者明文
     Crypt,preCrypt :Integer;    //當前加密的密文位置和上一次加密的密文塊位置，他們相差8
     Pos      :Integer;   //當前處理的加密解密塊的位置
     padding:integer;            //填充數

     Key    :Array  of Byte;   //密鑰
     Header :Boolean;            //用于加密時，表示當前是否是第一個8字節塊，因為加密算法
                                 //是反饋的，但是最開始的8個字節沒有反饋可用，所有需要標
                                 //明這種情況
     contextStart:integer;
     procedure Class_Initialize;      //這個表示當前解密開始的位置，之所以要這么一個變量是為了
                                //避免當解密到最后時后面已經沒有數據，這時候就會出錯，這
                                //個變量就是用來判斷這種情況免得出錯


     procedure ClearArray(var Arr:Array of Byte);
     function GetFCurrLen: integer;

   public
     constructor Create;

     Function Rand:Integer;
     procedure Encrypt8Bytes;

     Function Decipher(arrayIn, arrayKey:array of Byte;offset:Integer=0):TMYByte;

     //Function Decipher(arrayIn,arrayKey :array of byte;offset:Integer):TMYByte;

     Function Decrypt8Bytes(arrayIn:array of byte;offset:Integer):Boolean;

     Function Encrypt(arrayIn,arrayKey :array of byte;Var nSendLen:integer;offset:Integer=0):TMYByte;
     Function Decrypt(arrayIn,arrayKey :array of byte;offset:Integer=0):TMYByte;
     Function Encipher(arrayIn,arrayKey:array of Byte;offset:Integer=0):TMYByte;
     //Function Encipher(arrayIn,arrayKey :array of byte;offset:Integer):TMYByte;
     Function LShift(lValue:Longint; iShiftBits:Integer):Integer;
     Function RShift(lValue:Longint; iShiftBits:Integer):Integer;
     Function UnsignedAdd(Data1:integer; Data2:integer):integer;
     Function UnsignedDel(Data1, Data2:integer):integer;

     property CurrLen :integer Read GetFCurrLen; 
   end;

var
  QQTEA:TQQTEA;
  GlobalCurrLen:Integer;

  procedure InitArray(var My:TMyByte);


implementation

Function TQQTEA.Encrypt(arrayIn,arrayKey :array of byte;Var nSendLen:integer;offset:Integer):TMYByte;
var
  i:integer;
  nLen :integer;
  nMyLen:integer;
begin
   Pos :=1;
   Crypt :=0;
   preCrypt := 0;
   nLen :=High(arrayin)+1;

   SetLength(Key,High(arrayKey)+1);
   ClearArray(Key);

   CopyMemory(@Key[0], @arrayKey[0],High(arrayKey)+1);

    Header := True ;
    Pos := (nLen+ 10) Mod 8;
    If Pos <> 0 Then Pos := 8-Pos;
    nSendLen :=nLen + Pos + 10;

    For i:=0 to 499 do
    begin
      OutKey[i]:=0;
      prePlain[i]:=0;
      Plain[i]:=0;
    end;
    Plain[0] := (Rand And $F8) Or Pos;
    For I := 1 To Pos do
        Plain[I] := Rand And $FF;

    For I := 0 To 7 do
        prePlain[i] :=$0;

    Pos := Pos + 1;
    padding := 1;
    While padding < 3 do
    begin
      If Pos < 8 Then
      begin
          Plain[Pos] := Rand And $FF;
          padding    := padding + 1 ;
          Pos        := Pos + 1   ;
      end else if Pos = 8 Then
          Encrypt8Bytes;
    end;
    I := offset;   // 頭部填充完了，這里開始填真正的明文了，也是滿了8字節就加密，一直到明文讀完
    While nLen > 0 do
    begin
      If Pos < 8 Then
      begin
          Plain[Pos] := arrayIn[I];
          I := I + 1;
          Pos := Pos + 1;
          nLen := nLen - 1;
      end else if Pos = 8 Then
          Encrypt8Bytes
    end;

    padding := 1;         // 最后填上0，以保證是8字節的倍數
    While padding < 9 do
    begin
      If Pos < 8 Then
      begin
          Plain[Pos] := $0;
          Pos := Pos + 1;
          padding := padding + 1
      end else If Pos = 8 Then
          Encrypt8Bytes
    end;
    //SetLength(Result,High(OutKey)+1);
    //CopyMemory(@Result[0],@OutKey[0],High(OutKey)+1);
    CopyMemory(@Result[0],@OutKey[0], nSendLen);



    //Result := OutKey;
end;


Function TQQTEA.Decrypt(arrayIn,arrayKey :array of byte;offset:Integer):TMYByte;
var
   m:array of byte;
   I :Integer;
   Count :Integer;
   nLen :integer;
begin
    If (High(arrayIn) < 15) Or (((High(arrayIn)+1) Mod 8) <> 0) Then Exit ;
    //If High(arrayKey) <> 15 Then Exit ;
    SetLength(m,offset + 8);
    SetLength(Key,16);
    CopyMemory(@Key[0], @arrayKey[0],16);
    Crypt    := 0;
    preCrypt := 0;
    prePlain := Decipher(arrayIn, arrayKey, offset);
    Pos := prePlain[0] And $7;
    Count:= High(arrayIn)- Pos - 8;
    nLen := High(arrayIn)- Pos - 8;
    If Count < 0 Then Exit ;
    //SetLength(OutKey,Count ); //**
    preCrypt := 0 ;
    Crypt    := 8 ;
    contextStart := 8;
    Pos := Pos + 1;
    padding := 1 ;
    While padding < 3 do
    begin
        If Pos < 8 Then
        begin
            Pos := Pos + 1;
            padding := padding + 1;
        end Else If Pos = 8 Then
        begin
              SetLength(m,high(arrayIn)+1);
              CopyMemory(@m[0], @arrayIn[0], High(m)+ 1);
              If not Decrypt8Bytes(arrayIn, offset) Then Exit;
        end;
    end;
    I := 0;
    While Count <> 0 do
    begin
        If Pos < 8 Then
        begin
            OutKey[I] := m[offset + preCrypt + Pos] Xor prePlain[Pos];
            I := I + 1 ;
            Count := Count - 1;
            Pos   := Pos + 1;
        end  Else If Pos = 8 Then
          begin
            //m := arrayIn; //**
            SetLength(m,High(arrayin)+1);//**

            CopyMemory(@m[0],@arrayin[0],High(arrayin)+1);
            preCrypt := Crypt - 8;
            If not Decrypt8Bytes(arrayIn, offset) Then Exit ;
          end
    end;
    For i:=1 To 7 do
    begin
        If Pos < 8 Then
        begin
            If (m[offset + preCrypt + Pos] Xor prePlain[Pos]) <> 0 Then Exit;
            Pos := Pos + 1;
        end else If Pos = 8 Then
          begin
            CopyMemory(@m[0], @arrayIn[0], High(m) + 1);
            preCrypt := Crypt;
            If not Decrypt8Bytes(arrayIn, offset) Then Exit;
          end;
    end;

 
    //SetLength(Result,High(OutKey)+1);
    //Result :=OutKey;

    CopyMemory(@Result[0],@OutKey[0],nLen);
    FCurrLen :=nLen;

    //Result := OutKey;
end;

procedure TQQTEA.Encrypt8Bytes;
var
  Crypted:TMYByte;
  I :Integer;
begin
    For i :=0 To 7 do
    begin
        If Header Then
            Plain[i] := Plain[i] Xor prePlain[i]
        Else
            Plain[i] := Plain[i] Xor OutKey[preCrypt + i];
    end;
    
    //**
    Crypted := Encipher(Plain,Key);

    For I := 0 To 7 do
        OutKey[Crypt + I] := Crypted[I];

    For i :=0 To 7 do
        OutKey[Crypt + i] := OutKey[Crypt + i] Xor prePlain[i];

    //prePlain := Plain;
    CopyMemory(@PrePlain[0],@Plain[0],8);
    preCrypt := Crypt;
    Crypt    := Crypt + 8;
    Pos := 0;
    Header := False
end;



Function TQQTEA.Decrypt8Bytes(arrayIn:array of byte;offset:Integer):Boolean;
var
  i:integer;
begin
    For i:=0  To 7 do
    begin
        If (contextStart + i) > (High(arrayIn)) Then
        begin
            Result:=True;
            Exit;
        end;
        prePlain[i] := prePlain[i] Xor arrayIn[offset + Crypt + i];
    end;
    try
    //**
      prePlain := Decipher(prePlain, Key);
    except
     Result := False;
     Exit;
    end;
    contextStart := contextStart + 8;
    Crypt := Crypt + 8;
    Pos   := 0;
    Result:= True;
end;


//Function Encipher(arrayIn:TMYByte;arrayKey:Array [0..30] of integer ;offset:Integer):TMYByte;
//Function Encipher:TMYByte;
Function TQQTEA.Encipher(arrayIn,arraykey:Array of Byte;offset:Integer):TMYByte;
var
    I,y,z,a,b,c,d:Longword;
    sum,delta :Longword;
    tmpArray :Array [0..23] of Byte;
    //tmpOut :Array [0..7] of Byte;
    tmpOut :TMYByte;

begin
   { If High(arrayIn) < 7 Then Exit ;
    If High(arrayKey) < 15 Then Exit ;
    sum := 0;
    delta := $9E3779B9;
    delta := delta And $FFFFFFFF;
    CopyMemory(@y,@arrayIn[0],4);
    CopyMemory(@z,@arrayIn[4],4);
    CopyMemory(@a,@arrayKey[0],4);
    CopyMemory(@b,@arrayKey[4],4);
    CopyMemory(@c,@arrayKey[8],4);
    CopyMemory(@d,@arrayKey[12],4);

    For I := 1 To 16 do
    begin
        sum := sum+delta;
        sum := sum And $FFFFFFFF;
        y :=Y+((z shl 4) + a) xor (z + sum) xor ((z shr 5) + b);
        y :=Y and $FFFFFFFF;
        z :=Z+((y shl 4) + c) xor (y + sum) xor ((y shr 5) + d);
        z :=z and $FFFFFFFF;
    end;
   
    SetLength(Result,8);
    Y:=Integer(Y);
    Z:=Integer(Z);
    CopyMemory(@Result[0],@y,4);
    CopyMemory(@Result[4],@z,4);  }

    If High(arrayIn) < 7 Then Exit ;