program MEOW;

{$APPTYPE CONSOLE}

{$DEFINE THREAD_SAFE}
{$DEFINE LOG_CONFIG}
{$DEFINE LOG_SQL}
{$DEFINE LOG_UNHANDLED_PACKET_FAMILY}
{$DEFINE LOG_UNHANDLED_PACKET_ACTION}

uses
  Windows, WinSock;

type
  procedureref = reference to procedure;

  CriticalSectionHelper = record helper for TRTLCriticalSection
    procedure Create; inline;
    procedure Free;   inline;

    procedure Enter; inline;
    procedure Leave; inline;

    procedure Section(Code: procedureref); inline;
  end;{CriticalSectionHelper}

const
  sqlite3 = 'sqlite3.dll';

type
  TSQLiteDB    = Pointer;
  TSQLiteQuery = Pointer;

function sqlite3_open(DBName: PAnsiChar; var DB: TSQLiteDB): Integer; cdecl; external sqlite3;
function sqlite3_close(DB: TSQLiteDB): Integer; cdecl; external sqlite3;
function sqlite3_prepare(DB: TSQLiteDB; QueryStr: PAnsiChar; QuerySize: Integer; var Query: TSQLiteQuery; var NextQuery: PAnsiChar): Integer; cdecl; external sqlite3;
function sqlite3_step(Query: TSQLiteQuery): Integer; cdecl; external sqlite3;
function sqlite3_finalize(Query: TSQLiteQuery): Integer; cdecl; external sqlite3;
function sqlite3_column_count(Query: TSQLiteQuery): Integer; cdecl; external sqlite3;
function sqlite3_column_name(Query: TSQLiteQuery; i: Integer): PAnsiChar; cdecl; external sqlite3;
function sqlite3_column_type(Query: TSQLiteQuery; i: Integer): Integer; cdecl; external sqlite3;
function sqlite3_column_int(Query: TSQLiteQuery; i: Integer): Integer; cdecl; external sqlite3;
function sqlite3_column_text(Query: TSQLiteQuery; i: Integer): PAnsiChar; cdecl; external sqlite3;

const
  SQLITE_OK   = 0;
  SQLITE_ROW  = 100;
  SQLITE_DONE = 101;

  SQLITE_INTEGER = 1;
  SQLITE_TEXT    = 3;
  SQLITE_NULL    = 5;

type
  TDatabase = class
    var CriticalSection: TRTLCriticalSection;

    var FileName: AnsiString;
    var DB:       TSQLiteDB;

    var Transaction: Boolean;

    type TTable = class
      var Database: TDatabase;

      type TCell = record
        DataType: Integer;

        DataStr:  AnsiString;
        DataInt:  Integer;
      end;{TCell}

      var ColumnNames: array of AnsiString;
      var Table:       array of array of TCell;

      constructor Create(ADatabase: TDatabase; SQL: AnsiString);
      destructor  Destroy; override;

      function Empty: Boolean; inline;

      function Column(Name: AnsiString): Integer;

      function Value(Name: AnsiString; Row: Integer = 0; Default: AnsiString = ''): AnsiString;  overload;
      function Value(Name: AnsiString; Row: Integer = 0; Default: Integer    = 0):  Integer;     overload;
    end;{TTable}

    constructor Create(AFileName: AnsiString);
    destructor  Destroy; override;

    function  Prepare(SQL: AnsiString): TSQLiteQuery;
    procedure Finalize(var Query: TSQLiteQuery);

    function Query     (SQL: AnsiString): Boolean;
    function QueryTable(SQL: AnsiString): TTable; inline;

    function TableExists(Name: AnsiString): Boolean;

    function BeginTransaction: Boolean;
    function EndTransaction(Rollback: Boolean = False): Boolean;
  end;{TDatabase}

  TINIFile = class
    var CriticalSection: TRTLCriticalSection;

    var FileName: AnsiString;

    constructor Create(AFileName: AnsiString);
    destructor  Destroy; override;

    function Read(Section, Key: AnsiString; Default: AnsiString  = ''):    AnsiString; overload;
    function Read(Section, Key: AnsiString; Default: Integer     = 0):     Integer;    overload;
    function Read(Section, Key: AnsiString; Default: Boolean     = False): Boolean;    overload;
  end;{TINIFile}

  TArray<T: class> = class
    var Items: array of T;

    constructor Create;
    destructor  Destroy; override;

    function Find  (Item: T): Integer;
    function Add   (Item: T): Integer;
    function Remove(Item: T): Integer;

    procedure Clear;
  end;{TArray<T>}

  TSHA256Hash = packed record
    A, B, C, D, E, F, G, H: Cardinal;
  end;{TSHA256Hash}

  TSHA256 = record
    Hash:   TSHA256Hash;
    MLen:   Int64;
    Buffer: array[0..63] of Byte;
    Index:  Integer;

    procedure Init;
    procedure Compress;
    procedure Update(Data: Pointer; Len: Integer);
    function  Done: AnsiString;

    class function HashStr(S: AnsiString): AnsiString; static;
  end;{TSHA256}

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

    const ReceiveKey = 8;
    const SendKey    = 10;

    const PacketFamilyRaw        = 255;
    const PacketFamilyConnection = 1;
    const PacketFamilyAccount    = 2;
    const PacketFamilyLogin      = 4;
    const PacketFamilyGameState  = 5;
    const PacketFamilyWalk       = 6;
    const PacketFamilyFace       = 7;
    const PacketFamilyTalk       = 18;
    const PacketFamilyPlayers    = 22;
    const PacketFamilyRequest    = 27;

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

    type TPacket = record
      Family: Byte;
      Action: Byte;

      Data:   AnsiString;

      Time: Cardinal;

      procedure SetID(AFamily, AAction: Byte);

      procedure Reset; inline;

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

      procedure AddByte(b: Byte); inline;
      procedure AddInt1(i: Byte); inline;
      procedure AddInt2(i: Word); inline;
      procedure AddInt3(i: Cardinal); inline;
      procedure AddInt4(i: Cardinal); inline;
      procedure AddBreakString(s: AnsiString); inline;
      procedure AddString     (s: 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 abstract
      var Data: AnsiString;
      var CRC:  array[0..3] of Byte;
      var Len:  array[0..1] of Byte;

      var FileName: AnsiString;

      class function DataID: Byte; virtual; abstract;

      constructor Create(AFileName: AnsiString);

      function Load: Boolean; virtual;
    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}

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

    type TSession = class
      var Socket: TSocket;
      var IPStr:  AnsiString;
      var IPInt:  Integer;

      var Thread: THandle;

      var ID:          Cardinal;
      var Initialized: Boolean;
      var LoggedIn:    Boolean;

      var Packet: record
        Buffer: AnsiString;

        Queue: record
          Items:  array of TPacket;
          Time:   Cardinal;
          Active: Boolean;
        end;{Queue}

        Receive: TPacket;
        Send:    TPacket;

        Time: Cardinal;
      end;{Packet}

      var Name:      AnsiString;
      var Password:  AnsiString;
      var HDDSerial: AnsiString;

      var X: Integer;
      var Y: Integer;
      var D: Integer;
      var S: Integer;

      var Admin: Integer;

      var Tag:        AnsiString;
      var Sex:        Integer;
      var HairStyle:  Integer;
      var HairColour: Integer;
      var Race:       Integer;

      var ClassID: Integer;
      var Title:   AnsiString;
      var Home:    AnsiString;
      var Partner: AnsiString;
      var Guild:   AnsiString;
      var Rank:    AnsiString;

      var Boots:  Integer;
      var Armour: Integer;
      var Hat:    Integer;
      var Shield: Integer;
      var Weapon: Integer;

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

      function  Sync(Discard: Boolean = False): Boolean;
      procedure Unload;

      procedure Log(Params: array of const);

      procedure Send(var Packet: TPacket; Raw: Boolean = False); overload;
      procedure Send(                     Raw: Boolean = False); overload; inline;

      procedure SendData(Data: TGameData);

      procedure Login;
      procedure Logout;

      procedure BuildCharacterPacket(var Packet: TPacket);

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

      procedure Refresh;
      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 UnhandledAction(Name: AnsiString = '');

      procedure HandleRaw       (var Param); message Server.PacketFamilyRaw;
      procedure HandleConnection(var Param); message Server.PacketFamilyConnection;
      procedure HandleAccount   (var Param); message Server.PacketFamilyAccount;
      procedure HandleLogin     (var Param); message Server.PacketFamilyLogin;
      procedure HandleGameState (var Param); message Server.PacketFamilyGameState;
      procedure HandleWalk      (var Param); message Server.PacketFamilyWalk;
      procedure HandleFace      (var Param); message Server.PacketFamilyFace;
      procedure HandleRequest   (var Param); message Server.PacketFamilyRequest;
      procedure HandleTalk      (var Param); message Server.PacketFamilyTalk;
    end;{Session}

    class var CriticalSection: TRTLCriticalSection;

    class var Sessions: TArray<TSession>;
    class var Socket:   TSocket;

    class var Database:      TDatabase;
    class var Configuration: TINIFile;

    class var Connection: record
      Bind:    AnsiString;
      Port:    Word;
      Timeout: Cardinal;

      BytesIn:  Int64;
      BytesOut: Int64;
    end;{Connection}

    class var PacketQueue: record
      Enabled: Boolean;
      Size:    Integer;
    end;{Packet}

    class var Defaults: record
      X, Y, D: Integer;
    end;{Defaults}

    const ViewRange  = 12;
    const TextLength = 100;

    class constructor Create;
    class destructor  Destroy;

    class procedure Main;

    class var Caption: AnsiString;
    class procedure UpdateCaption;

    class procedure Log(Params: array of const; Prefix: AnsiString = '');

    class procedure Send(var Packet: TPacket; Sender: TSession = nil; Ranged: Boolean = True);

    class function GetSessionByID  (ID:   Cardinal):   TSession;
    class function GetSessionByName(Name: AnsiString): TSession;

    const NameMax   = 12;
    const NameChars = 'abcdefghijklmnopqrstuvwxyz0123456789';

    class function ValidName(Name: AnsiString): Boolean;

    class function GetAccount(Name: AnsiString; Items: AnsiString = '*'): TDatabase.TTable;
    class function AccountExists(Name: AnsiString): Boolean;
  end;{Server}

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

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:      Integer;
  c:      AnsiChar;
  Buffer: AnsiString;
