Pastebin

{(
 )) MEOW.dpr
((    Mini EO? WOW!
 ))
((  A simple 65k EO server created by Sordie out of pure bordem
 )}

program MEOW;

{$APPTYPE CONSOLE}
{$DEFINE SILENTUNHANDLED}

uses
  Windows, WinSock;

const
  Range = 10;

  PacketFamilyRaw        = 255;
  PacketFamilyConnection = 1;
  PacketFamilyGameData   = 5;
  PacketFamilyWalk       = 6;
  PacketFamilyFace       = 7;
  PacketFamilyTalk       = 18;
  PacketFamilyPlayers    = 22;
  PacketFamilyRequest    = 27;

  PacketActionRaw      = 255;
  PacketActionRequest  = 1;
  PacketActionAccept   = 2;
  PacketActionReply    = 3;
  PacketActionRemove   = 4;
  PacketActionAgree    = 5;
  PacketActionPlayer   = 8;
  PacketActionMessage  = 15;
  PacketActionSpecial  = 16;
  PacketActionAdmin    = 17;
  PacketActionReport   = 21;

  RequiredVersion: array[0..2] of Byte = (0, 0, 28);

  FileIDMap   = 1;
  FileIDItem  = 2;
  FileIDNPC   = 3;
  FileIDSpell = 4;
  FileIDClass = 5;

  DirectionDown  = 0;
  DirectionLeft  = 1;
  DirectionUp    = 2;
  DirectionRight = 3;

type
  TPacket = packed record
    Family: Byte;
    Action: Byte;
    Data:   AnsiString;

    procedure SetID(AFamily, AAction: Byte);

    procedure Reset; inline;

    procedure Discard(Count: Integer = 1); inline;

    procedure AddByte(v: Byte);              inline;
    procedure AddInt1(v: Byte);              inline;
    procedure AddInt2(v: Word);              inline;
    procedure AddInt3(v: Cardinal);          inline;
    procedure AddInt4(v: Cardinal);          inline;
    procedure AddBreakString(v: AnsiString); inline;
    procedure AddString     (v: AnsiString); inline;

    function GetByte: Byte;
    function GetInt1: Byte;
    function GetInt2: Word;
    function GetInt3: Cardinal;
    function GetInt4: Cardinal;
    function GetBreakString:               AnsiString;
    function GetString(Len: Integer = -1): AnsiString;
  end;{TPacket}

  TGameData = class
    class function DataID: Byte; virtual; abstract;

    var Data: AnsiString;
    var CRC:  array[0..3] of Byte;
    var Len: array[0..1]  of Byte;

    constructor Create(FileName: String);
  end;{TGameData}

  TItemData = class(TGameData)
    class function DataID: Byte; override;
  end;{TItemData}

  TNPCData = class(TGameData)
    class function DataID: Byte; override;
  end;{TNPCData}

  TSpellData = class(TGameData)
    class function DataID: Byte; override;
  end;{TSpellData}

  TClassData = class(TGameData)
    class function DataID: Byte; override;
  end;{TClassData}

  TMapData = class(TGameData)
    class function DataID: Byte; override;
  end;{TMapData}

  TSession = class
    class var Sessions:     array of TSession;
    class var SessionsLock: TRTLCriticalSection;

    class constructor Create;
    class destructor  Destroy;

    class procedure ThreadSafe;     inline;
    class procedure ThreadSafeDone; inline;

    class function GetSession(ID: Cardinal): TSession;

    class procedure SendAll(Packet: TPacket; Ignore: TSession = nil; Raw: Boolean = False);

    var Socket:      TSocket;
    var ThreadID:    Cardinal;
    var ID:          Cardinal;

    var Buffer:      AnsiString;
    var PacketIn:    TPacket;
    var PacketOut:   TPacket;

    var Initialized: Boolean;

    var IPStr:     AnsiString;
    var IPInt:     Integer;
    var HDDSerial: AnsiString;

    var Name: AnsiString;

    var X, Y, D: Integer;

    constructor Create(ASocket: TSocket);
    destructor  Destroy; override;

    procedure Log(S: String);

    function Index: Integer;

    procedure Send       (Packet: TPacket; Raw: Boolean = False);
    procedure SendInRange(Packet: TPacket; Raw: Boolean = False);

    procedure SendGameData(Data: TGameData);
    procedure SendGameState;

    procedure BuildCharacterPacket(var Packet: TPacket);

    function Walk(Direction: Integer; Admin: Boolean = False; Ghost: Boolean = False): Boolean;
    function Face(Direction: Integer): Boolean;
    function Say(Text: AnsiString): Boolean;

    function Execute: Boolean;

    procedure DefaultHandler(var Param); override;

    procedure HandleRaw       (var Param); message PacketFamilyRaw;
    procedure HandleConnection(var Param); message PacketFamilyConnection;
    procedure HandleGameData  (var Param); message PacketFamilyGameData;
    procedure HandleWalk      (var Param); message PacketFamilyWalk;
    procedure HandleFace      (var Param); message PacketFamilyFace;
    procedure HandleRequest   (var Param); message PacketFamilyRequest;
    procedure HandleTalk      (var Param); message PacketFamilyTalk;
  end;{TSession}

const
  RecieveKey = 8;
  SendKey    = 10;

  EOInt1Max = 253;
  EOInt2Max = 64009;
  EOInt3Max = 16194277;

