L2Stream

unit L2Stream;

interface

uses
  Windows, Messages, Classes, SysUtils, Math;

type
  TL2Stream = class;

  TL2Packet = class(TObject)
  private
    FCursor: Cardinal;
    FData: RawByteString;

    procedure SetData(Data: RawByteString);
    function GetId: Byte;
    procedure SetId(Id: Byte);
  public
    property Id: Byte read GetId write SetId;
    property Data: RawByteString read FData write SetData;
    property Cursor: Cardinal read FCursor write FCursor;

    procedure WriteB(Buf: Pointer; Size: Integer; Index: Integer = 0);
    procedure WriteC(Value: Byte; Index: Integer = 0);
    procedure WriteH(Value: Word; Index: Integer = 0);
    procedure WriteD(Value: Integer; Index: Integer = 0);
    procedure WriteQ(Value: Int64; Index: Integer = 0);
    procedure WriteF(Value: Double; Index: Integer = 0);
    procedure WriteS(Value: string; Index: Integer = 0);
    function ReadC: Byte;
    function ReadH: Word;
    function ReadD: Integer;
    function ReadQ: Int64;
    function ReadF: Double;
    function ReadS: string;
    function ReadB(Size: Integer): RawByteString;
    function EndOfPacket(RaiseException: Boolean = True): Boolean;
    procedure Skip(Fields: AnsiString); overload;
    procedure Skip(Bytes: Integer); overload;
    procedure Clear;

    constructor Create;
    destructor Destroy; override;
  end;

  TL2PacketEvent = procedure(Packet: TL2Packet; Sender: TL2Stream) of object;
  TL2SendEvent = procedure(Data: RawByteString) of object;

  TL2Key = array [0..15] of Byte;

  TL2Stream = class(TObject)
  private
    FEmptyKey: Boolean;
    FRecvBuf: RawByteString;
    RKey, SKey: TL2Key;
    Packet: TL2Packet;

    procedure DecryptPacket(var Packet: RawByteString; var Key: TL2Key);
    procedure EncryptPacket(var Packet: RawByteString; var Key: TL2Key);

  public
    PacketEvent: TL2PacketEvent;
    SendEvent: TL2SendEvent;

    property EmptyKey: Boolean read FEmptyKey;

    procedure Reset;
    function SetKey(Key: RawByteString): Boolean;
    procedure Send(Data: RawByteString);
    function ProcessData(const Data: RawByteString): Boolean;

    constructor Create;
    destructor Destroy; override;
  end;

implementation

constructor TL2Packet.Create;
begin
  inherited Create;

  Clear;
end;

destructor TL2Packet.Destroy;
begin
  // Nothing

  inherited Destroy;
end;

