Pastebin

{(
 )) .       .      __  __  ___   __  _    _
((  \`-"'"-'/     (  \/  )(  _) /  \( \/\/ )
 ))  ) 6 6 (   -   )    (  ) _)( () )\    /
((  =.  Y  ,=     (_/\/\_)(___) \__/  \/\/
 ))   /^^^\  .
((   /     \  )         Mini EO? WOW!
 )) (  )-(  )/  Created by Sordie out of bordem
((   ""   ""
 )}

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>}

  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 PacketActionRaw     = 255;
    const PacketActionRequest = 1;
    const PacketActionAccept  = 2;
    const PacketActionReply   = 3;
    const PacketActionCreate  = 6;

    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}

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

      var Thread: THandle;

      var ID:          Cardinal;
      var Initialized: 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;

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

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

      procedure Log(Params: array of const);

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

      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;
    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 constructor Create;
    class destructor  Destroy;

    class procedure Main;

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

    class function GetSessionByID(ID: Cardinal): 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 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
  i: Integer;
  n: Boolean;
  w: AnsiString;
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(String(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}
end;{Int}

function Str(I: Integer): AnsiString; overload;
var
  x: Integer;
  f: Boolean;
  c: AnsiChar;
  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 := AnsiChar(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(Integer}

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}

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 '+
    'out of bordem'#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 (20),' +
        '`hddserial` VARCHAR (8)' +
      ');') then
      Error(['Failed to create table']);
  end;{if not Database.TableExists}

  Database.Query('INSERT INTO `accounts` (`name`) VALUES ("sordie");');
  Writeln(AccountExists('sordie'));
  Writeln(AccountExists('zordie'));

  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']);

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

  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;

  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 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.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}

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
    try
      Session.Free;
    except
      {}
    end;{try...except}

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

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

  Initialized := False;
  Name := '';

  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']);
end;{Server.TSession.Create}

destructor Server.TSession.Destroy;
begin
  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;
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);

      Result := True;
    finally
      Free;
    end{with Server.GetAccount}
  else
  begin
    if Server.AccountExists(Name) then
      SQL := 'UPDATE `accounts` SET ' +
        '`password`="' + Password + '" ' +
        ' WHERE `name`="' + Name + '";'
    else
      SQL := 'INSERT INTO `accounts` (' +
        '`name`,'     +
        '`password`,' +
        '`hddserial`' +
        ') values (' +
        '"' + Name      + '",' +
        '"' + Password  + '",' +
        '"' + HDDSerial + '"'  +
        ');';

    Result := Server.Database.Query(SQL);
  end{else}
end;{Server.TSession.Sync}

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

procedure Server.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, 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);
end;{Server.TSession.Send}

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

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;

      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;
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;

  Writeln(length(HDDSerial), HDDSerial);

  //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
    {}
  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;

  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;
  end;{HandleAccountRequest}

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

    if CheckAccount(AccountName) then exit;
  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}

begin
  Server.Create;
end.