Network Message Class

[PhantoM]

This is the network message class used in my program Troxy. You'll have to use this if you want to use the Packet Parser Loop (my other post).

Code:

unit netmsg;

interface

uses
  WinSock, Math, SysUtils, Dialogs;

const
  MAXNETMSG_SIZE = 16384;

type TXteaKey = array [1..16] of byte;

type
  TNetMsg = class(TObject)
  public
    amsgsize, adatasize, areadpos : integer;
    amsgbuf : array[1..MAXNETMSG_SIZE] of byte;
    bEncrypt: boolean;
    bProxy  : boolean;
    m_XteaKey : TXteaKey;

    procedure BlockPacket;
    procedure Reset;
    procedure Dump(fn : string);
    procedure Skip(numbytes : word);
    procedure SkipString;

    function isEOP : boolean;
    function ReadSock(Sock : u_int) : boolean;
    function WriteSock(Sock : u_int) : boolean;

    function GetByte : byte;
    function GetU16 : word;
    function GetU32 : cardinal;
    function GetString : string;

    function GetByteOnPos(iPos: integer) : byte;

    procedure PutByte(B : byte);
    procedure PutU16(I : word);
    procedure PutU32(I : cardinal);
    procedure PutString(S : string);

    procedure OverwriteByte(b : byte);
    procedure OverwriteU16(i : word);
    procedure OverwriteU32(i : cardinal);
    procedure OverwriteString(S : string);

    function GetReadPos(): integer;
    procedure SetReadPos(i: integer);
    function GetPacketLength(): integer;

    function toString(): string;

    procedure SetEncryption(enc: boolean; key: TXteaKey);
    procedure SetProxy(proxy: boolean);
    procedure XTeaEncrypt();
    procedure XTeaDecrypt();

    constructor Create; reintroduce; virtual;
    Destructor  Destroy; override;
  end;

implementation

constructor TNetMsg.Create;
begin
inherited Create;
Reset;
end;

destructor TNetMsg.Destroy;
begin
    inherited;
end;

procedure TNetMsg.BlockPacket;
begin
    amsgsize := 0;
    fillchar(amsgbuf,MAXNETMSG_SIZE,0);
end;

procedure TNetMsg.Reset;
begin
    fillchar(amsgbuf,MAXNETMSG_SIZE,0);
    amsgsize := 0;
    adatasize := 0;
    areadpos := 5;
    bEncrypt := false;
    bProxy   := false;
end;

procedure TNetMsg.Dump(fn : string);
var wbuf : array[1..1024] of byte; i, s : integer; f : file of byte;
begin
assignfile(f, fn);
rewrite(f);
s := 0;
repeat
  i := min(1024, amsgsize - s);
  move( (@amsgbuf[s+1])^, (@wbuf[1])^, i);
  blockwrite(f, wbuf, i);
  inc(s, i);
until s = amsgsize + 2;
closefile(f);
end;

procedure TNetMsg.Skip(numbytes : word);
begin
inc(areadpos,numbytes);
end;

procedure TNetMsg.SkipString;
var i : word;
begin
i := getu16;
skip(i);
end;

function TNetMsg.isEOP : boolean;
begin
result := NOT (areadpos < (adatasize+5));
end;

function TNetMsg.ReadSock(Sock : u_int) : boolean;
var t, p : integer; keep : boolean; buf : array[1..1000] of byte;
begin
    keep := true;
    p := 1;
    while keep do
    begin
        if p = 1 then // copia somente 2 bytes para ler apenas uma mensagem
            t := recv(sock, buf, 2, 0)
        else
            t := recv(sock, buf, min(1000, amsgsize - p + 3), 0);

        if (t = SOCKET_ERROR) or (t = 0) then
        begin
            result := false;
            exit;
        end;

        if p = 1 then
            amsgsize := buf[1] or (buf[2] shl 8);

        if t > 0 then
        begin
            move((@buf[1])^, (@amsgbuf[p])^, t);
            inc(p, t);
        end;

        keep := amsgsize <> p - 3;
    end;

    areadpos := 3;
    
    // Stel de encryption in
    if (bEncrypt = true) then
    begin
        XTeaDecrypt();
    end;

    result := true;
end;