var
  ItemData:  TItemData;
  NPCData:   TNPCData;
  SpellData: TSpellData;
  ClassData: TClassData;
  MapData:   TMapData;

function Str(i: Integer): String;
var
  x: Integer;
  f: Boolean;
  c: Char;
  v: Integer;
begin
  v := i;
  if v = 0 then exit('0');

  if v < 0 then
  begin
    Result := '-';
    v := abs(v);
  end{if v < 0}
  else Result := '';

  f := True;
  x := 1000000000;

  repeat
    c := #48;

    while v >= x do
    begin
      c := chr(Byte(c) + 1);
      v := v - x;
    end;{while v >= x}

    if f and (c <> #48) then f := False;
    if not f then Result := Result + c;
    x := x div 10;
  until x = 0;
end;{Str}

function Int(s: String; Default: Integer = 0): Integer;
var
  i: Integer;
  n: Boolean;
  w: String;
begin
  if length(s) = 0 then exit(Default);

  n := s[1] = '-';
  if n or (s[1] = '+') then w := copy(s, 2, length(s)) else w := s;

  if length(w) = 0 then exit(Default);

  for i := 1 to length(w) do
    if pos(w[i], '0123456789') = 0 then exit(Default);

  Result := 0;

  for i := 1 to length(w) do
  begin
    Result := Result * 10;
    Result := Result + ord(w[i]) - 48;
  end;{for i}

  if n then Result := -Result;
end;{Int}

function PackEOInt(b1: Byte = 0; b2: Byte = 0; b3: Byte = 0; b4: Byte = 0): Cardinal;
begin
  if b1 = 254 then b1 := 0 else if b1 > 0 then dec(b1);
  if b2 = 254 then b2 := 0 else if b2 > 0 then dec(b2);
  if b3 = 254 then b3 := 0 else if b3 > 0 then dec(b3);
  if b4 = 254 then b4 := 0 else if b4 > 0 then dec(b4);

  Result := (b4 * EOInt3Max) + (b3 * EOInt2Max) + (b2 * EOInt1Max) + b1;
end;{PackEOInt}

function UnpackEOInt(Num: Cardinal): AnsiString;
var
  i: Cardinal;
begin
  Result := #254#254#254#254;

  i := Num;

  if i >= EOInt3Max then
  begin
    Result[4] := AnsiChar(Num div EOInt3Max + 1);
    Num := Num mod EOInt3Max;
  end;{if i >= EOInt3Max}

  if i >= EOInt2Max then
  begin
    Result[3] := AnsiChar(Num div EOInt2Max + 1);
    Num := Num mod EOInt2Max;
  end;{if i >= EOInt2Max}

  if i >= EOInt1Max then
  begin
    Result[2] := AnsiChar(Num div EOInt1Max + 1);
    Num := Num mod EOInt1Max;
  end;{if i >= EOInt3Max}

  Result[1] := AnsiChar(Num + 1);
end;{UnpackEOInt}

function FoldData(Str: AnsiString; Key: Byte): AnsiString;
var
  i, j:   Integer;
  c:      Byte;
  Buffer: AnsiString;
begin
  if Key = 0 then exit(Str);

  Result := '';
  Buffer := '';

  for i := 1 to length(Str) do
  begin
    c := ord(Str[i]);
    if (c mod Key) = 0 then Buffer := Buffer + AnsiChar(c)

    else
    begin
      if length(Buffer) > 0 then
      begin
        for j := length(Buffer) downto 1 do
          Result := Result + Buffer[j];

        Buffer := '';
      end;{if length(Buffer)}

      Result := Result + AnsiChar(c);
    end;{else}
  end;{for i}

  if length(Buffer) > 0 then
    for j := length(Buffer) downto 1 do
      Result := Result + Buffer[j];
end;{FoldData}

procedure TPacket.SetID(AFamily, AAction: Byte);
begin
  Family := AFamily;
  Action := AAction;
end;{TPacket.SetID}

procedure TPacket.Reset;
begin
  Data := '';
end;{TPacket.Reset}

procedure TPacket.Discard;
begin
  Data := copy(Data, Count + 1, length(Data));
end;{TPacket.Discard}

procedure TPacket.AddByte;
begin
  Data := Data + AnsiChar(v);
end;{TPacket.AddByte}

procedure TPacket.AddInt1;
begin
  Data := Data + UnpackEOInt(v)[1];
end;{{TPacket.AddInt1}

procedure TPacket.AddInt2;
begin
  Data := Data + copy(UnpackEOInt(v), 1, 2);
end;{{TPacket.AddInt2}

procedure TPacket.AddInt3;
begin
  Data := Data + copy(UnpackEOInt(v), 1, 3);
end;{TPacket.AddInt3}

procedure TPacket.AddInt4;
begin
  Data := Data + UnpackEOInt(v);
end;{TPacket.AddInt4}

procedure TPacket.AddBreakString;
begin
  Data := Data + v + #$FF;
end;{TPacket.AddBreakString}

procedure TPacket.AddString;
begin
  Data := Data + v;
end;{TPacket.AddString}

function TPacket.GetByte;
begin
  if length(Data) = 0 then exit(0);

  Result := ord(Data[1]);
  Data   := copy(Data, 2, length(Data));
end;{TPacket.GetByte}

function TPacket.GetInt1;
begin
  if length(Data) = 0 then exit(0);

  Result := PackEOInt(ord(Data[1]));
  Data  := copy(Data, 2, length(Data));
end;{TPacket.GetInt1}

function TPacket.GetInt2;
begin
  if length(Data) = 0 then exit(0);
  if length(Data) < 2 then exit(GetInt1);

  Result := PackEOInt(ord(Data[1]), ord(Data[2]));
  Data   := copy(Data, 3, length(Data));
end;{TPacket.GetInt2}

function TPacket.GetInt3;
begin
  if length(Data) = 0 then exit(0);
  if length(Data) < 2 then exit(GetInt1);
  if length(Data) < 3 then exit(GetInt2);

  Result := PackEOInt(ord(Data[1]), ord(Data[2]), ord(Data[3]));
  Data   := copy(Data, 4, length(Data));
end;{TPacket.GetInt3}

function TPacket.GetInt4;
begin
  if length(Data) = 0 then exit(0);
  if length(Data) < 2 then exit(GetInt1);
  if length(Data) < 3 then exit(GetInt2);
  if length(Data) < 4 then exit(GetInt3);

  Result := PackEOInt(ord(Data[1]), ord(Data[2]), ord(Data[3]), ord(Data[4]));
  Data   := copy(Data, 5, length(Data));
end;{TPacketGetInt4}

function TPacket.GetBreakString;
var
  i: Integer;
begin
  for i := 1 to length(Data) do
    if Data[i] = #$FF then break;

  Result := copy(Data, 1, i - 1);
  Data   := copy(Data, i + 1, length(Data));
end;{TPacket.GetBreakString}

function TPacket.GetString;
begin
  if Len = -1 then
  begin
    Result := Data;
    Data  := '';
  end{if Len = -1}
  else
  begin
    Result := copy(Data, 1, Len);
    Data   := copy(Data, Len + 1, length(Data));
  end;{else}
end;{TPacket.GetString}

constructor TGameData.Create;
var
  l: Cardinal;
  f: THandle;
begin
  inherited Create;

  f := CreateFile(PChar(FileName), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if f = 0 then exit;

  try
    l := SetFilePointer(f, 0, nil, FILE_END);
    if l = Cardinal(-1) then exit;
    SetLength(Data, l);

    SetFilePointer(f, 0, nil, FILE_BEGIN);
    ReadFile(f, Data[1], length(Data), l, nil);

    CRC[0] := ord(Data[4]);
    CRC[1] := ord(Data[5]);
    CRC[2] := ord(Data[6]);
    CRC[3] := ord(Data[7]);

    Len[0] := ord(Data[8]);
    Len[1] := ord(Data[9]);
  finally
    CloseHandle(f);
  end;{try...finally}
end;{TGameData.Load}

class function TItemData.DataID;
begin
  Result := 5;
end;{TItemData.DataID}

class function TNPCData.DataID;
begin
  Result := 6;
end;{TNPCData.DataID}

class function TSpellData.DataID;
begin
  Result := 7;
end;{TSpellData.DataID}

class function TClassData.DataID;
begin
  Result := 11;
end;{TClassData.DataID}

class function TMapData.DataID;
begin
  Result := 4;
end;{TMapData.DataID}

function SessionThread(Session: TSession): Integer;
begin
  Result := 0;
  try
    try
      while Session.Execute do
        sleep(1);

      Session.Free;
    except
      Writeln('Exception in session thread');

      Result := -1;
    end;{try...except}
  finally
    EndThread(Result);
  end;{try...finally}
end;{SessionThread}

class constructor TSession.Create;
begin
  SetLength(Sessions, 0);
  InitializeCriticalSection(SessionsLock);
end;{class)TSession.Create}

class destructor TSession.Destroy;
begin
  DeleteCriticalSection(SessionsLock);
end;{class)TSession.Destroy}

class procedure TSession.ThreadSafe;
begin
  EnterCriticalSection(SessionsLock);
end;{class)TSession.ThreadSafe}

class procedure TSession.ThreadSafeDone;
begin
  LeaveCriticalSection(SessionsLock);
end;{class)TSession.ThreadSafeDone}