procedure TL2Packet.Clear;
begin
  SetData(#$00);
end;

procedure TL2Packet.WriteB(Buf: Pointer; Size: Integer; Index: Integer = 0);
var
  L, MinLen: Integer;
begin
  L := Length(FData);
  if Index < 2 then Index := L + 1;
  MinLen := Index + Size - 1;
  if L < MinLen then SetLength(FData, MinLen);
  Move(Buf^, FData[Index], Size);
end;

procedure TL2Packet.WriteC(Value: Byte; Index: Integer = 0);
begin
  WriteB(@Value, 1, Index);
end;

procedure TL2Packet.WriteH(Value: Word; Index: Integer = 0);
begin
  WriteB(@Value, 2, Index);
end;

procedure TL2Packet.WriteD(Value: Integer; Index: Integer = 0);
begin
  WriteB(@Value, 4, Index);
end;

procedure TL2Packet.WriteQ(Value: Int64; Index: Integer = 0);
begin
  WriteB(@Value, 8, Index);
end;

procedure TL2Packet.WriteF(Value: Double; Index: Integer = 0);
begin
  WriteB(@Value, 8, Index);
end;

procedure TL2Packet.WriteS(Value: string; Index: Integer = 0);
var
  WS: WideString;
  S: RawByteString;
  L: Integer;
begin
  WS := Value;
  L := Length(WS) * 2;
  SetLength(S, L);
  if L > 0 then Move(WS[1], S[1], L);
  S := S + #0#0;
  WriteB(@S[1], L + 2, Index);
end;

function TL2Packet.ReadC: Byte;
begin
  if FCursor < 2 then FCursor := 2;
  if Length(FData) < FCursor then raise Exception.Create('Error in ReadC!');
  Result := Ord(FData[FCursor]);
  Inc(FCursor);
end;

function TL2Packet.ReadH: Word;
begin
  if FCursor < 2 then FCursor := 2;
  if Length(FData) < FCursor + 1 then raise Exception.Create('Error in ReadH!');
  Move(FData[FCursor], Result, 2);
  Inc(FCursor, 2);
end;

function TL2Packet.ReadD: Integer;
begin
  if FCursor < 2 then FCursor := 2;
  if Length(FData) < FCursor + 3 then raise Exception.Create('Error in ReadD!');
  Move(FData[FCursor], Result, 4);
  Inc(FCursor, 4);
end;

function TL2Packet.ReadQ: Int64;
begin
  if FCursor < 2 then FCursor := 2;
  if Length(FData) < FCursor + 7 then raise Exception.Create('Error in ReadQ!');
  Move(FData[FCursor], Result, 8);
  Inc(FCursor, 8);
end;

function TL2Packet.ReadF: Double;
begin
  if FCursor < 2 then FCursor := 2;
  if Length(FData) < FCursor + 7 then raise Exception.Create('Error in ReadF!');
  Move(FData[FCursor], Result, 8);
  Inc(FCursor, 8);
end;

function TL2Packet.ReadB(Size: Integer): RawByteString;
begin
  if FCursor < 2 then FCursor := 2;
  if Size < 1 then raise Exception.Create('Error in ReadB!');
  if Length(FData) < FCursor + Size - 1 then raise Exception.Create('Error in ReadB!');
  SetLength(Result, Size);
  Move(FData[FCursor], Result[1], Size);
  Inc(FCursor, Size);
end;

function TL2Packet.ReadS: string;
var
  I, Len, N: Integer;
  WS: WideString;
begin
  if FCursor < 2 then FCursor := 2;
  Result := '';
  I := FCursor;
  Len := Length(FData);
  while True do
    begin
      if I + 1 > Len then
        begin
          FCursor := Len + 1;
          raise Exception.Create('Error in ReadS!');
          Exit;
        end;
      if (FData[I] = #0) and (FData[I + 1] = #0) then
        begin
          N := I - FCursor;
          SetLength(WS, N div 2);
          Move(FData[FCursor], WS[1], N);
          Result := WS;
          FCursor := I + 2;
          Exit;
        end;
      Inc(I, 2);
    end;
end;

function TL2Packet.EndOfPacket(RaiseException: Boolean = True): Boolean;
var
  N: Integer;
begin
  N := Length(FData) + 1 - FCursor;
  Result := N = 0;
  if (not Result) and RaiseException then raise Exception.Create(Format('EndOfPacket expected (%d)!', [N]));
end;

procedure TL2Packet.Skip(Bytes: Integer);
begin
  if Bytes < 1 then raise Exception.Create('Error in Skip!');
  Inc(FCursor, Bytes);
end;

procedure TL2Packet.Skip(Fields: AnsiString);
var
  I, FI, N: Integer;
  C: AnsiChar;
  T: AnsiString;
begin
  Fields := AnsiString(LowerCase(String(Fields)));
  T := '';
  for FI := 1 to Length(Fields) do
    begin
      C := Fields[FI];
      if C in ['0'..'9'] then
        begin
          T := T + C;
          Continue;
        end;

      if T <> '' then
        begin
          N := StrToInt(String(T));
          T := '';
          if N < 1 then raise Exception.Create('Invalid amount!');
        end
      else
        begin
          N := 1;
        end;

      case C of
        'c': Inc(FCursor, 1 * N);
        'h': Inc(FCursor, 2 * N);
        'd': Inc(FCursor, 4 * N);
        'q': Inc(FCursor, 8 * N);
        'f': Inc(FCursor, 8 * N);
        's': for I := 1 to N do ReadS;
      end;
    end;
end;

procedure TL2Packet.SetData(Data: RawByteString);
begin
  if Data = '' then Data := #$00;
  FData := Data;
  FCursor := 2;
end;

function TL2Packet.GetId: Byte;
begin
  Result := Ord(FData[1]);
end;

procedure TL2Packet.SetId(Id: Byte);
begin
  FData[1] := AnsiChar(Id);
end;

constructor TL2Stream.Create;
begin
  inherited Create;

  Packet := TL2Packet.Create;
  Reset;
end;

destructor TL2Stream.Destroy;
begin
  Packet.Free;

  inherited Destroy;
end;

procedure TL2Stream.Reset;
begin
  FRecvBuf := '';
  SetKey('');
end;

function TL2Stream.SetKey(Key: RawByteString): Boolean;
var
  L2Key: TL2Key;
  I: Integer;
begin
  if Length(Key) <> Length(L2Key) then
    begin
      FEmptyKey := True;
      Exit(False);
    end;

  for I := 1 to Length(Key) do L2Key[I - 1] := Byte(Key[I]);
  RKey := L2Key;
  SKey := L2Key;
  FEmptyKey := False;
  Result := True;
end;

procedure TL2Stream.EncryptPacket(var Packet: RawByteString; var Key: TL2Key);
var
  I, L: Integer;
  K: Byte;
  PB: PByte;
begin
  if EmptyKey then Exit;

  L := Length(Packet);
  if L = 0 then Exit;

  K := 0;
  PB := @Packet[1];
  for i := 0 to L - 1 do
    begin
      PB^ := PB^ xor Key[I and 15] xor K;
      K := PB^;
      Inc(PB);
    end;

  Inc(PInteger(@Key[8])^, L);
end;

procedure TL2Stream.DecryptPacket(var Packet: RawByteString; var Key: TL2Key);
var
  I, L: Integer;
  T, K: Byte;
  PB: PByte;
begin
  if EmptyKey then Exit;

  L := Length(Packet);
  if L = 0 then Exit;

  K := 0;
  PB := @Packet[1];
  for i := 0 to L - 1 do
    begin
      T := PB^;
      PB^ := PB^ xor Key[I and 15] xor K;
      K := T;

      Inc(PB);
    end;

  Inc(PInteger(@Key[8])^, L);
end;

procedure TL2Stream.Send(Data: RawByteString);
var
  L, W: Word;
  S: RawByteString;
begin
  if Length(Data) = 0 then Exit;

  EncryptPacket(Data, SKey);
  if not Assigned(SendEvent) then Exit;

  L := Length(Data);
  W := L + 2;
  SetLength(S, W);
  Move(W, S[1], 2);
  Move(Data[1], S[3], L);

  SendEvent(S);
end;

function TL2Stream.ProcessData(const Data: RawByteString): Boolean;
var
  S: RawByteString;
  Size: Word;
  L, I: Integer;
begin
  FRecvBuf := FRecvBuf + Data;
  L := Length(FRecvBuf);
  I := 1;
  while L > 2 do
    begin
      Move(FRecvBuf[I], Size, 2);
      if Size < 3 then Exit(False);
      if L < Size then Break;

      S := Copy(FRecvBuf, I + 2, Size - 2);
      DecryptPacket(S, RKey);

      if Assigned(PacketEvent) then
        begin
          Packet.Data := S;
          PacketEvent(Packet, Self);
        end;

      Inc(I, Size);
      Dec(L, Size);
    end;

  if I > 1 then
    begin
      Delete(FRecvBuf, 1, I - 1);
    end;

  Result := True;
end;

end.