begin
  if Key = 0 then exit(Str);

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

  for c in Str do
  begin
    if (ord(c) mod Key) = 0 then
      Buffer := Buffer + c
    else
    begin
      if length(Buffer) > 0 then
      begin
        for i := length(Buffer) downto 1 do
          Result := Result + Buffer[i];

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

      Result := Result + c;
    end;{else}
  end;{for c}

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

function bswap(A: integer): Integer;
asm
  bswap eax
end;{bswap}

procedure bswap256(s, d: PInteger);
asm
  push ebx
  mov ecx, eax
  mov eax,[ecx];    mov ebx,[ecx+4];  bswap eax; bswap ebx; mov [edx],    eax; mov [edx+4],  ebx
  mov eax,[ecx+8];  mov ebx,[ecx+12]; bswap eax; bswap ebx; mov [edx+8],  eax; mov [edx+12], ebx
  mov eax,[ecx+16]; mov ebx,[ecx+20]; bswap eax; bswap ebx; mov [edx+16], eax; mov [edx+20], ebx
  mov eax,[ecx+24]; mov ebx,[ecx+28]; bswap eax; bswap ebx; mov [edx+24], eax; mov [edx+28], ebx
  pop ebx
end;{bswap256}

function InterlockedExchangeAdd64(var Addend: Int64; Value: Int64): Int64; register;
asm
  push edi
  push esi
  push ebp
  push ebx

  mov esi, dword ptr [Value]
  mov edi, dword ptr [Value + 4]
  mov ebp, eax

  mov eax, [ebp]
  mov edx, [ebp + 4]
@@lockmore:
  mov ecx, edx
  mov ebx, eax

  add ebx, esi
  adc ecx, edi

  lock cmpxchg8b [ebp]
  jnz @@lockmore

  pop ebx
  pop ebp
  pop esi
  pop edi
end;{InterlockedExchangeAdd64}

function Lower(S: AnsiString): AnsiString;
begin
  Result := S;
  if length(Result) = 0 then exit;

  CharLowerBuffA(Pointer(Result), length(Result));
end;{Lower}

function Int(S: AnsiString; Default: Integer = 0): Integer;
var
  Code: Integer;
begin
  Val(String(S), Result, Code);
  if Code <> 0 then Result := Default;
end;{Int}

function Str(I: Integer): AnsiString; overload;
var
  S: ShortString;
begin
  System.Str(I, S);
  Result := AnsiString(S);