class function TSession.GetSession;
var
  Session: TSession;
begin
  for Session in Sessions do
    if Session.ID = ID then exit(Session);

  Result := nil;
end;{class)TSession.GetSession}

class procedure TSession.SendAll(Packet: TPacket; Ignore: TSession = nil; Raw: Boolean = False);
var
  Session: TSession;
begin
  ThreadSafe;
  try
    for Session in Sessions do
      if Session <> Ignore then
        Session.Send(Packet, Raw);
  finally
    ThreadSafeDone;
  end;{try...finally}
end;{class)TSession.SendAll}

constructor TSession.Create;
var
  i:    Integer;
  Addr: TSockAddr;
begin
  inherited Create;

  Initialized := False;
  Buffer      := '';

  Socket := ASocket;

  FillChar(Addr, sizeof(Addr), 0);
  i := sizeof(addr);
  getpeername(Socket, Addr, i);
  IPStr := AnsiString(inet_ntoa(Addr.sin_addr));
  IPInt := Addr.sin_addr.S_addr;

  Name := IPStr;

  X := 12;
  Y := 12;
  D := 0;

  i := 1;
  ioctlsocket(Socket, FIONBIO, i);

  ID := 100;

  ThreadSafe;
  try
    while GetSession(ID) <> nil do inc(ID);

    SetLength(Sessions, length(Sessions) + 1);
    Sessions[high(Sessions)] := Self;
  finally
    ThreadSafeDone;
  end;{try...finally}

  Log('Created');

  BeginThread(nil, 0, @SessionThread, Pointer(Self), 0, ThreadID);
