RealICQClient/AppCentre/XXTEA.pas

{
/**********************************************************\  
|                                                          |  
| The implementation of PHPRPC Protocol 3.0                |  
|                                                          |  
| XXTEA.pas                                                |  
|                                                          |  
| Release 3.0.0                                            |  
| Copyright (c) 2005-2008 by Team-PHPRPC                   |  
|                                                          |  
| WebSite:  http://www.phprpc.org/                         |  
|           http://www.phprpc.net/                         |  
|           http://www.phprpc.com/                         |  
|           http://sourceforge.net/projects/php-rpc/       |  
|                                                          |  
| Authors:  Ma Bingyao <andot@ujn.edu.cn>                  |  
|                                                          |  
| This file may be distributed and/or modified under the   |  
| terms of the GNU Lesser General Public License (LGPL)    |  
| version 3.0 as published by the Free Software Foundation |  
| and appearing in the included file LICENSE.              |  
|                                                          |  
\**********************************************************/  
 
/* XXTEA encryption arithmetic library.  
 *  
 * Copyright (C) 2005-2008 Ma Bingyao <andot@ujn.edu.cn>  
 * Version: 3.0.0  
 * LastModified: Jan 17, 2008  
 * This library is free.  You can redistribute it and/or modify it.  
 */  
}  
  
unit XXTEA;
  
interface
 uses
    SysUtils,Windows;
  
function Encrypt(const data:AnsiString; const key:AnsiString):AnsiString;   
function Decrypt(const data:AnsiString; const key:AnsiString):AnsiString;
function DecryptNoHex(const data:AnsiString; const key:AnsiString):AnsiString;
function HexToStr(const Str: AnsiString): AnsiString;
  
implementation  
  
type
  TLongWordDynArray = array of LongWord;
  
const  
  delta:Longword = $9e3779b9;

function HexToStr(const Str: AnsiString): AnsiString;
asm
  push ebx
  push edi
  push esi
  test eax,eax //为空串
  jz   @@Exit
  mov  edi,eax
  mov  esi,edx
  mov  edx,[eax-4]
  test edx,edx
  je   @@Exit
  mov  ecx,edx
  push ecx
  shr  edx,1
  mov  eax,esi //开始构造字符串
  {$IFDEF VER210}
  movzx ecx, word ptr [edi-12] {需要设置CodePage}
  {$ENDIF}
  call System.@LStrSetLength //设置新串长度
  mov  eax,esi       //新字符串地址
  Call UniqueString  //产生一个唯一的新字符串，串位置在eax中
  Pop   ecx
  xor  ebx,ebx
  xor  esi,esi
@@CharFromHex:
  xor  edx,edx
  mov  dl, [edi]     //Str字符串字符
  cmp  dl, '0'  //查看是否在0到f之间的字符
  JB   @@Exit   //小于0，退出
  cmp  dl,'9'   //小于=9
  ja  @@DoChar//CompOkNum
  sub  dl,'0'
  jmp  @@DoConvert
@@DoChar:
  //先转成大写字符
  and  dl,$DF
  cmp  dl,'F'
  ja   @@Exit  //大于F退出
  add  dl,10
  sub  dl,'A'
@@DoConvert: //转化
  inc  ebx
  cmp  ebx,2
  je   @@Num1
  xor  esi,esi
  shl  edx,4
  mov  esi,edx
  jmp  @@Num2
@@Num1:
  add  esi,edx
  mov  edx,esi
  mov  [eax],dl
  xor  ebx,ebx
  inc  eax
@@Num2:
  dec  ecx
  inc  edi
  test ecx,ecx
  jnz  @@CharFromHex
@@Exit:
  pop  esi
  pop  edi
  pop  ebx
end;

function StrToHex(Const str: Ansistring): Ansistring;
asm
    push ebx
    push esi
    push edi
    test eax,eax
    jz   @@Exit
    mov  esi,edx       //保存edx值，用来产生新字符串的地址
    mov  edi,eax       //保存原字符串
    mov  edx,[eax-4]  //获得字符串长度
    test edx,edx      //检查长度
    je   @@Exit      {Length(S) = 0}
    mov  ecx,edx       //保存长度
    Push ecx
    shl  edx,1
    mov  eax,esi
    movzx ecx, word ptr [edi-12] {需要设置CodePage}
    call System.@LStrSetLength //设置新串长度
    mov  eax,esi       //新字符串地址
    Call UniqueString  //产生一个唯一的新字符串，串位置在eax中
    Pop   ecx
  @@SetHex:
    xor  edx,edx       //清空edx
    mov  dl, [edi]     //Str字符串字符
    mov  ebx,edx       //保存当前的字符
    shr  edx,4         //右移4字节，得到高8位
    mov  dl,byte ptr[edx+@@HexChar] //转换成字符
    mov  [eax],dl      //将字符串输入到新建串中存放
    and  ebx,$0F       //获得低8位
    mov  dl,byte ptr[ebx+@@HexChar] //转换成字符
    inc  eax             //移动一个字节,存放低位
    mov  [eax],dl
    inc  edi
    inc  eax
    loop @@SetHex
  @@Exit:
    pop  edi
    pop  esi
    pop  ebx
    ret
  @@HexChar: db '0123456789ABCDEF'