end;{Str(Integer}

function Str(F: Extended): AnsiString; overload;
var
  S: ShortString;
begin
  System.Str(F:2:2, S);
  Result := AnsiString(S);
end;{Str(Extended}

function Tidy(s: AnsiString): AnsiString;
var
  i: Integer;
  c: AnsiChar;
begin
  Result := '';

  for c in s do
    if pos(String(c), '0123456789.') > 0 then Result := Result + c;

  if length(Result) = 0 then exit('0');

  if pos('.', String(Result)) > 0 then
  begin
    while Result[length(Result)] = '0' do
      Result := copy(Result, 1, length(Result) - 1);

    if Result[length(Result)] = '.' then
      Result := copy(Result, 1, length(Result) - 1);
  end;{if pos('.'...}

  while (length(Result) > 0) and (Result[1] = '0') do
    Result := copy(Result, 2, length(Result));

  i := pos('.', String(Result)) - 1; if i < 1 then i := length(Result);

  repeat
    dec(i, 3); if i < 1 then break;

    Result := copy(Result, 1, i) + ',' + copy(Result, i + 1, length(Result));
  until False;

  if (length(Result) = 0) or (Result[1] = '.') then Result := '0' + Result;
end;{Tidy}

function Scale(i: Int64): AnsiString;
const
  MinAdjustValue = 900;
  ScaleStr: array[0..3] of AnsiString = ('B', 'KB',  'MB',  'GB');
var
  j:  Integer;
  k:  Extended;
begin
  j := 0;
  k := i;

  while k > MinAdjustValue do
  begin
    k := k / 1024;
    inc(j); if j = high(ScaleStr) then break;
  end;{while i}

  Result := Tidy(Str(k)) + ScaleStr[j];
end;{Scale}

function Str(B: Boolean): AnsiString; overload;
begin
  if B then
    Result := 'true'
  else
    Result := 'false';
end;{Str(Boolean}

function Bool(S: AnsiString; Default: Boolean = False): Boolean;
begin
  if length(S) = 0 then exit(Default);
  S := Lower(copy(S, 1, 2));

  if (S[1] = 't') or (S = 'ok') or (S = 'on') then
    Result := True
  else
    Result := Int(S, Integer(Default)) <> 0;
end;{Bool}

procedure Error(Params: array of const);
begin
  Server.Log(Params, '/!\ ERROR');
  halt(1);
end;{Error}

procedure CriticalSectionHelper.Create;
begin
{$IFDEF THREAD_SAFE}
  InitializeCriticalSection(Self);
{$ENDIF THREAD_SAFE}
end;{CriticalSectionHelper.Create}

procedure CriticalSectionHelper.Free;
begin
{$IFDEF THREAD_SAFE}
  DeleteCriticalSection(Self);
{$ENDIF THREAD_SAFE}
end;{CriticalSectionHelper.Free}

procedure CriticalSectionHelper.Enter;
begin
{$IFDEF THREAD_SAFE}
  EnterCriticalSection(Self);
{$ENDIF THREAD_SAFE}
end;{CriticalSectionHelper.Enter}

procedure CriticalSectionHelper.Leave;
begin
{$IFDEF THREAD_SAFE}
  LeaveCriticalSection(Self);
{$ENDIF THREAD_SAFE}
end;{CriticalSectionHelper.Leave}

procedure CriticalSectionHelper.Section(Code: procedureref);
begin
  Enter;
  try
    Code;
  finally
    Leave;
  end;{try...finally}
end;{CriticalSectionHelper.Secion}

constructor TDatabase.TTable.Create(ADatabase: TDatabase; SQL: AnsiString);
var
  i:     Integer;
  Query: TSQLiteQuery;
begin
  inherited Create;

  Database := ADatabase;

  Database.CriticalSection.Enter;

  try
    Query := Database.Prepare(SQL);
    if Query = nil then exit;

    while sqlite3_step(Query) = SQLITE_ROW do
    begin
      if length(Table) = 0 then
      begin
        SetLength(ColumnNames, sqlite3_column_count(Query));

        for i := 0 to length(ColumnNames) - 1 do
          ColumnNames[i] := lower(sqlite3_column_name(Query, i));
      end;{if length(Table) = 0}

      SetLength(Table, length(Table) + 1);
      SetLength(Table[high(Table)], length(ColumnNames));

      for i := 0 to length(ColumnNames) - 1 do
        with Table[high(Table)][i] do
        begin
          DataType := sqlite3_column_type(Query, i);

          case DataType of
            SQLITE_INTEGER:
            begin
              DataInt := sqlite3_column_int(Query, i);
              DataStr := Str(DataInt);
            end;{SQLITE_INTEGER:}

            SQLITE_TEXT:
            begin
              DataStr := sqlite3_column_text(Query, i);
              DataInt := Int(DataStr);
            end;{SQLITE_TEXT:}
          else
            DataStr := '';
            DataInt := 0;
          end;{case DataType}
        end;{with Table}
    end;{while sqlite3_step}
  finally
    Database.Finalize(Query);
  end;{try...finally}
end;{TDatabase.TTable.Create}

destructor TDatabase.TTable.Destroy;
begin
  Database.CriticalSection.Leave;

  inherited;
end;{TDatabase.TTable.Destroy}

function TDatabase.TTable.Empty: Boolean;
begin
  Result := length(Table) = 0;
end;{TDatabase.Empty}

function TDatabase.TTable.Column(Name: AnsiString): Integer;
var
  i: Integer;
begin
  Name := lower(Name);

  for i := 0 to length(ColumnNames) - 1 do
    if Name = ColumnNames[i] then exit(i);

  Result := -1;
end;{TDatabase.TTable.Column}

function TDatabase.TTable.Value(Name: AnsiString; Row: Integer = 0; Default: AnsiString = ''): AnsiString;
var
  i: Integer;
begin
  i := Column(Name);
  if i = -1 then exit(Default);

  Result := Table[Row][i].DataStr;
end;{TDatabase.TTable.Value(AnsiString}

function TDatabase.TTable.Value(Name: AnsiString; Row: Integer = 0; Default: Integer = 0): Integer;
var
  i: Integer;
begin
  i := Column(Name);
  if i = -1 then exit(Default);

  Result := Table[Row][i].DataInt;
end;{TDatabase.TTable.Value(Integer}

constructor TDatabase.Create(AFileName: AnsiString);
begin
  inherited Create;

  CriticalSection.Create;

  FileName := AFileName;

  Transaction := False;

  if sqlite3_open(PAnsiChar(FileName), DB) <> SQLITE_OK then
    Error(['Failed to open database "', FileName, '"']);
end;{TDatabase.Create}

destructor TDatabase.Destroy;
begin
  if DB <> nil then
  begin
    if Transaction then
      EndTransaction(True);

    sqlite3_close(DB);
    DB := nil;
  end;{if DB <> nil}

  CriticalSection.Free;

  inherited;
end;{TDatabase.Destroy}

function TDatabase.Prepare(SQL: AnsiString): TSQLiteQuery;
var
  NextQuery: PAnsiChar;
begin
  if DB = nil then exit(nil);

{$IFDEF LOG_SQL}
  Server.Log(['Database (', FileName, ') ', SQL]);
{$ENDIF LOG_SQL}

  if sqlite3_prepare(DB, PAnsiChar(SQL), -1, Result, NextQuery) <> SQLITE_OK then
    if Result <> nil then
      Finalize(Result);
end;{TDatabase.Prepare}

procedure TDatabase.Finalize(var Query: TSQLiteQuery);
begin
  if Query = nil then exit;

  sqlite3_finalize(Query);
  Query := nil;
end;{TDatabase.Finalize}

function TDatabase.Query(SQL: AnsiString): Boolean;
var
  Query: TSQLiteQuery;
begin
  CriticalSection.Enter;
  try
    Query := Prepare(SQL);
    if Query = nil then exit(False);

    Result := sqlite3_step(Query) = SQLITE_DONE;
  finally
    Finalize(Query);

    CriticalSection.Leave;
  end;{try...finally}
end;{TDatabase.Query}

function TDatabase.QueryTable(SQL: AnsiString): TTable;
begin
  Result := TTable.Create(Self, SQL);
end;{TDatabase.QueryTable}

function TDatabase.TableExists(Name: AnsiString): Boolean;
begin
  with QueryTable('SELECT `sql` FROM `sqlite_master` WHERE `type` = "table" AND `name` = "' + Name + '";') do try
    Result := not Empty;
  finally
    Free;
  end;{with QueryTable..}
end;{TDatabase.TableExists}

function TDatabase.BeginTransaction: Boolean;
begin
  CriticalSection.Enter;
  try
    if Transaction then exit(False);

    Result := Query('BEGIN TRANSACTION;');
    if Result then Transaction := True;
  finally
    CriticalSection.Leave;
  end;{try...finallly}
end;{TDatabase.BeginTransaction}

function TDatabase.EndTransaction(Rollback: Boolean = False): Boolean;
begin
  CriticalSection.Enter;
  try
    //if not Transaction then exit(False);

    if Rollback then
      Result := Query('ROLLBACK;')
    else
      Result := Query('COMMIT;');

    if Result then Transaction := False;
  finally
    CriticalSection.Leave;
  end;{try...finally}
end;{TDatabase.EndTransaction}

constructor TINIFile.Create(AFileName: AnsiString);
begin
  inherited Create;

  FileName := AFileName;

  CriticalSection.Create;
end;{TINIFile.Create}

destructor TINIFile.Destroy;
begin
  CriticalSection.Free;

  inherited;
end;{TINIFile.Destroy}

function TINIFile.Read(Section, Key: AnsiString; Default: AnsiString = ''): AnsiString;
begin
  CriticalSection.Enter;

  try
    SetLength(Result, 256);
    SetLength(Result, GetPrivateProfileStringA(PAnsiChar(Section), PAnsiChar(Key), PAnsiChar(Default), PAnsiChar(Result), length(Result), PAnsiChar(FileName)));
  finally
    CriticalSection.Leave;
  end;{try...finally}

{$IFDEF LOG_CONFIG}
  Server.Log(['Configuration (', FileName, ') [', Section, '] ', Key ,'=', Result]);
{$ENDIF LOG_CONFIG}
end;{TINIFile.Read(String}

function TINIFile.Read(Section, Key: AnsiString; Default: Integer = 0): Integer;
begin
  Result := Int(Read(Section, Key, Str(Default)));
end;{TINIFile.Read(Integer}

function TINIFile.Read(Section, Key: AnsiString; Default: Boolean = False): Boolean;
begin
  Result := Bool(Read(Section, Key, Str(Default)));
end;{TINIFile.Read(Boolean}

constructor TArray<T>.Create;
begin
  inherited Create;

  Clear;
end;{TArray<T>.Create}

destructor TArray<T>.Destroy;
begin
  Clear;

  inherited;
end;{TArray<T>.Destroy}

function TArray<T>.Find(Item: T): Integer;
var
  i: Integer;
begin
  for i := 0 to high(Items) do
    if Items[i] = Item then exit(i);

  Result := -1;
end;{TArray<T>.Add}

function TArray<T>.Add(Item: T): Integer;
begin
  Result := Find(Item);

  if Result = -1 then
  begin
    SetLength(Items, length(Items) + 1);
    Result := high(Items);
    Items[Result] := Item;
  end;{if Result = -1}
end;{TArray<T>.Add}

function TArray<T>.Remove(Item: T): Integer;
begin
  Result := Find(Item);
  if Result = -1 then exit;

  if Result < high(Items) then
    move(Items[Result + 1], Items[Result], sizeof(T) * (length(Items) - 1));

  SetLength(Items, length(Items) - 1);
end;{TArray<T>.Remove}

procedure TArray<T>.Clear;
begin
  SetLength(Items, 0);
end;{TArray<T>.Clear}

procedure TSHA256.Init;
begin
  Hash.A := $6a09e667;
  Hash.B := $bb67ae85;
  Hash.C := $3c6ef372;
  Hash.D := $a54ff53a;
  Hash.E := $510e527f;
  Hash.F := $9b05688c;
  Hash.G := $1f83d9ab;
  Hash.H := $5be0cd19;

  FillChar(Buffer, sizeof(Buffer), 0);

  Index := 0;
  MLen  := 0;
end;{TSHA256.Init}

procedure TSHA256.Compress;
var
  a, b, c, d, e, f, g, h: Cardinal;
  t1, t2: Cardinal;
  W: array[0..63] of Cardinal;
  i: longword;
begin
  Index:= 0;

  Move(Buffer,W,Sizeof(Buffer));

  a := Hash.A;
  b := Hash.B;
  c := Hash.C;
  d := Hash.D;
  e := Hash.E;
  f := Hash.F;
  g := Hash.G;
  h := Hash.H;

  for i:= 0 to 15 do
    W[i] := bswap(W[i]);

  for i:= 16 to 63 do
    W[i] := (((W[i - 2] shr 17) or (W[i - 2] shl 15)) xor ((W[i - 2] shr 19) or
            (W[i - 2] shl 13)) xor (W[i - 2] shr 10)) + W[i - 7] + (((W[i - 15]
            shr 7) or (W[i - 15] shl 25)) xor ((W[i - 15] shr 18) or (W[i - 15]
            shl 14)) xor (W[i - 15] shr 3)) + W[i - 16];

  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $428a2f98 + W[0];  t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $71374491 + W[1];  t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $b5c0fbcf + W[2];  t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $e9b5dba5 + W[3];  t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $3956c25b + W[4];  t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $59f111f1 + W[5];  t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $923f82a4 + W[6];  t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $ab1c5ed5 + W[7];  t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $d807aa98 + W[8];  t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $12835b01 + W[9];  t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $243185be + W[10]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $550c7dc3 + W[11]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $72be5d74 + W[12]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $80deb1fe + W[13]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $9bdc06a7 + W[14]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $c19bf174 + W[15]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $e49b69c1 + W[16]; t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $efbe4786 + W[17]; t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $0fc19dc6 + W[18]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $240ca1cc + W[19]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $2de92c6f + W[20]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $4a7484aa + W[21]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $5cb0a9dc + W[22]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $76f988da + W[23]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $983e5152 + W[24]; t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $a831c66d + W[25]; t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $b00327c8 + W[26]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $bf597fc7 + W[27]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $c6e00bf3 + W[28]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $d5a79147 + W[29]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $06ca6351 + W[30]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $14292967 + W[31]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $27b70a85 + W[32]; t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $2e1b2138 + W[33]; t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $4d2c6dfc + W[34]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $53380d13 + W[35]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $650a7354 + W[36]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $766a0abb + W[37]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $81c2c92e + W[38]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $92722c85 + W[39]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $a2bfe8a1 + W[40]; t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $a81a664b + W[41]; t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $c24b8b70 + W[42]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $c76c51a3 + W[43]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $d192e819 + W[44]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $d6990624 + W[45]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $f40e3585 + W[46]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $106aa070 + W[47]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $19a4c116 + W[48]; t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $1e376c08 + W[49]; t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $2748774c + W[50]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $34b0bcb5 + W[51]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $391c0cb3 + W[52]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $4ed8aa4a + W[53]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $5b9cca4f + W[54]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $682e6ff3 + W[55]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;
  t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $748f82ee + W[56]; t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); h := t1 + t2; d := d + t1;
  t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $78a5636f + W[57]; t2:= (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); g := t1 + t2; c := c + t1;
  t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $84c87814 + W[58]; t2:= (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); f := t1 + t2; b := b + t1;
  t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $8cc70208 + W[59]; t2:= (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); e := t1 + t2; a := a + t1;
  t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $90befffa + W[60]; t2:= (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); d := t1 + t2; h := h + t1;
  t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $a4506ceb + W[61]; t2:= (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); c := t1 + t2; g := g + t1;
  t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $bef9a3f7 + W[62]; t2:= (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); b := t1 + t2; f := f + t1;
  t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $c67178f2 + W[63]; t2:= (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); a := t1 + t2; e := e + t1;

  inc(Hash.A, a);
  inc(Hash.B, b);
  inc(Hash.C, c);
  inc(Hash.D, d);
  inc(Hash.E, e);
  inc(Hash.F, f);
  inc(Hash.G, g);
  inc(Hash.H, h);

  FillChar(W,Sizeof(W),0);
  FillChar(Buffer,Sizeof(Buffer),0);
end;{TSHA256.Compress}

procedure TSHA256.Update(Data: Pointer; Len: Integer);
var
  i: Integer;
begin
  inc(MLen, Int64(Cardinal(Len) shl 3));

  while Len > 0 do
  begin
    i := 64 - Index;

    if i <= Len then
    begin
      move(Data^, Buffer[Index], i);
      dec(Len, i);
      inc(Integer(Data), i);
      Compress;
      Index := 0;
    end{if i <= Len}
    else
    begin
      move(Data^, Buffer[Index], Len);
      inc(Index, Len);
      break;
    end;{else}
  end;{while Len > 0}
end;{TSHA256.Update}

function TSHA256.Done: AnsiString;
const
  HexChar: array[0..15] of AnsiChar = '0123456789ABCDEF';
type
  TInt64 = packed record
    Lo, Hi: Cardinal;
  end;{TInt64}
var
  i:       Integer;
  PResult: PAnsiChar;
  Digest:  array[0..31] of Byte;
begin
  Buffer[Index] := $80;

  fillchar(Buffer[Index + 1], 63 - Index, 0);

  if Index >= 56 then
  begin
    Compress;
    fillchar(Buffer, 56, 0);
  end;{if Index >= 56}

  PInteger(@Buffer[56])^ := bswap(TInt64(MLen).Hi);
  PInteger(@Buffer[60])^ := bswap(TInt64(MLen).Lo);

  Compress;

  bswap256(@Hash, @Digest);

  Setlength(Result, sizeof(Digest) * 2);
  PResult := PAnsiChar(Result);

  for i := 0 to sizeof(Digest) - 1 do
  begin
    PResult[0] := HexChar[Digest[I] shr 4];
    PResult[1] := HexChar[Digest[I] and 15];
    inc(PResult,2);
  end;{for i}
end;{TSHA256.Done}

class function TSHA256.HashStr(S: AnsiString): AnsiString;
var
  SHA256: TSHA256;
begin
  SHA256.Init;
  SHA256.Update(PAnsiChar(S), length(S));
  Result := SHA256.Done;
end;{class)TSHA256.HashStr}

class constructor Server.Create;
const
  Banner = ' .       .       __  __  ___   __  _    _'#13#10' \`-"''"-''/      '+
    '(  \/  )(  _) /  \( \/\/ )'#13#10'  } o o {    -   )    (  ) _)( () )\    '+
    '/'#13#10' =.  Y  ,=      (_/\/\_)(___) \__/  \/\/'#13#10'   /-O-\  .'#13#10+
    '  /     \  )          Mini EO? WOW!'#13#10' (  )-(  )/ Created by Sordie o'+
    'ut of boredom'#13#10'  ""   ""';
var
  WSAData: TWSAData;
  AddrIn:  TSockAddrIn;
begin
  Writeln(Banner);

  CriticalSection.Create;

  Sessions := TArray<TSession>.Create;

  WSAStartup(MakeLong(2, 2), WSAData);

  Configuration := TINIFile.Create('.\MEOW.ini');

  Database := TDatabase.Create(Configuration.Read('database', 'name', '.\MEOW.db'));
  //Database.Query('DROP TABLE `accounts`;');

  if not Database.TableExists('accounts') then
  begin
    Log(['Creating accounts database']);

    if not Database.Query('CREATE TABLE `accounts` (' +
        '`id` INTEGER PRIMARY KEY, ' +
        '`name` VARCHAR (' + Str(NameMax) + '), ' +
        '`password` VARCHAR (64), ' +
        '`x` INTEGER, ' +
        '`y` INTEGER, ' +
        '`d` INTEGER, ' +
        '`s` INTEGER, ' +
        '`admin` INTEGER, ' +
        '`tag` VARCHAR (3), ' +
        '`sex` INTEGER, '  +
        '`hairstyle` INTEGER, ' +
        '`haircolour` INTEGER, ' +
        '`race` INTEGER, ' +
        '`class` INTEGER, ' +
        '`title` VARCHAR (64), ' +
        '`home` VARCHAR (64), ' +
        '`partner` VARCHAR (' + Str(NameMax) + '), ' +
        '`guild` VARCHAR (64), ' +
        '`rank` VARCHAR (64), ' +
        '`boots` INTEGER, ' +
        '`armour` INTEGER, ' +
        '`hat` INTEGER, ' +
        '`shield` INTEGER, ' +
        '`weapon` INTEGER' +
      ');') then
      Error(['Failed to create table']);
  end;{if not Database.TableExists}

  PacketQueue.Enabled := Configuration.Read('packetqueue', 'enabled', True);
  if PacketQueue.Enabled then
    PacketQueue.Size := Configuration.Read('packetqueue', 'size', 10);

  Socket := WinSock.socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  if Socket = 0 then
    Error(['Failed to create socket']);

  Connection.Bind    := Configuration.Read('connection', 'bind',    '0.0.0.0');
  Connection.Port    := Configuration.Read('connection', 'port',    8078);
  Connection.Timeout := Configuration.Read('connection', 'timeout', 180000);

  FillChar(AddrIn, sizeof(AddrIn), 0);
  with AddrIn do
  begin
    sin_family      := AF_INET;
    sin_addr.S_addr := inet_addr(PAnsiChar(Connection.Bind));
    sin_port        := htons(Connection.Port);
  end;{with AddrIn}
  if bind(Socket, AddrIn, sizeof(AddrIn)) <> 0 then
    Error(['Failed to bind socket']);

  if listen(Socket, 0) <> 0 then
    Error(['Cannot listen on socket']);

  ItemData  := TItemData. Create(Configuration.Read('data', 'item',  '.\dat001.eif'));
  NPCData   := TNPCData.  Create(Configuration.Read('data', 'npc',   '.\dtn001.enf'));
  SpellData := TSpellData.Create(Configuration.Read('data', 'spell', '.\dsl001.esf'));
  ClassData := TClassData.Create(Configuration.Read('data', 'class', '.\dat001.ecf'));
  MapData   := TMapData.  Create(Configuration.Read('data', 'map',   '.\00001.emf'));

  Defaults.X := Configuration.Read('defaults', 'x', 10);
  Defaults.Y := Configuration.Read('defaults', 'y', 10);
  Defaults.D := Configuration.Read('defaults', 'd', 0);

  Connection.BytesIn  := 0;
  Connection.BytesOut := 0;

  UpdateCaption;

  try
    Main;
  except
    Log(['Server Exception']);
  end;{try...except}
end;{class)Server.Create}

class destructor Server.Destroy;
begin
  if Socket <> 0 then
  begin
    closesocket(Socket);
    Socket := 0;
  end;{if Socket <> 0}

  Sessions.Free;

  ItemData.Free;
  NPCData.Free;
  SpellData.Free;
  ClassData.Free;
  MapData.Free;

  Configuration.Free;
  Database.Free;

  CriticalSection.Free;
  Readln;
end;{class)Server.Destroy}

class procedure Server.Main;
var
  FDSet:    TFDSet;
  SockSize: Integer;
  SockAddr: TSockAddr;
begin
  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 Socket = 0;
end;{class)Server.Main}

class procedure Server.Log(Params: array of const; Prefix: AnsiString = '');
var
  i: Integer;
begin
  CriticalSection.Enter;
  try
    if length(Prefix) > 0 then
      Write(Prefix + ' ');

    for i := 0 to high(Params) do
      with TVarRec(Params[i]) do
        case VType of
          vtInteger:       Write(VInteger);
          vtBoolean:       Write(VBoolean);
          vtChar:          Write(VChar);
          vtWideChar:      Write(VWideChar);
          vtExtended:      Write(VExtended^);
          vtString:        Write(AnsiString(VString));
          vtPointer:       Write(Cardinal(VPointer));
          vtPChar:         Write(AnsiString(VPChar));
          vtObject:        Write(VObject.ClassName);
          vtClass:         Write(VClass.ClassName);
          vtPWideChar:     Write(WideString(VPWideChar));
          vtWideString:    Write(WideString(VWideString));
          vtInt64:         Write(VInt64^);
          vtUnicodeString: Write(String(VUnicodeString));
          vtAnsiString:    Write(AnsiString(VAnsiString));
        else
          Write('?(', VType, ')');
        end;{case VType}
  finally
    Writeln;
    CriticalSection.Leave;
  end;{try...finally}
end;{class)Server.Log}

class procedure Server.Send(var Packet: TPacket; Sender: TSession = nil; Ranged: Boolean = True);
var
  Session: TSession;
begin
  CriticalSection.Enter;
  try
    for Session in Sessions.Items do
      if (Session <> Sender) and Session.LoggedIn then
      begin
        if Ranged and (Sender <> nil) and
          ((Session.X < (Sender.X - ViewRange)) or (Session.X > (Sender.X + ViewRange)) or
           (Session.Y < (Sender.Y - ViewRange)) or (Session.Y > (Sender.Y + ViewRange))) then
          continue;

        Session.Send(Packet);
      end;{if (Session <> Sender)}
  finally
    CriticalSection.Leave;
  end;{try...finally}
end;{Server.Send}

class procedure Server.UpdateCaption;
begin
  CriticalSection.Section(procedure
  var
    NewCaption: AnsiString;
  begin
    NewCaption := 'MEOW - ' +
      Str(length(Sessions.Items)) + ' Connection(s) - ' +
      Scale(Connection.BytesIn)  + ' in / ' +
      Scale(Connection.BytesOut) + ' out';

    if NewCaption <> Caption then
    begin
      Caption := NewCaption;
      SetConsoleTitleA(PAnsiChar(Caption));
    end;{if NewCaption <> Caption}
  end);{CriticalSection.Section}
end;{class)Server.Update}

class function Server.GetSessionByID(ID: Cardinal): TSession;
var
  Session: TSession;
begin
  CriticalSection.Enter;
  try
    for Session in Sessions.Items do
      if Session.ID = ID then exit(Session);

    Result := nil;
  finally
    CriticalSection.Leave;
  end;{try...finally}
end;{class)Server.GetSessionByID}

class function Server.GetSessionByName(Name: AnsiString): TSession;
var
  Session: TSession;
begin
  Name := Lower(Name);

  CriticalSection.Enter;
  try
    for Session in Sessions.Items do
      if Session.Name = Name then exit(Session);

    Result := nil;
  finally
    CriticalSection.Leave;
  end;{try...finally}
end;{Server.GetSessionByName}

class function Server.ValidName(Name: AnsiString): Boolean;
var
  c: AnsiChar;
begin
  if (length(Name) < 3) or (length(Name) > NameMax) then exit(False);

  for c in Name do
    if pos(String(c), NameChars) = 0 then
      exit(False);

  Result := True;
end;{class)Server.ValidName}

