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

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

      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;
      procedure HandleLogin     (var Param); message Server.PacketFamilyLogin;
    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 var Caption: AnsiString;
    class procedure UpdateCaption;

    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 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 = (' bytes', ' 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 '+
    '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 (64)' +
      ');') 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;

  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;

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

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

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

      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` ' +
        ') values (' +
        '"' + Name      + '", ' +
        '"' + Password  + '"'   +
        ');';

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

procedure Server.TSession.Unload;
begin
  Name     := '';
  Password := '';
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(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}

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

    Writeln(Password);

    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
      Pass: AnsiString;
    begin
      Name := Packet.Receive.GetBreakString;
      Pass := TSHA256.HashStr(Packet.Receive.GetBreakString);

      // TODO: Check for logged in user

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

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

begin
  Server.Create;
end.