function TNetMsg.WriteSock(Sock : u_int) : boolean;
var sent, x, t, i : integer; buf : array[1..1000] of byte;
begin
    result := false;

    if amsgsize = 0 then begin
        result := true;
        exit;
    end;

    // modo I/O
    t := 1;
    //ioctlsocket(Sock,FIONBIO,t);

    // Stel de encryption in
    if (bEncrypt = true) then
    begin
        XTeaEncrypt();
    end;

    sent := 0;
    repeat
        t := min(1000, 2+amsgsize-sent);
        for i := 1 to t do buf[i] := amsgbuf[i+sent];
        x := send(Sock, buf, t, 0);
        if x <= 0 then exit;
        inc(sent, x);
    until (sent = amsgsize+2);

    // modo block
    t := 0;
    //ioctlsocket(Sock,FIONBIO,t);

    result := true;
end;

function TNetMsg.GetByte : byte;
begin
    result := amsgbuf[areadpos];
    inc(areadpos,1);
end;

function TNetMsg.GetU16 : word;
begin
result := word(amsgbuf[areadpos] or
                (amsgbuf[areadpos+1] shl 8));
inc(areadpos,2);
end;

function TNetMsg.GetU32 : cardinal;
begin
result := cardinal(amsgbuf[areadpos] or
                    (amsgbuf[areadpos+1] shl 8) or
                    (amsgbuf[areadpos+2] shl 16) or
                    (amsgbuf[areadpos+3] shl 24));
inc(areadpos,4);
end;

function TNetMsg.GetString : string;
var tam,a : integer;
begin
tam := getu16;

{ temporario, ate eu achar um metodo pra ler }
  setlength(result,tam);
  for a := 1 to tam do
   result[a] := chr(GetByteOnPos(areadpos+a-1));
{ end temp }

//result := copy(amsgbuf, areadpos, tam);
inc(areadpos,tam);
end;

function TNetMsg.GetByteOnPos(iPos: integer) : byte;
begin
    result := amsgbuf[iPos];
end;

procedure TNetMsg.PutByte(b : byte);
begin
amsgbuf[areadpos] := b;
inc(areadpos,1);
inc(amsgsize,1);
inc(adatasize, 1);
end;

procedure TNetMsg.PutU16(i : word);
begin
amsgbuf[areadpos] := byte(i);
amsgbuf[areadpos+1] := byte(i shr 8);
inc(areadpos,2);
inc(amsgsize,2);
inc(adatasize, 2);
end;

procedure TNetMsg.PutU32(i : cardinal);
begin
amsgbuf[areadpos] := byte(i);
amsgbuf[areadpos+1] := byte(i shr 8);
amsgbuf[areadpos+2] := byte(i shr 16);
amsgbuf[areadpos+3] := byte(i shr 24);
inc(areadpos,4);
inc(amsgsize,4);
inc(adatasize, 4);
end;

procedure TNetMsg.PutString(s : string);
var tam,a : integer;
begin
tam := length(s);
putu16(tam);
{ temporario, ate achar um metodo possivel }
for a := 1 to tam do
  amsgbuf[areadpos+a-1] := ord(s[a]);
{ end if }
//insert(s,amsgbuf,areadpos);
inc(areadpos,tam);
inc(amsgsize,tam);
inc(adatasize, tam);
end;

procedure TNetMsg.OverwriteByte(b : byte);
begin
amsgbuf[areadpos] := b;
inc(areadpos,1);
end;

procedure TNetMsg.OverwriteU16(i : word);
begin
amsgbuf[areadpos] := byte(i);
amsgbuf[areadpos+1] := byte(i shr 8);
inc(areadpos,2);
end;

procedure TNetMsg.OverwriteU32(i : cardinal);
begin
amsgbuf[areadpos] := byte(i);
amsgbuf[areadpos+1] := byte(i shr 8);
amsgbuf[areadpos+2] := byte(i shr 16);
amsgbuf[areadpos+3] := byte(i shr 24);
inc(areadpos,4);
end;

procedure TNetMsg.OverwriteString(s : string);
var tam,a : integer;
begin
  tam := length(s);
  putu16(tam);

  for a := 1 to tam do
      amsgbuf[areadpos+a-1] := ord(s[a]);
end;