class function Server.GetAccount(Name: AnsiString; Items: AnsiString = '*'): TDatabase.TTable;
begin
  Result := Database.QueryTable('SELECT ' + Items + ' FROM `accounts` WHERE `name` = "' + Name + '";');
end;{class)Server.GetAccount}

class function Server.AccountExists(Name: AnsiString): Boolean;
begin
  with GetAccount(Name, '`id`') do try
    Result := length(Table) > 0
  finally
    Free;
  end;{with GetAccount}
end;{class)Server.AccountExists}

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

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

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

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

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

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

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

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

procedure Server.TPacket.AddBreakString(s: AnsiString);
begin
  Data := Data + s + #$FF;
end;{Server.TPacket.AddBreakString}

procedure Server.TPacket.AddString(s: AnsiString);
begin
  Data := Data + s;
end;{Server.TPacket.AddString}

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

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

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

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

function Server.TPacket.GetInt2: Word;
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;{Server.TPacket.GetInt2}

function Server.TPacket.GetInt3: Cardinal;
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;{Server.TPacket.GetInt3}

function Server.TPacket.GetInt4: Cardinal;
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;{Server.TPacketGetInt4}

function Server.TPacket.GetBreakString: AnsiString;
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;{Server.TPacket.GetBreakString}

function Server.TPacket.GetString(Len: Integer = -1): AnsiString;
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;{Server.TPacket.GetString}

