Someone

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
 TLong2 = array[0..1] of Longword;

 TTeaKey = array[0..3] of Longword;    //128-bit =  16-byte

 Tbyte8 = array[0..7] of byte;


Const
  Delta: longword = $9e3779b9;
  Lim32 = 2147483648; // MaxInt32 +1
  xTeaKey = 1337133713371337;

  adr_TeaKey = $7637AC;

var
  Form2: TForm2;
  Tibia_HWND:HWND;
  pid,phandle:longint;
  NB:longword;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
Tibia_HWND := Findwindow('tibiaclient', nil);
if Tibia_HWND = 0 then
begin
 MessageBox(0, 'Please open Tibia.', 'Error', MB_ICONERROR);
 Application.Terminate;
end;
GetWindowThreadProcessId(Tibia_HWND, @PID);
PHandle:=OpenProcess(PROCESS_ALL_ACCESS, False, PID);
end;

function GetKey():TTeaKey;
Begin
   ReadProcessMemory(PHandle, ptr(adr_TeaKey), @Result, 16, nb);
End;

procedure XTeaEncrypt(var data: TLong2; const key: TTeaKey; N: Longword = 32);
var
  y,z,sum,limit: Longword;
begin
  y:=data[0];
  z:=data[1];
  sum:=0;
  limit := Delta*N;
  while sum <> limit do
  begin

//    inc(y,((z shl 4) xor (z shr 5)) xor (sum+key[sum and 3]));
    inc(y,(((z shl 4) xor (z shr 5)) + z) xor (sum+key[sum and 3]));
    inc(sum,Delta);
//    inc(z,((y shl 4) xor (y shr 5)) xor (sum+key[(sum shr 11) and 3]));
    inc(z,(((y shl 4) xor (y shr 5)) + y) xor (sum+key[(sum shr 11) and 3]));
  end;
  data[0]:=y;
  data[1]:=z
end;

procedure XTeaDecrypt(var data: TLong2; const key: TTeaKey; N: Longword = 32);
var
  y,z,sum: Longword;
begin
  y:=data[0];
  z:=data[1];
  sum:=Delta*N;
  while sum <> 0 do
  begin

//    dec(z,((y shl 4) xor (y shr 5)) xor (sum+key[(sum shr 11) and 3]));
    dec(z,(((y shl 4) xor (y shr 5)) + y) xor (sum+key[(sum shr 11) and 3]));
    dec(sum,Delta);
//    dec(y,((z shl 4) xor (z shr 5)) xor (sum+key[sum and 3]));
    dec(y,(((z shl 4) xor (z shr 5)) + z) xor (sum+key[sum and 3]));
  end;
  data[0]:=y;
  data[1]:=z
end;

procedure EncryptPacket(var Packet: array of Byte; Length: Integer); //szyfrowanie
var
  i, j: integer;
  data: TLong2;
  Key: TTeaKey;
begin
  Key := GetKey;
  i := 0;
  while i <= Length-8 do
  begin
    for j := 0 to 7 do
      TByte8(data)[j] := Packet[i+j+2];
    XTeaEncrypt(data, Key);
    for j := 0 to 7 do
      Packet[i+j+2] := TByte8(data)[j];
    inc(i,8);
  end;
end;

procedure DecryptPacket(var Packet: array of Byte; Length: Integer);  //odszyfrowywanie
var
  i, j: integer;
  data: TLong2;
  Key: TTeaKey;
begin
  Key := GetKey;        //klucz
  i := 0;               // i jest ronw 0
  while i <= Length-8 do    // dopki i <= dlugosc - 8 wykonuj petle
  begin
    for j := 0 to 7 do     //dla j = 0 do7 rob(8powtorzen)
      TByte8(data)[j] := Packet[i+j+2];  // przypisane tablicy 8bajtow bez 2 pierwszych bo to dlugosc
    XTeaDecrypt(data, Key);
    for j := 0 to 7 do
      Packet[i+j+2] := TByte8(data)[j];
    inc(i,8);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
 Buffer : Array [1..1024] of byte;
 i : byte;
begin
 Memo1.Clear;

 Buffer[1] := $01;
 Buffer[2] := $00;
 Buffer[3] := $65;

 EncryptPacket(Buffer, 3); //szyfrowanie

 for i := 1 to 30 do
  begin
   Memo1.SelText := Memo1.SelText+inttostr(Buffer[i])+' ';
  end;
end;

end.