function TNetMsg.GetReadPos(): integer;
begin
    result := areadpos;
end;

procedure TNetMsg.SetReadPos(i: integer);
begin
    areadpos := i;
end;

function TNetMsg.GetPacketLength(): integer;
begin
    result := amsgsize+4;
end;

function TNetMsg.toString(): string;
var
    i: integer;
begin
    result := '';

    for i := 1 to GetPacketLength() do
    begin
        result := result + inttohex(amsgbuf[i], 2) + ' ';
    end;
end;

[PhantoM]

Sorry, it didnt fit in 1 post, and somehow I couldnt upload it.

Code:

procedure TNetMsg.SetEncryption(enc: boolean; key: TXteaKey);
begin
    bEncrypt := enc;
    m_XteaKey  := key;
end;

procedure TNetMsg.SetProxy(proxy: boolean);
begin
    bProxy := proxy;
end;

// Encrypt de packet
procedure TNetMsg.XTeaEncrypt();
var
    I: integer;
    S: Int64;
    K: array[0..3] of LongWord;
    V: array[0..1] of LongWord;
    readPos: LongWord;
    Delta: LongWord;
    n: integer;
begin
    // Zet de key erin
    K[0] := cardinal(m_XteaKey[1] or (m_XteaKey[2] shl 8) or (m_XteaKey[3] shl 16) or (m_XteaKey[4] shl 24));
    K[1] := cardinal(m_XteaKey[5] or (m_XteaKey[6] shl 8) or (m_XteaKey[7] shl 16) or (m_XteaKey[8] shl 24));
    K[2] := cardinal(m_XteaKey[9] or (m_XteaKey[10] shl 8) or (m_XteaKey[11] shl 16) or (m_XteaKey[12] shl 24));
    K[3] := cardinal(m_XteaKey[13] or (m_XteaKey[14] shl 8) or (m_XteaKey[15] shl 16) or (m_XteaKey[16] shl 24));

    // Zorg ervoor dat de packet grootte goed komt
    if (bProxy = false) then
    begin
        // Als de data zelf gemaakt is, zet de grootte erin
        amsgbuf[3] := byte(amsgsize);
        amsgbuf[4] := byte(amsgsize shr 8);
        
        if (((amsgsize+2) mod 8) > 0) then
        begin
            n := 8 - ((amsgsize+2) mod 8);
            for i := 0 to n do
                amsgbuf[areadpos+i] := $00;

            amsgsize := amsgsize + n;
        end;
    end;

    readPos := 3;
    while(readPos < amsgsize) do
    begin
        Delta := $61C88647;
        S := $0;
        V[0] := cardinal(amsgbuf[readpos + 0] or
                        (amsgbuf[readpos + 1] shl 8) or
                        (amsgbuf[readpos + 2] shl 16) or
                        (amsgbuf[readpos + 3] shl 24));
        V[1] := cardinal(amsgbuf[readpos + 4] or
                        (amsgbuf[readpos + 5] shl 8) or
                        (amsgbuf[readpos + 6] shl 16) or
                        (amsgbuf[readpos + 7] shl 24));

        for I := 0 to 31 do
        begin
            Inc(V[0], ((V[1] shl 4 xor V[1] shr 5) + V[1]) xor (S + K[S and 3]));
            Dec(S, Delta);
            Inc(V[1], ((V[0] shl 4 xor V[0] shr 5) + V[0]) xor (S + K[S shr 11 and 3]));
        end;

        // Zet de zooi terug in de packet
        amsgbuf[readpos+0] := byte(V[0]) ;
        amsgbuf[readpos+1] := byte(V[0] shr 8);
        amsgbuf[readpos+2] := byte(V[0] shr 16);
        amsgbuf[readpos+3] := byte(V[0] shr 24);

        amsgbuf[readpos+4] := byte(V[1]) ;
        amsgbuf[readpos+5] := byte(V[1] shr 8);
        amsgbuf[readpos+6] := byte(V[1] shr 16);
        amsgbuf[readpos+7] := byte(V[1] shr 24);

        readPos := readPos+8;
    end;

    // Zet de packetlength erin, als de data zelf gemaakt is
    if (bProxy = false) then
    begin
        amsgsize := amsgsize + 2;
        amsgbuf[1] := byte(amsgsize);
        amsgbuf[2] := byte(amsgsize shr 8);
    end;