constructor Server.TGameData.Create(AFileName: AnsiString);
begin
  inherited Create;

  FileName := AFileName;
  Load;
end;{Server.TGameData.Create}

function Server.TGameData.Load: Boolean;
var
  l: Cardinal;
  f: THandle;
begin
  f := CreateFileA(PAnsiChar(FileName), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if f = 0 then exit(False);

  try
    l := SetFilePointer(f, 0, nil, FIlE_END);
    if (l = Cardinal(-1)) or (l < 10) then exit(False);

    SetLength(Data, l);

    SetFilePointer(f, 0, nil, FILE_BEGIN);
    ReadFile(f, Data[1], l, 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]);

    Result := True;
  finally
    CloseHandle(f);
  end;{try...finally}
end;{Server.TGameData.Load}

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

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

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

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

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

function SessionThread(Session: Server.TSession): Integer;
begin
  Result := 0;

  try
    try
      while Session.Execute do
        Sleep(1);
    except
      Server.Log(['Session exception']);
    end;{try...except}
  finally
    Server.CriticalSection.Enter;
    try Session.Free; except end;
    Server.CriticalSection.Leave;

    EndThread(Result);
  end;{try...finally}
end;{SessionThread}

constructor Server.TSession.Create(ASocket: TSocket);
var
  i:    Integer;
  Addr: TSockAddr;