end;{TSession.Create}

destructor TSession.Destroy;
var
  i:      Integer;
  Packet: TPacket;
begin
  if Socket <> 0 then
  begin
    closesocket(Socket);
    Socket := 0;
  end;{if Socket}

  ThreadSafe;
  try
    i := Index;
    if i > -1 then
    begin
      if i < high(Sessions) then
        move(Sessions[i + 1], Sessions[i], sizeof(TSession) * (length(Sessions) - 1));

      SetLength(Sessions, length(Sessions) - 1);
    end;{if i > -1}
  finally
    ThreadSafeDone;
  end;{try...finally}

  Packet.SetID(PacketFamilyPlayers, PacketActionRemove);
  Packet.AddInt2(ID);

  SendAll(Packet);

  Log('Destroyed');

  inherited;
end;{TSession.Destroy}

procedure TSession.Log;
begin
  Writeln('Session[', ID, '] ', IPStr, ': ', S);
end;{TSession.Log}

function TSession.Index;
var
  i: Integer;
begin
  for i := 0 to length(Sessions) - 1 do
    if Sessions[i] = self then exit(i);

  Result := -1;
end;{TSession.Index}

procedure TSession.Send(Packet: TPacket; Raw: Boolean = False);
var
  i, j, Size: Integer;
  Encoded:    AnsiString;
  EncodeBuf:  AnsiString;
begin
  Encoded := copy(UnpackEOInt(length(Packet.Data) + 2), 1, 2) +
             AnsiChar(Packet.Action) +
             AnsiChar(Packet.Family) +
             Packet.Data;

  Size := length(Encoded);

  if not Raw then
  begin
    Encoded := FoldData(Encoded, SendKey);

    SetLength(EncodeBuf, Size);

    EncodeBuf[1] := Encoded[1];
    EncodeBuf[2] := Encoded[2];

    i := 2; j := 2;

    while i < Size do
    begin
      EncodeBuf[i + 1] := AnsiChar(ord(Encoded[j + 1]) xor $80);
      inc(j);
      inc(i, 2);
    end;{while i < Size}

    i := Size - 1;
    if Boolean(Size mod 2) then dec(i);

    while i >= 2 do
    begin
      EncodeBuf[i + 1] := AnsiChar(ord(Encoded[j + 1]) xor $80);
      inc(j);
      dec(i, 2);
    end;{while i >= 2}

    for i := 3 to Size do
           if EncodeBuf[i] = #128 then EncodeBuf[i] := #0
      else if EncodeBuf[i] = #0   then EncodeBuf[i] := #128;

    Encoded := EncodeBuf;
  end;{if not Raw}

  WinSock.send(Socket, Encoded[1], length(Encoded), 0);
end;{TSession.Send}

procedure TSession.SendInRange;
var
  Session: TSession;
begin
  ThreadSafe;
  try
    for Session in Sessions do
      if (Session <> Self) and
         (Session.X >= (X - Range)) and (Session.X <= (X + Range)) and
         (Session.Y >= (Y - Range)) and (Session.Y <= (Y + Range)) then
        Session.Send(Packet, Raw);
  finally
    ThreadSafeDone;
  end;{try...finally}
end;{TSession.SendInRange}

procedure TSession.SendGameData;
var
  Packet: TPacket;
begin
  Log('Sending game data: ' + Str(Data.DataID));

  Packet.SetID(PacketFamilyRaw, PacketActionRaw);

  Packet.AddInt1(Data.DataID);

  if Data.DataID <> 4 then
    Packet.AddInt1(1);

  Packet.AddString(Data.Data);

  Send(Packet, True);
end;{TSession.SendGameData}

procedure TSession.SendGameState;
var
  Packet: TPacket;