end;
  
function StrToArray(const data:AnsiString; includeLength:Boolean):TLongWordDynArray;   
var
  n, i:LongWord;   
begin  
  n := Length(data);
  if ((n and 3) = 0) then n := n shr 2 else n := (n shr 2) + 1;   
  if (includeLength) then begin  
    setLength(result, n + 1);   
    result[n] := Length(data);   
  end else begin  
    setLength(result, n);   
  end;   
  n := Length(data);   
  for i := 0 to n - 1 do begin  
    result[i shr 2] := result[i shr 2] or (($000000ff and ord(data[i + 1])) shl ((i and 3) shl 3));   
  end;   
end;   
  
function ArrayToStr(const data:TLongWordDynArray; includeLength:Boolean):AnsiString;
var
  n, m, i:LongWord;
begin
  n := Length(data) shl 2;
  if (includeLength) then
  begin
    m := data[Length(data) - 1];
    if (m > n) then
    begin
      result := '';
      exit;
    end
    else
    begin
      n := m;
    end;
  end;
  SetLength(result, n);
  for i := 0 to n - 1 do
  begin
    result[i + 1] := AnsiChar(chr((data[i shr 2] shr ((i and 3) shl 3)) and $ff));
  end;
end;

function XXTeaEncrypt(const v:TLongWordDynArray; var k:TLongWordDynArray):TLongWordDynArray;
var
  n, z, y, sum, e, p, q:LongWord;
  function MX:LongWord;
  begin
    result := (((z shr 5) xor (y shl 2)) + ((y shr 3) xor (z shl 4))) xor ((sum xor y) + (k[p and 3 xor e] xor z));
  end;
begin
  n := Length(v) - 1;
  if (n < 1) then
  begin
    result := v;
    exit;
  end;
  if Length(k) < 4 then
    setLength(k, 4);
  z := v[n];
  y := v[0];
  sum := 0;
  q := 6 + 52 div (n + 1);
  repeat
    inc(sum, delta);
    e := (sum shr 2) and 3;
    for p := 0 to n - 1 do
    begin  
      y := v[p + 1];   
      inc(v[p], mx());   
      z := v[p];   
    end;   
    p := n;   
    y := v[0];   
    inc(v[p], mx());   
    z := v[p];   
    dec(q);   
  until q = 0;   
  result := v;
end;

function XXTeaDecrypt(const v:TLongWordDynArray; var k:TLongWordDynArray):TLongWordDynArray;   
var  
  n, z, y, sum, e, p, q:LongWord;   
  function MX:LongWord;   
  begin  
    result := (((z shr 5) xor (y shl 2)) + ((y shr 3) xor (z shl 4))) xor ((sum xor y) + (k[p and 3 xor e] xor z));   
  end;   
begin  
  n := Length(v) - 1;   
  if (n < 1) then begin  
    result := v;   
    exit;   
  end;   
  if Length(k) < 4 then setLength(k, 4);   
  z := v[n];   
  y := v[0];   
  q := 6 + 52 div (n + 1);   
  sum := q * delta;   
  while (sum <> 0) do begin  
    e := (sum shr 2) and 3;   
    for p := n downto 1 do begin  
      z := v[p - 1];   
      dec(v[p], mx());   
      y := v[p];
    end;
    p := 0;
    z := v[n];
    dec(v[0], mx());
    y := v[0];
    dec(sum, delta);
  end;
  result := v;
end;

//9E 40 C2 51 867F 35 64 2A 6D B1 9C 91 48 9715
//9E 40 C2 51   3F 35 64 2A 6D B1 9C 91 48 3F
function Encrypt(const data:AnsiString; const key:AnsiString):AnsiString;
var
  v, k,c:TLongWordDynArray;
  s : AnsiString;
begin
  if (Length(data) = 0) then exit;
  v := StrToArray(data, true);
  k := StrToArray(key, false);
  s := ArrayToStr(XXTeaEncrypt(v, k), False);
  Result := StrToHex(s);
end;

function Decrypt(const data:AnsiString; const key:AnsiString):AnsiString;
var
  v, k,c:TLongWordDynArray;
  s :AnsiString;
begin
  if (Length(data) = 0) then exit;
  v := StrToArray(data, false);
  k := StrToArray(key, false);
  Result := ArrayToStr(XXTeaDecrypt(v, k), False);
  Result := StrToHex(Result);
end;

function DecryptNoHex(const data:AnsiString; const key:AnsiString):AnsiString;
var
  v, k,c:TLongWordDynArray;
  s :AnsiString;
begin
  if (Length(data) = 0) then exit;
  v := StrToArray(data, false);
  k := StrToArray(key, false);
  Result := ArrayToStr(XXTeaDecrypt(v, k), False);
//  Result := StrToHex(Result);
end;

end.