begin
  inherited Create;

  Initialized := False;
  LoggedIn    := False;

  Unload;

  Socket := ASocket;

  if Socket <> 0 then
  begin
    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;

    i := 1;
    ioctlsocket(Socket, FIONBIO, i);
  end;{if Socket}

  Server.CriticalSection.Section(procedure
  begin
    ID := 100;
    while Server.GetSessionByID(ID) <> nil do inc(ID);

    Server.Sessions.Add(Self);
  end);{Server.CriticalSection.Section}

  Packet.Time := GetTickCount + Server.Connection.Timeout;

  BeginThread(nil, 0, @SessionThread, Pointer(Self), 0, Thread);

  Log(['Created']);

  Server.UpdateCaption;
end;{Server.TSession.Create}

destructor Server.TSession.Destroy;
begin
  Logout;

  if Socket <> 0 then
  begin
    closesocket(Socket);
    Socket := 0;
  end;{if Socket <> 0}

  Server.CriticalSection.Section(procedure
  begin
    Server.Sessions.Remove(Self);
  end);{Server.CriticalSection.Section}

  Log(['Destroyed']);

  inherited;

  Server.UpdateCaption;
end;{Server.TSession.Destroy}

function Server.TSession.Sync(Discard: Boolean = False): Boolean;
var
  SQL: AnsiString;
begin
  if length(Name) = 0 then exit(False);

  if Discard then
    with Server.GetAccount(Name) do try
      if length(Table) = 0 then exit(False);

      Password := Value('password', 0, '');
      if length(Password) = 0 then exit(False);

      X := Value('x', 0, Server.Defaults.X);
      Y := Value('y', 0, Server.Defaults.Y);
      D := Value('d', 0, Server.Defaults.D);
      S := Value('s', 0, 0);
      Admin      := Value('admin', 0, 0);
      Tag        := copy(Value('tag', 0, ''), 1, 3);
      Sex        := Value('sex',        0, 0);
      HairStyle  := Value('hairstyle',  0, 0);
      HairColour := Value('haircolour', 0, 0);
      Race       := Value('race',       0, 0);
      ClassID    := Value('class',      0, 0);
      Title      := Value('title',      0, '');
      Home       := Value('home',       0, '');
      Partner    := Value('partner',    0, '');
      Guild      := Value('guild',      0, '');
      Rank       := Value('rank',       0, '');
      Boots      := Value('boots',      0, 0);
      Armour     := Value('armour',     0, 0);
      Hat        := Value('hat',        0, 0);
      Shield     := Value('shield',     0, 0);
      Weapon     := Value('weapon',     0, 0);

      Result := True;
    finally
      Free;
    end{with Server.GetAccount}
  else
  begin
    if not Server.AccountExists(Name) then
    begin
      SQL := 'INSERT INTO `accounts` (`name`) VALUES ("' + Name + '");';
      Result := Server.Database.Query(SQL);
      if not Result then
      begin
        Log(['Failed to insert into database']);
        exit;
      end;{if not Result}
    end;{if not Server.AccountExists}

    SQL := 'UPDATE `accounts` SET ' +
      '`password` = "' + Password + '", ' +
      '`x` = ' + Str(X) + ', ' +
      '`y` = ' + Str(Y) + ', ' +
      '`d` = ' + Str(D) + ', ' +
      '`s` = ' + Str(S) + ', ' +
      '`admin` = ' + Str(Admin) + ', ' +
      '`tag` = "' + Tag + '", ' +
      '`sex` = ' + Str(Sex) + ', ' +
      '`hairstyle` = ' + Str(HairStyle) + ', ' +
      '`haircolour` = ' + Str(HairColour) + ', ' +
      '`race` = ' + Str(Race) + ', ' +
      '`class` = ' + Str(ClassID) + ', ' +
      '`title` = "' + Title + '", ' +
      '`home` = "' + Home + '", ' +
      '`partner` = "' + Partner + '", ' +
      '`guild` = "' + Guild + '", ' +
      '`rank` = "' + Rank + '", '+
      '`boots` = ' + Str(Boots) + ', ' +
      '`armour` = ' + Str(Armour) + ', ' +
      '`hat` = ' + Str(Hat) + ', ' +
      '`shield` = ' + Str(Shield) + ', ' +
      '`weapon` = ' + Str(Weapon) +
      ' WHERE `name` = "' + Name + '";';

    Result := Server.Database.Query(SQL);

    if not Result then Log(['Database sync failed']);
  end{else}
end;{Server.TSession.Sync}

procedure Server.TSession.Unload;
begin
  Name     := '';
  Password := '';
  LoggedIn := False;
end;{Server.TSession.Unload}

procedure Server.TSession.Log(Params: array of const);
begin
  Server.Log(Params, 'Session (' + IPStr + ')');
end;{Server.TSession.Log}

procedure Server.TSession.Send(var 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, Server.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], Size, 0);
  InterlockedExchangeAdd64(Server.Connection.BytesOut, Size);
  Server.UpdateCaption;
end;{Server.TSession.Send}

procedure Server.TSession.Send(Raw: Boolean = False);
begin
  Send(Packet.Send, Raw);
end;{Server.TSession.Send}

procedure Server.TSession.SendData(Data: TGameData);
var
  Packet: Server.TPacket;
begin
  Packet.SetID(Server.PacketFamilyRaw, Server.PacketActionRaw);

  Packet.AddInt1(Data.DataID);

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

  Packet.AddString(Data.Data);

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

procedure Server.TSession.Login;
var
  Packet: TPacket;
begin
  Packet.SetID(Server.PacketFamilyGameState, Server.PacketActionReply);

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

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

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

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

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

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

  Packet.AddBreakString(Name);
  Packet.AddBreakString(Title);
  Packet.AddBreakString(Guild);
  Packet.AddBreakString(Rank);

  Packet.AddInt1(ClassID);

  Packet.AddString(copy(Tag + '   ', 1, 3)); // Tag

  Packet.AddInt1(Admin);  // 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($24);
  Packet.AddInt1($24);
  Packet.AddInt2($10);
  Packet.AddInt2($10);
  Packet.AddInt2(1);
  Packet.AddInt2(1);
  Packet.AddInt1(0);

  Packet.AddByte(255);

  Send(Packet);
end;{Server.TSession.Login}

procedure Server.TSession.Logout;
var
  Packet: TPacket;
begin
  if not LoggedIn then exit;

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

  Server.Send(Packet, Self);

  Sync;
  Unload;
end;{Server.TSession.Logout}

procedure Server.TSession.BuildCharacterPacket(var Packet: TPacket);
begin
  Packet.AddBreakString(Name);

  Packet.AddInt2(ID);

  if LoggedIn then
  begin
    Packet.AddInt2(1);
    Packet.AddInt2(X);
    Packet.AddInt2(Y);
  end{if LoggedIn}
  else
  begin
    Packet.AddInt2(0);
    Packet.AddInt2(0);
    Packet.AddInt2(0);
  end;{else}

  Packet.AddInt1(D);
  Packet.AddInt1(ClassID);
  Packet.AddString(copy(Tag + '   ', 1, 3));
  Packet.AddInt1(0);  // Level
  Packet.AddInt1(Sex);
  Packet.AddInt1(HairStyle);
  Packet.AddInt1(HairColour);
  Packet.AddInt1(Race);
  Packet.AddInt2(10); // MaxHP
  Packet.AddInt2(10); // HP
  Packet.AddInt2(10); // MaxTP
  Packet.AddInt2(10); // TP

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

  Packet.AddInt1(S);

  if LoggedIn then
    Packet.AddInt1(0) // Hidden
  else
    Packet.AddInt1(1);
end;{Server.TSession.BuildCharacterPacket}

procedure Server.TSession.Refresh;
var
  Packet: TPacket;
begin
  Packet.SetID(Server.PacketFamilyPlayers, Server.PacketActionRemove);
  Packet.AddInt2(ID);

  Server.Send(Packet);

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

  Server.Send(Packet);
end;{Server.TSession.Refresh}

function Server.TSession.Walk(Direction: Integer; Admin: Boolean = False; Ghost: Boolean = False): Boolean;
var
  i:          Integer;
  State:      Integer;
  NewX, NewY: Integer;
  PacketShow: TPacket;
  PacketHide: TPacket;
  PacketWalk: TPacket;
  PacketChar: TPacket;
  Session:    TSession;
  NewCoords:  array[-Server.ViewRange..Server.ViewRange] of TPoint;
  OldCoords:  array[-Server.ViewRange..Server.ViewRange] 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 ', Direction]);
    exit(False);
  end;{case Direction}

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

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

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

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

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

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

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

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

  Server.CriticalSection.Enter;
  try
    for Session in Server.Sessions.Items do
      if (Session <> Self) and Session.LoggedIn and
         (Session.X >= (X - Server.ViewRange)) and (Session.X <= (X + Server.ViewRange)) and
         (Session.Y >= (Y - Server.ViewRange)) and (Session.Y <= (Y + Server.ViewRange)) and
         (length(Session.Name) > 0) then
      begin
        State := 0;

        for i := -Server.ViewRange to Server.ViewRange 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
            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
            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
    Server.CriticalSection.Leave;
  end;{try...finally}

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