end;

// Decrypt de packet
procedure TNetMsg.XTeaDecrypt();
var
    I: LongWord;
    S: Int64;
    K: array[0..3] of LongWord;
    V: array[0..1] of LongWord;
    readPos: LongWord;
    Delta: LongWord;
begin
    // Make the key the right size
    K[0] := cardinal(m_XteaKey[1] or (m_XteaKey[2] shl 8) or (m_XteaKey[3] shl 16) or (m_XteaKey[4] shl 24));
    K[1] := cardinal(m_XteaKey[5] or (m_XteaKey[6] shl 8) or (m_XteaKey[7] shl 16) or (m_XteaKey[8] shl 24));
    K[2] := cardinal(m_XteaKey[9] or (m_XteaKey[10] shl 8) or (m_XteaKey[11] shl 16) or (m_XteaKey[12] shl 24));
    K[3] := cardinal(m_XteaKey[13] or (m_XteaKey[14] shl 8) or (m_XteaKey[15] shl 16) or (m_XteaKey[16] shl 24));

    readPos := 3;
    while(readPos < amsgsize) do
    begin
        Delta := $61C88647;
        S := $C6EF3720;
        V[0] := cardinal(amsgbuf[readpos + 0] or
                        (amsgbuf[readpos + 1] shl 8) or
                        (amsgbuf[readpos + 2] shl 16) or
                        (amsgbuf[readpos + 3] shl 24));
        V[1] := cardinal(amsgbuf[readpos + 4] or
                        (amsgbuf[readpos + 5] shl 8) or
                        (amsgbuf[readpos + 6] shl 16) or
                        (amsgbuf[readpos + 7] shl 24));

        for I := 0 to 31 do
        begin
            Dec(V[1], ((V[0] shl 4 xor V[0] shr 5) + V[0]) xor (S + K[S shr 11 and 3]));
            Inc(S, Delta);
            Dec(V[0], ((V[1] shl 4 xor V[1] shr 5) + V[1]) xor (S + K[S and 3]));
        end;

        // Put the stuff back in the packet
        amsgbuf[readpos+0] := byte(V[0]) ;
        amsgbuf[readpos+1] := byte(V[0] shr 8);
        amsgbuf[readpos+2] := byte(V[0] shr 16);
        amsgbuf[readpos+3] := byte(V[0] shr 24);

        amsgbuf[readpos+4] := byte(V[1]) ;
        amsgbuf[readpos+5] := byte(V[1] shr 8);
        amsgbuf[readpos+6] := byte(V[1] shr 16);
        amsgbuf[readpos+7] := byte(V[1] shr 24);

        readPos := readPos+8;
    end;

    // Read the data
    adatasize := GetU16;
end;

end.

[OsQu]

Moments like that I wonder why I didn't choose Delphi..
Nice!

[vapen]

this looks really nice but where can i find the unit modTibiaConstants?

[PhantoM]

I've edited the first post so it doesnt use the unit modTibiaConstants anymore. That was just needed for this line:

type TXteaKey = array [1..16] of byte;

[MeNi]

I want to filter packets (something like this: )

[TIBIA] --> (msg: 'test') --> [PROXY (checking, if msg contains 'lol' stop or change packet)] --> (msg: 'test') --> [SERVER]

[TIBIA] --> (msg: 'lol') --> [PROXY (checking, if msg contains 'lol' stop or change packet)] -X-> [SERVER]

[TIBIA] --> (msg: 'lol') --> [PROXY (checking, if msg contains 'lol' stop or change packet)] --> (msg: 'somethingelse')--> [SERVER]


and packets from server to tibia client. How should i do that?


I am using this proxy code as a base : http://tpforums.org/forum/showthread.php?t=1030

[Pro-grammer]

Bump.

For what is this?, does it works?. I'll read code right now.

[DarkstaR]

If you don't know what it is, chances are you don't need it.

[Pro-grammer]

(02-21-2010 10:45 PM)DarkstaR Wrote:  If you don't know what it is, chances are you don't need it.

yes thats kind of true, but am making my bot. So am looking all forum, and google looking how to do alot of usefull things to my bot.

[DarkstaR]

Its for constructing packets.