begin
  Packet.SetID(PacketFamilyGameData, PacketActionReply);

  Packet.AddInt2(1);
  Packet.AddInt2(ID);
  Packet.AddInt4(ID);
  Packet.AddInt2(1); // Map ID

  Packet.AddByte(MapData.CRC[0]);
  Packet.AddByte(MapData.CRC[1]);
  Packet.AddByte(MapData.CRC[2]);
  Packet.AddByte(MapData.CRC[3]);
  Packet.AddInt3(length(MapData.Data));

  Packet.AddByte(ItemData.CRC[0]);
  Packet.AddByte(ItemData.CRC[1]);
  Packet.AddByte(ItemData.CRC[2]);
  Packet.AddByte(ItemData.CRC[3]);
  Packet.AddByte(ItemData.Len[0]);
  Packet.AddByte(ItemData.Len[1]);

  Packet.AddByte(NPCData.CRC[0]);
  Packet.AddByte(NPCData.CRC[1]);
  Packet.AddByte(NPCData.CRC[2]);
  Packet.AddByte(NPCData.CRC[3]);
  Packet.AddByte(NPCData.Len[0]);
  Packet.AddByte(NPCData.Len[1]);

  Packet.AddByte(SpellData.CRC[0]);
  Packet.AddByte(SpellData.CRC[1]);
  Packet.AddByte(SpellData.CRC[2]);
  Packet.AddByte(SpellData.CRC[3]);
  Packet.AddByte(SpellData.Len[0]);
  Packet.AddByte(SpellData.Len[1]);

  Packet.AddByte(ClassData.CRC[0]);
  Packet.AddByte(ClassData.CRC[1]);
  Packet.AddByte(ClassData.CRC[2]);
  Packet.AddByte(ClassData.CRC[3]);
  Packet.AddByte(ClassData.Len[0]);
  Packet.AddByte(ClassData.Len[1]);

  Packet.AddBreakString(Name);  // Name
  Packet.AddBreakString(IPStr); // Title
  Packet.AddBreakString('');    // Guild
  Packet.AddBreakString('');    // Rank

  Packet.AddInt1(0); // Class index

  Packet.AddString('   '); // Tag

  Packet.AddInt1(1);  // Admin
  Packet.AddInt1(0);  // Level
  Packet.AddInt4(0);  // Exp
  Packet.AddInt4(0);  // Usage
  Packet.AddInt2(10); // HP
  Packet.AddInt2(10); // MaxHP
  Packet.AddInt2(10); // TP
  Packet.AddInt2(10); // MaxTP
  Packet.AddInt2(10); // MaxSP
  Packet.AddInt2(0);  // Stat points
  Packet.AddInt2(0);  // Skill points
  Packet.AddInt2(0);  // Karma
  Packet.AddInt2(0);  // Min damage
  Packet.AddInt2(0);  // Max damage
  Packet.AddInt2(0);  // Accuracy
  Packet.AddInt2(0);  // Evade
  Packet.AddInt2(0);  // Armour

  Packet.AddInt2(0); // Str
  Packet.AddInt2(0); // Int
  Packet.AddInt2(0); // Wis
  Packet.AddInt2(0); // Agi
  Packet.AddInt2(0); // Con
  Packet.AddInt2(0); // Cha

  Packet.AddInt2(0); // Elements
  Packet.AddInt2(0);
  Packet.AddInt2(0);
  Packet.AddInt2(0);
  Packet.AddInt2(0);
  Packet.AddInt2(0);
  Packet.AddInt2(0);

  Packet.AddInt1(0); // Guild Rank
  Packet.AddInt2(1); // Jail map
  Packet.AddInt2(4);
  Packet.AddInt1($F0);
  Packet.AddInt1($F0);
  Packet.AddInt2($FFF0);
  Packet.AddInt2($FFF0);
  Packet.AddInt2(1);
  Packet.AddInt2(1);
  Packet.AddInt1(0);

  Packet.AddByte(255);

  Send(Packet);
end;{TSession.SendGameState}

procedure TSession.BuildCharacterPacket;
begin
  Packet.AddBreakString(Name);

  Packet.AddInt2(ID);
  Packet.AddInt2(1);  // Map ID
  Packet.AddInt2(X);
  Packet.AddInt2(Y);
  Packet.AddInt1(D);
  Packet.AddInt1(0);  // Class
  Packet.AddString('   '); // Tag
  Packet.AddInt1(0);  // Level
  Packet.AddInt1(0);  // Sex
  Packet.AddInt1(1);  // Hair style
  Packet.AddInt1(1);  // Hair colour
  Packet.AddInt1(0);  // Race
  Packet.AddInt2(10); // MaxHP
  Packet.AddInt2(10); // HP
  Packet.AddInt2(10); // MaxTP
  Packet.AddInt2(10); // TP

  Packet.AddInt2(0); // Boots
  Packet.AddInt2(0);
  Packet.AddInt2(0);
  Packet.AddInt2(0);
  Packet.AddInt2(0); // Armour
  Packet.AddInt2(0);
  Packet.AddInt2(0); // Hat
  Packet.AddInt2(0); // Shield
  Packet.AddInt2(0); // Weapon

  Packet.AddInt1(0); // Sittting
  Packet.AddInt1(0); // Hidden
end;{TSession.BuildCharacterPacket}

function TSession.Walk;
var
  i:          Integer;
  State:      Integer;
  NewX, NewY: Integer;
  PacketShow: TPacket;
  PacketHide: TPacket;
  PacketWalk: TPacket;
  PacketChar: TPacket;
  Session:    TSession;
  NewCoords:  array[-Range..Range] of TPoint;
  OldCoords:  array[-Range..Range] of TPoint;