function Server.TSession.Face(Direction: Integer): Boolean;
var
  Packet: TPacket;
begin
  if (Direction < 0) or (Direction > 3) then
  begin
    Log(['Invalid face direction ', Direction]);
    exit(False);
  end;{if Direction..}

  D := Direction;

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

  Server.Send(Packet, Self);

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

function Server.TSession.Say(Text: AnsiString): Boolean;
  function StartsWith(wth: AnsiString): Boolean;
  begin
    Result := lower(copy(Text, 1, length(wth))) = wth;
    if Result then Text := copy(Text, length(wth) + 1, length(Text));
  end;{StartsWith}
var
  Packet: TPacket;
begin
  if length(Text) = 0 then exit(False);

  Result := True;

       if StartsWith('=hairstyle')  then HairStyle  := Int(Text)
  else if StartsWith('=haircolour') then HairColour := Int(Text)
  else if StartsWith('=sex')        then Sex        := Int(Text)
  else if StartsWith('=race')       then Race       := Int(Text)

  else if StartsWith('=admin') then Admin := Int(Text)

  else if StartsWith('=tag') then Tag := copy(Text, 1, 3)

  else if StartsWith('=armour') then Armour := Int(Text)
  else if StartsWith('=boots')  then Boots  := Int(Text)
  else if StartsWith('=hat')    then Hat    := Int(Text)
  else if StartsWith('=shield') then Shield := Int(Text)
  else if StartsWith('=weapon') then Weapon := Int(Text)

  else
  begin
    Text := copy(Text, 1, Server.TextLength);

    Packet.SetID(PacketFamilyTalk, PacketActionPlayer);

    Packet.AddInt2(ID);
    Packet.AddString(Text);

    Server.Send(Packet, Self);
    exit;
  end;{else}

  Refresh;
end;{Server.TSession.Say}

function Server.TSession.Execute: Boolean;
  procedure QueuePacket(Time: Cardinal);
  begin
    if length(Packet.Queue.Items) = Server.PacketQueue.Size then
    begin
      Log(['Packet queue full']);
      Initialized := False;
      exit;
    end;{if length(Packet.Queue.Items}

    SetLength(Packet.Queue.Items, length(Packet.Queue.Items) + 1);
    Packet.Queue.Items[high(Packet.Queue.Items)] := Packet.Receive;
    Packet.Queue.Items[high(Packet.Queue.Items)].Time := Time;
  end;{QueuePacket}

  function UnqueuePacket: Boolean;
  begin
    if (length(Packet.Queue.Items) = 0) or (GetTickCount < Packet.Queue.Time) then exit(False);

    Result := True;

    Packet.Receive := Packet.Queue.Items[high(Packet.Queue.Items)];
    SetLength(Packet.Queue.Items, length(Packet.Queue.Items) - 1);

    Packet.Queue.Time   := GetTickCount + Packet.Receive.Time;
    Packet.Receive.Time := GetTickCount;
  end;{UnqueuePacket}
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
  begin
    Log(['Connection dropped']);
    exit(False);
  end;{if (Socket = 0)..}

  if GetTickCount > Packet.Time then
  begin
    Log(['Connection timeout']);
    exit(False);
  end;{if GetTickCount}

  Packet.Queue.Active := UnqueuePacket;

  if not Packet.Queue.Active then
  begin
    if ioctlsocket(Socket, FIONREAD, i) = 0 then
    begin
      SetLength(ReadBuf, BufSize);

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

        InterlockedExchangeAdd64(Server.Connection.BytesIn, ReadLen);

        Packet.Buffer := Packet.Buffer + copy(ReadBuf, 1, ReadLen);
      until False;

      Server.UpdateCaption;
      Packet.Time := GetTickCount + Server.Connection.Timeout;
    end;{if ioctlsocket}

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

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

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

    if Size < 3 then exit(true);

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

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

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

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

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

      Packet.Receive.Data := FoldData(ReadBuf, ReceiveKey);
    end;{if Initialized}

    Packet.Receive.Family := ord(Packet.Receive.Data[2]);
    Packet.Receive.Action := ord(Packet.Receive.Data[1]);
    Packet.Receive.Data   := copy(Packet.Receive.Data, 3, length(Packet.Receive.Data));
    Packet.Receive.Time   := GetTickCount;

    if Packet.Receive.Family <> Server.PacketFamilyRaw then
    begin
      // Sequence
      Packet.Receive.GetByte;
    end;{if Packet.Receive.Family}
  end;{if not Packet.Queue.Active}

  Packet.Send.Reset;
  Packet.Send.SetID(Packet.Receive.Family, Server.PacketActionReply);

  i := Packet.Receive.Family;

  if (not Server.PacketQueue.Enabled) or Packet.Queue.Active then
    Dispatch(i)
  else
    case Packet.Receive.Family of
      0: ;
    else
      Dispatch(i)
    end;{case Packet.Receive.Family}

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

procedure Server.TSession.DefaultHandler(var Param);
begin
{$IFDEF LOG_UNHANDLED_PACKET_FAMILY}
  Log(['Unhandled packet family ', Packet.Receive.Family]);
{$ENDIF LOG_UNHANDLED_PACKET_FAMILY}
end;{Server.TSession.DefaultHandler}

procedure Server.TSession.UnhandledAction(Name: AnsiString = '');
begin
{$IFDEF LOG_UNHANDLED_PACKET_ACTION}
  if length(Name) = 0 then Name := 'family (' + Str(Packet.Receive.Family) + ')';
  Log(['Unhandled ' + Name + ' action ', Packet.Receive.Action]);
{$ENDIF LOG_UNHANDLED_PACKET_ACTION}
end;{Server.TSession.UnhandledAction}

procedure Server.TSession.HandleRaw(var Param);
  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;{AuthClient}
var
  Auth:   Integer;
  s1, s2: Byte;
  Ver:    array[0..2] of Byte;
  Seq:    Byte;
begin
  Packet.Send.SetID(Server.PacketFamilyRaw, Server.PacketActionRaw);

  Auth := Packet.Receive.GetInt3;

  Ver[0] := Packet.Receive.GetInt1;
  Ver[1] := Packet.Receive.GetInt1;
  Ver[2] := Packet.Receive.GetInt1;

  if (Ver[0] <> Server.RequiredVersion[0])
  or (Ver[1] <> Server.RequiredVersion[1])
  or (Ver[2] <> Server.RequiredVersion[2]) then
  begin
    Packet.Send.AddByte(1);
    Packet.Send.AddByte(Server.RequiredVersion[0] + 1);
    Packet.Send.AddByte(Server.RequiredVersion[1] + 1);
    Packet.Send.AddByte(Server.RequiredVersion[2] + 1);

    Log(['Invalid client version ', Ver[0], '.', Ver[1], '.', Ver[2]]);

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

  Packet.Receive.Discard(2);
  HDDSerial := Packet.Receive.GetString;

  //2 = ok
  //3 = ip permabanned
  //10 = some weird sound?
  Packet.Send.AddByte(2);

  Seq := 1 + Random(220);

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

  Packet.Send.AddByte(s1);
  Packet.Send.AddByte(s2);

  Log(['Initialized']);// s1:' + Str(s1) + ' s2:' + Str(s2)]);

  Packet.Send.AddByte(Server.SendKey);
  Packet.Send.AddByte(Server.ReceiveKey);

  Packet.Send.AddInt2(ID);

  Packet.Send.AddInt3(AuthClient(Auth));

  Send(True);

  Initialized := True;
end;{Server.TSession.HandleRaw}

procedure Server.TSession.HandleConnection;
  procedure HandleConnectionAccept;
  begin
    SendData(Server.ItemData);
    SendData(Server.NPCData);
    SendData(Server.SpellData);
    SendData(Server.ClassData);
  end;{HandleConnectionAccept}
begin
  case Packet.Receive.Action of
    Server.PacketActionAccept: HandleConnectionAccept;
  else
    UnhandledAction('connection');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleConnection}

procedure Server.TSession.HandleAccount;
const
  AccountReplyAlreadyExists = 1;
  AccountReplyNotApproved   = 2;
  AccountReplyCreated       = 3;
  AccountReplyChangeFailed  = 5;
  AccountReplyChanged       = 6;
  AccountReplyContinue      = 1000;

  function CheckAccount(AccountName: AnsiString): Boolean;
  begin
    Result := True;

    if False{AccountsDisabled} then

    else if not Server.ValidName(AccountName) then
    begin
      Packet.Send.AddInt2(AccountReplyNotApproved);
      Packet.Send.AddString('NO');
      Send;
    end{else if not Server.ValidName}

    else if Server.AccountExists(AccountName) then
    begin
      Packet.Send.AddInt2(AccountReplyAlreadyExists);
      Packet.Send.AddString('NO');
      Send;
    end{else if}

    else Result := False;
  end;{CheckAccount}

  procedure HandleAccountRequest;
  var
    AccountName: AnsiString;
  begin
    AccountName := Lower(Packet.Receive.GetString);

    if CheckAccount(AccountName) then exit;

    Packet.Send.AddInt2(AccountReplyContinue);
    Packet.Send.AddString('OK');
    Send;
  end;{HandleAccountRequest}

  procedure HandleAccountCreate;
  var
    AccountName: AnsiString;
  begin
    Packet.Receive.Discard(3);
    AccountName := Lower(Packet.Receive.GetBreakString);

    if CheckAccount(AccountName) then exit;

    Name     := AccountName;
    Password := TSHA256.HashStr(Packet.Receive.GetBreakString);

    {FullName     := }Packet.Receive.GetBreakString;
    {Location     := }Packet.Receive.GetBreakString;
    {EmailAddress := }Packet.Receive.GetBreakString;
    {ComputerName := }Packet.Receive.GetBreakString;

    if Packet.Receive.GetBreakString <> HDDSerial then
    begin
      Packet.Send.AddInt2(AccountReplyNotApproved);
      Packet.Send.AddString('NO');
      Send;
      exit;
    end;{if Packet.Receive.GetBreakString <> HDDSerial}

    Log(['Creating account']);

    X := Server.Defaults.X;
    Y := Server.Defaults.Y;
    D := Server.Defaults.D;

    Sync;

    Packet.Send.AddInt2(AccountReplyCreated);
    Packet.Send.AddString('OK');
    Send;
  end;{HandleAccountCreate}
begin
  case Packet.Receive.Action of
    Server.PacketActionRequest: HandleAccountRequest;
    Server.PacketActionCreate:  HandleAccountCreate;
  else
    UnhandledAction('account');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleAccount}

procedure Server.TSession.HandleLogin(var Param);
const
  LoginReplyUnknownUser     = 1;
  LoginReplyWrongPassword   = 2;
  LoginReplyOK              = 3;
  // 4 = clear input
  LoginReplyAlreadyLoggedIn = 5;

  procedure HandleLoginRequest;
  begin
    Server.CriticalSection.Section(procedure
    var
      User: AnsiString;
      Pass: AnsiString;
    begin
      User := Lower(Packet.Receive.GetBreakString);
      Pass := TSHA256.HashStr(Packet.Receive.GetBreakString);

      if GetSessionByName(User) <> nil then
      begin
        Unload;

        Packet.Send.AddInt2(LoginReplyAlreadyLoggedIn);
        Send;

        exit;
      end;{if GetSessionByName}

      Name := User;

      if not Sync(True) then
      begin
        Unload;

        Packet.Send.AddInt2(LoginReplyUnknownUser);
        Send;
      end{if not Sync(True)}
      else if Pass <> Password then
      begin
        Unload;

        Packet.Send.AddInt2(LoginReplyWrongPassword);
        Send;
      end{else if Pass <> Password}

      else Login;
    end);{Server.CriticalSection.Section}
  end;{HandleLoginRequest}
begin
  case Packet.Receive.Action of
    Server.PacketActionRequest: HandleLoginRequest;
  else
    UnhandledAction('login');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleLogin}

procedure Server.TSession.HandleGameState(var Param);
  procedure HandleGameStateAgree;
  var
    FileID: Byte;
  begin
    FileID := Packet.Receive.GetInt1;

    case FileID of
      1: SendData(Server.MapData);
      2: SendData(Server.ItemData);
      3: SendData(Server.NPCData);
      4: SendData(Server.SpellData);
      5: SendData(Server.ClassData);
    else
      Log(['Unknown file ID ', FileID]);
    end;{case FileID}
  end;{HandleGameStateAgree}

  procedure HandleGameStateMessage;
  var
    i: Integer;
  begin
    Packet.Send.AddInt2(2);
    Packet.Send.AddByte(255);

    Packet.Send.AddBreakString('MEOW');

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

    Packet.Send.AddByte(255);

    Packet.Send.AddInt1(0);  // Weight
    Packet.Send.AddInt1(50); // Max weight

    Packet.Send.AddByte(255); // Inventory
    Packet.Send.AddByte(255); // Spells

    LoggedIn := True;

    Server.CriticalSection.Section(procedure
    var
      p, Count: Integer;
      Session:  Server.TSession;
    begin
      p := length(Packet.Send.Data) + 1;
      Packet.Send.AddInt1(0);
      Packet.Send.AddByte(255);

      Count := 0;

      for Session in Server.Sessions.Items do
        if Session.LoggedIn then
        begin
          Session.BuildCharacterPacket(Packet.Send);
          Packet.Send.AddByte(255);
          inc(Count);
        end;{if Session.LoggedIn}

      Packet.Send.Data[p] := UnpackEOInt(Count)[1];
    end);{Server.CriticalSection.Section}

    Packet.Send.AddByte(255); // NPCs
    //Packet.Send.AddByte(255); // Items

    Send;

    Packet.Send.Reset;
    Packet.Send.SetID(Server.PacketFamilyPlayers, Server.PacketActionAgree);
    Packet.Send.AddByte(255);
    BuildCharacterPacket(Packet.Send);
    Packet.Send.AddInt1(1);
    Packet.Send.AddByte(255);
    Packet.Send.AddInt1(1);

    Server.Send(Packet.Send, Self);
  end;{HandleGameStateMessage}
begin
  case Packet.Receive.Action of
    Server.PacketActionRequest: Login;
    Server.PacketActionAgree:   HandleGameStateAgree;
    Server.PacketActionMessage: HandleGameStateMessage;
  else
    UnhandledAction('game state');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleGameState}

procedure Server.TSession.HandleWalk(var Param);
begin
  case Packet.Receive.Action of
    Server.PacketActionPlayer:  Walk(Packet.Receive.GetInt1);
    Server.PacketActionSpecial: Walk(Packet.Receive.GetInt1, False, True);
    Server.PacketActionAdmin:   Walk(Packet.Receive.GetInt1, True);
  else
    UnhandledAction('walk');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleWalk}

procedure Server.TSession.HandleFace(var Param);
begin
  case Packet.Receive.Action of
    Server.PacketActionPlayer: Face(Packet.Receive.GetInt1);
  else
    UnhandledAction('face');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleFace}

procedure Server.TSession.HandleRequest(var Param);
  procedure HandleRequestRequest;
  var
    RequestID: Integer;
    Session:   TSession;
  begin
    RequestID := Packet.Receive.GetInt2;

    Packet.Send.SetID(Server.PacketFamilyPlayers, Server.PacketActionRemove);
    Packet.Send.AddInt2(RequestID);
    Send;

    Packet.Send.Reset;
    Packet.Send.SetID(Server.PacketFamilyPlayers, Server.PacketActionAgree);
    Packet.Send.AddByte(255);

    Server.CriticalSection.Enter;
    try
      Session := Server.GetSessionByID(RequestID);
      if Session = nil then exit;

      Session.BuildCharacterPacket(Packet.Send);
    finally
      Server.CriticalSection.Leave;
    end;{try..finally}

    Packet.Send.AddInt1(1);
    Packet.Send.AddByte(255);
    Packet.Send.AddInt1(1);

    Send;
  end;{HandleRequestRequest}
begin
  case Packet.Receive.Action of
    Server.PacketActionRequest: HandleRequestRequest;
  else
    UnhandledAction('request');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleRequest}

procedure Server.TSession.HandleTalk(var Param);
begin
  case Packet.Receive.Action of
    Server.PacketActionReport: Say(Packet.Receive.GetBreakString);
  else
    UnhandledAction('talk');
  end;{case Packet.Receive.Action}
end;{Server.TSession.HandleTalk}

begin
  Server.Create;
end.