begin
  NewX := X;
  NewY := Y;

  case Direction of
    DirectionDown:  inc(NewY);
    DirectionLeft:  dec(NewX);
    DirectionUp:    dec(NewY);
    DirectionRight: inc(NewX);
  else
    Log('Invalid walk direction ' + Str(Direction));
    exit(False);
  end;{case Direction}

  D := Direction;
  X := NewX;
  Y := NewY;

  PacketShow.SetID(PacketFamilyPlayers, PacketActionAgree);
  PacketShow.AddByte(255);
  BuildCharacterPacket(PacketShow);
  PacketShow.AddByte(255);
  PacketShow.AddInt1(1);

  PacketHide.SetID(PacketFamilyPlayers, PacketActionRemove);
  PacketHide.AddInt2(ID);

  PacketWalk.SetID(PacketFamilyWalk, PacketActionPlayer);
  PacketWalk.AddInt2(ID);
  PacketWalk.AddInt1(D);
  PacketWalk.AddInt1(X);
  PacketWalk.AddInt1(Y);

  for i := -Range to Range do
    case Direction of
      DirectionDown:
      begin
        NewCoords[i].X := X + i;
        NewCoords[i].Y := Y + Range - abs(i);
        OldCoords[i].X := X + i;
        OldCoords[i].Y := Y - Range - 1 + abs(i);
      end;{DirectionDown:}

      DirectionLeft:
      begin
        NewCoords[i].X := X - Range + abs(i);
        NewCoords[i].Y := Y + i;
        OldCoords[i].X := X + Range + 1 - abs(i);
        OldCoords[i].Y := Y + i;
      end;{DirectionLeft:}

      DirectionUp:
      begin
        NewCoords[i].X := X + i;
        NewCoords[i].Y := Y - Range + abs(i);
        OldCoords[i].X := X + i;
        OldCoords[i].Y := Y + Range + 1 - abs(i);
      end;{DirectionUp:}

      DirectionRight:
      begin
        NewCoords[i].X := X + Range - abs(i);
        NewCoords[i].Y := Y + i;
        OldCoords[i].X := X - Range - 1 + abs(i);
        OldCoords[i].Y := Y + i;
      end;{DirectionRight:}
  end;{case Direction}

  ThreadSafe;
  try
    for Session in Sessions do
      if (Session <> Self) and
         (Session.X >= (X - (Range + 1))) and (Session.X <= (X + (Range + 1))) and
         (Session.Y >= (Y - (Range + 1))) and (Session.Y <= (Y + (Range + 1))) then
      begin
        State := 0;

        for i := -Range to Range do
          if (Session.X = NewCoords[i].X) and (Session.Y = NewCoords[i].Y) then
          begin
            State := 1;
            break;
          end{if (Session.X...}
          else if (Session.X = OldCoords[i].X) and (Session.Y = OldCoords[i].Y) then
          begin
            State := -1;
            break;
          end;{else if (Session.X...}

        case State of
          1:
          begin
            Log('add ' + Str(Session.ID));

            PacketChar.Reset;
            PacketChar.SetID(PacketFamilyPlayers, PacketActionAgree);
            PacketChar.AddByte(255);
            Session.BuildCharacterPacket(PacketChar);
            PacketChar.AddByte(255);
            PacketChar.AddInt1(1);

            Session.Send(PacketShow);
            Send(PacketChar);
          end;{1:}

          -1:
          begin
            Log('remove ' + Str(Session.ID));

            PacketChar.Reset;
            PacketChar.SetID(PacketFamilyPlayers, PacketActionRemove);
            PacketChar.AddInt2(Session.ID);

            Session.Send(PacketHide);
            Send(PacketChar);
          end;{-1:}
        else
          Session.Send(PacketWalk);
        end;{case State}
      end;{if Session <> Self}
  finally
    ThreadSafeDone;
  end;{try...finally}

  Result := True;
end;{TSession.Walk}

function TSession.Face;
var
  Packet: TPacket;
begin
  if (Direction < 0) or (Direction > 3) then
  begin
    Log('Invalid face direction ' + Str(Direction));
    exit(False);
  end;{if (Direction...}

  D := Direction;

  Packet.SetID(PacketFamilyFace, PacketActionPlayer);
  Packet.AddInt2(ID);
  Packet.AddInt1(D);

  SendInRange(Packet);

  Result := True;
end;{TSession.Face}

function TSession.Say;
var
  Packet: TPacket;
begin
  if length(Text) = 0 then exit(False);

  Packet.SetID(PacketFamilyTalk, PacketActionPlayer);
  Packet.AddInt2(ID);
  Packet.AddString(Text);

  SendInRange(Packet);

  Result := True;
end;{TSession.Say}

function TSession.Execute;
const
  BufSize = 1024;
var
  i:       Integer;
  Size:    Integer;
  ReadLen: Integer;
  ReadBuf: AnsiString;
begin
  if (Socket = 0) or (recv(Socket, nil^, 0, MSG_OOB) = 0) then exit(False);

  if ioctlsocket(Socket, FIONREAD, i) = 0 then
  begin
    SetLength(ReadBuf, BufSize);

    repeat
      ReadLen := recv(Socket, ReadBuf[1], BufSize, 0);
      if ReadLen < 1 then break;

      Buffer := Buffer + copy(ReadBuf, 1, ReadLen);
    until False;
  end;{if ioctlsocket}

  if length(Buffer) < 2 then exit(True);

  Size := PackEOInt(ord(Buffer[1]), ord(Buffer[2]));
  if length(Buffer) < (Size + 2) then exit(True);

  PacketIn.Data := copy(Buffer, 3, Size);
  Buffer        := copy(Buffer, Size + 3, length(Buffer));

  if Size < 3 then exit(true);

  if Initialized then
  begin
    ReadBuf := '';
    i       := 1;

    while i <= length(PacketIn.Data) do
    begin
      ReadBuf := ReadBuf + AnsiChar(ord(PacketIn.Data[i]) xor $80);
      inc(i, 2);
    end;{while i <= length(PacketIn.Data)}

    dec(i);
    if Boolean(length(PacketIn.Data) mod 2) then dec(i, 2);

    repeat
      ReadBuf := ReadBuf + AnsiChar(ord(PacketIn.Data[i]) xor $80);
      dec(i, 2);
    until i <= 0;

    for i := 3 to length(PacketIn.Data) do
           if ReadBuf[i] = #128 then ReadBuf[i] := #0
      else if ReadBuf[i] = #0   then ReadBuf[i] := #128;

    PacketIn.Data := FoldData(ReadBuf, RecieveKey);
  end;{if Initialized}

  PacketIn.Family := ord(PacketIn.Data[2]);
  PacketIn.Action := ord(PacketIn.Data[1]);
  PacketIn.Data   := copy(PacketIn.Data, 3, length(PacketIn.Data));

  if PacketIn.Family <> PacketFamilyRaw then
  begin
    // Sequence
    PacketIn.GetByte;
  end;{if PackeyIn.Family}

  PacketOut.Reset;
  PacketOut.SetID(PacketIn.Family, PacketActionReply);

  //Log('Packet family:' + Str(PacketIn.Family) + ' action:' + Str(PacketIn.Action));

  i := PacketIn.Family;
  Dispatch(i);

  Result := Initialized;
end;{TSession.Execute}

procedure TSession.DefaultHandler;
begin
{$IFNDEF SILENTUNHANDLED}
  Log('Unhandled packet family ' + Str(PacketIn.Family));
{$ENDIF SILENTUNHANDLED}
end;{TSession.DefaultHandler}

procedure TSession.HandleRaw;
  function AuthClient(Auth: Integer): Integer;
  begin
    inc(Auth);

    Result := (Auth mod 11 + 1) * 119;
    if Result = 0 then exit;

    Result := 110905 + (Auth mod 9 + 1) * ((11092004 - Auth) mod Result) * 119 + Auth mod 2004;
  end;
var
  Auth:   Integer;
  s1, s2: Byte;
  Ver:    array[0..2] of Byte;
  Seq:    Byte;
begin
  PacketOut.SetID(PacketFamilyRaw, PacketActionRaw);

  Auth := PacketIn.GetInt3;

  Ver[0] := PacketIn.GetInt1;
  Ver[1] := PacketIn.GetInt1;
  Ver[2] := PacketIn.GetInt1;

  if (Ver[0] < RequiredVersion[0])
  or (Ver[1] < RequiredVersion[1])
  or (Ver[2] < RequiredVersion[2]) then
  begin
    PacketOut.AddByte(1);
    PacketOut.AddByte(RequiredVersion[0] + 1);
    PacketOut.AddByte(RequiredVersion[1] + 1);
    PacketOut.AddByte(RequiredVersion[2] + 1);

    Log('Invalid client version');

    Send(PacketOut, True);
    exit;
  end;{if (Ver...}

  PacketIn.Discard(2);
  HDDSerial := PacketIn.GetString;

  PacketOut.AddByte(2);

  Seq := 1 + Random(220);

  s1 := (Seq + 12) div 7;
  s2 := (Seq +  5) mod 7;

  PacketOut.AddByte(s1);
  PacketOut.AddByte(s2);

  Log('Initialized s1:' + Str(s1) + ' s2:' + Str(s2));

  PacketOut.AddByte(SendKey);
  PacketOut.AddByte(RecieveKey);

  PacketOut.AddInt2(ID);

  PacketOut.AddInt3(AuthClient(Auth));

  Send(PacketOut, True);
  Initialized := True;
end;{TSession.HandleRaw}

procedure TSession.HandleConnection;
  procedure HandleConnectionAccept;
  begin
    SendGameData(ItemData);
    SendGameData(NPCData);
    SendGameData(SpellData);
    SendGameData(ClassData);

    // For some reason the client can't handle all this data at once, slow down a bit
    Sleep(500);

    SendGameState;
  end;{HandleConnectionAccept}

  procedure HandleConnectionPing;
  begin
    {}
  end;{HandleConnectionPing}
begin
  case PacketIn.Action of
    PacketActionAccept: HandleConnectionAccept;
  else
{$IFNDEF SILENTUNHANDLED}
    Log('Unhandled connection action ' + Str(PacketIn.Action));
{$ENDIF SILENTUNHANDLED}
  end;{case PacketIn.Action}
end;{TSession.HandleConnection}

procedure TSession.HandleGameData;
  procedure HandleGameDataAgree;
  var
    FileID: Byte;
  begin
    FileID := PacketIn.GetInt1;

    case FileID of
      FileIDMap:    SendGameData(MapData);
      FileIDItem:   SendGameData(ItemData);
      FileIDNPC:    SendGameData(NPCData);
      FileIDSpell:  SendGameData(SpellData);
      FileIDClass:  SendGameData(ClassData);
    else
      Log('Unknown file ID ' + Str(FileID));
    end;{case FileID}
  end;{HandleGameDataAgree}

  procedure HandleGameDataMessage;
  var
    i:       Integer;
    Session: TSession;
  begin
    PacketOut.AddInt2(2);
    PacketOut.AddByte(255);

    PacketOut.AddBreakString('MEOW');

    for i := 0 to 6 do
      PacketOut.AddBreakString('');

    PacketOut.AddByte(255);

    PacketOut.AddInt1(0);  // Weight
    PacketOut.AddInt1(50); // Max weight

    PacketOut.AddByte(255); // Inventory
    PacketOut.AddByte(255); // Spells

    ThreadSafe;
    try
      PacketOut.AddInt1(length(Sessions));
      PacketOut.AddByte(255);

      for Session in Sessions do
      begin
        Session.BuildCharacterPacket(PacketOut);
        PacketOut.AddByte(255);
      end;{for Session in Sessions}
    finally
      ThreadSafeDone;
    end;{try...finally}

    PacketOut.AddByte(255); // NPCs
    //PacketOut.AddByte(255); // Items

    Send(PacketOut);

    PacketOut.Reset;
    PacketOut.SetID(PacketFamilyPlayers, PacketActionAgree);
    PacketOut.AddByte(255);
    BuildCharacterPacket(PacketOut);
    PacketOut.AddInt1(1);
    PacketOut.AddByte(255);
    PacketOut.AddInt1(1);

    SendAll(PacketOut, Self);
  end;{HandleGameDataMessage}
begin
  case PacketIn.Action of
    PacketActionRequest: SendGameState;
    PacketActionAgree:   HandleGameDataAgree;
    PacketActionMessage: HandleGameDataMessage;
  else
{$IFNDEF SILENTUNHANDLED}
    Log('Unhandled game data action '  + Str(PacketIn.Action));
{$ENDIF SILENTUNHANDLED}
  end;{case PacketIn.Action}
end;{TSession.HandleGameData}

procedure TSession.HandleWalk;
begin
  case PacketIn.Action of
    PacketActionPlayer:  Walk(PacketIn.GetInt1, False);
    PacketActionSpecial: Walk(PacketIn.GetInt1, False, True);
    PacketActionAdmin:   Walk(PacketIn.GetInt1, True);
  else
    Log('Unhandled walk action ' + Str(PacketIn.Action));
  end;{case Receive.Action}
end;{TSession.HandleWalk}

procedure TSession.HandleFace;
begin
  if PacketIn.Action = PacketActionPlayer then
    Face(PacketIn.GetInt1)
  else
    Log('Unhandled face action ' + Str(PacketIn.Action));
end;{TSession.HandleFace}

procedure TSession.HandleRequest;
var
  RequestID: Integer;
  Session:   TSession;
begin
  if PacketIn.Action <> PacketActionRequest then
  begin
    Log('Unhandled request action ' + Str(PacketIn.Action));
    exit;
  end;{if PacketIn.Action}

  RequestID := PacketIn.GetInt2;

  PacketOut.SetID(PacketFamilyPlayers, PacketActionRemove);
  PacketOut.AddInt2(RequestID);
  Send(PacketOut);

  PacketOut.Reset;
  PacketOut.SetID(PacketFamilyPlayers, PacketActionAgree);
  PacketOut.AddByte(255);

  ThreadSafe;
  try
    Session := GetSession(RequestID);
    if Session = nil then exit;

    Session.BuildCharacterPacket(PacketOut);
  finally
    ThreadSafeDone;
  end;{try..finally}

  PacketOut.AddInt1(1);
  PacketOut.AddByte(255);
  PacketOut.AddInt1(1);

  Send(PacketOut);
end;{TSession.HandleRequest}

procedure TSession.HandleTalk;
  procedure HandleTalkReport;
  var
    Text:   AnsiString;
  begin
    Text := copy(PacketIn.GetBreakString, 1, 200);
    if length(Text) = 0 then exit;

    Say(Text);
  end;{HandleTalkReport}
begin
  case PacketIn.Action of
    PacketActionReport: HandleTalkReport;
  else
    Log('Unhandled talk action ' + Str(PacketIn.Action));
  end;{case PacketIn.Action}
end;{TSession.HandleTalk}


var
  WSAData:  TWSAData;
  Socket:   TSocket;
  AddrIn:   TSockAddrIn;
  FDSet:    TFDSet;
  SockAddr: TSockAddr;
  SockSize: Integer;
begin
  try
    Writeln('MEOW - "Mini EO? WOW!"');
    Writeln('Created by Sordie out of pure bordem.');
    Writeln;

    Writeln('Loading item data');
    ItemData := TItemData.Create('dat001.eif');
    if length(ItemData.Data) = 0 then exit;

    Writeln('Loading npc data');
    NPCData := TNPCData.Create('dtn001.enf');
    if length(NPCData.Data) = 0 then exit;

    Writeln('Loading spell data');
    SpellData := TSpellData.Create('dsl001.esf');
    if length(SpellData.Data) = 0 then exit;

    Writeln('Loading class data');
    ClassData := TClassData.Create('dat001.ecf');
    if length(ClassData.Data) = 0 then exit;

    Writeln('Loading map data');
    MapData := TMapData.Create('00001.emf');
    if length(MapData.Data) = 0 then exit;

    Writeln('Initializing WinSock');
    WSAStartup(MakeLong(2, 2), WSAData);

    Writeln('Creating server socket');
    Socket := WinSock.socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
    if Socket = 0 then exit;

    Writeln('Binding socket');
    FillChar(AddrIn, sizeof(AddrIn), 0);
    AddrIn.sin_family      := AF_INET;
    AddrIn.sin_addr.S_addr := inet_addr('0.0.0.0');
    AddrIn.sin_port        := htons(8078);
    if bind(Socket, AddrIn, sizeof(AddrIn)) <> 0 then exit;

    Writeln('Listening');
    if listen(Socket, 0) <> 0 then exit;

    repeat
      sleep(1);

      FDSet.fd_count    := 1;
      FDSet.fd_array[0] := Socket;

      if select(0, @FDSet, nil, nil, nil) = 1 then
      begin
        SockSize := sizeof(SockAddr);
        TSession.Create(accept(Socket, @SockAddr, @SockSize));
      end;{if select}
    until False;

    closesocket(Socket);

    Writeln('Success');
  finally
    Write('Done');
    Readln;
  end;{try...finally}
end.