delphimvcframework/lib/dmustache/SynCommons.pas

/// common functions used by most Synopse projects
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynCommons;

(*
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2019 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2019
  the Initial Developer. All Rights Reserved.

  Contributor(s):
   - Alan Chate
   - Aleksandr (sha)
   - Alfred Glaenzer (alf)
   - ASiwon
   - Chaa
   - BigStar
   - Eugene Ilyin
   - f-vicente
   - itSDS
   - Johan Bontes
   - kevinday
   - Maciej Izak (hnb)
   - Marius Maximus (mariuszekpl)
   - mazinsw
   - mingda
   - PBa
   - RalfS
   - Sanyin
   - Pavel (mpv)
   - Wloochacz
   - zed

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Version 1.18
  - old version history has been cut down to maintain this huge unit under
    65,000 lines, as required by Delphi 5 to avoid internal error PRO-3006
*)


{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

interface

uses
{$ifdef WITH_FASTMM4STATS}
  FastMM4,
{$endif}
{$ifdef MSWINDOWS}
  Windows,
  Messages,
  {$ifndef LVCL}
  Registry,
  {$endif}
{$else MSWINDOWS}
  {$ifdef KYLIX3}
    Types,
    LibC,
    SynKylix,
  {$endif KYLIX3}
  {$ifdef FPC}
    BaseUnix,
  {$endif FPC}
{$endif MSWINDOWS}
  Classes,
{$ifndef LVCL}
  SyncObjs, // for TEvent and TCriticalSection
  Contnrs,  // for TObjectList
  {$ifdef HASINLINE}
    Types,
  {$endif HASINLINE}
{$endif LVCL}
{$ifndef NOVARIANTS}
  Variants,
{$endif NOVARIANTS}
  SynLZ, // needed for TSynMapFile .mab format
  SysUtils;


const
  /// the corresponding version of the freeware Synopse framework
  // - includes a commit increasing number (generated by SourceCodeRep tool)
  // - a similar constant shall be defined in SynCrtSock.pas
  SYNOPSE_FRAMEWORK_VERSION = {$I SynopseCommit.inc};

  /// a text including the version and the main active conditional options
  // - usefull for low-level debugging purpose
  SYNOPSE_FRAMEWORK_FULLVERSION  = SYNOPSE_FRAMEWORK_VERSION
    {$ifdef FPC}
      {$ifdef FPC_FASTMM4}+' FMM4'{$else}
        {$ifdef FPC_SYNTBB}+' TBB'{$else}
          {$ifdef FPC_SYNJEMALLOC}+' JM'{$else}
            {$ifdef FPC_SYNCMEM}+' GM'{$else}
              {$ifdef FPC_CMEM}+' CM'{$endif}{$endif}{$endif}{$endif}{$endif}
    {$else}
      {$ifdef LVCL}+' LVCL'{$else}
        {$ifdef ENHANCEDRTL}+' ERTL'{$endif}{$endif}
      {$ifdef DOPATCHTRTL}+' PRTL'{$endif}
      {$ifdef FullDebugMode}+' FDM'{$endif}
    {$endif FPC};


{ ************ common types used for compatibility between compilers and CPU }

const
  /// internal Code Page for UTF-16 Unicode encoding
  // - used e.g. for Delphi 2009+ UnicodeString=String type
  CP_UTF16 = 1200;

  /// fake code page used to recognize TSQLRawBlob
  // - as returned e.g. by TTypeInfo.AnsiStringCodePage from mORMot.pas
  CP_SQLRAWBLOB = 65534;

  /// internal Code Page for RawByteString undefined string
  CP_RAWBYTESTRING = 65535;

  /// US English Windows Code Page, i.e. WinAnsi standard character encoding
  CODEPAGE_US = 1252;

  /// Latin-1 ISO/IEC 8859-1 Code Page
  CODEPAGE_LATIN1 = 819;

{$ifndef MSWINDOWS}
  /// internal Code Page for UTF-8 Unicode encoding
  CP_UTF8 = 65001;
var
  /// contains the curent system code page (default WinAnsi)
  GetACP: integer = CODEPAGE_US;
{$endif}

{$ifdef FPC} { make cross-compiler and cross-CPU types available to Delphi }

type
  PBoolean = ^Boolean;

{$else FPC}

type
  {$ifdef CPU64} // Delphi XE2 seems stable about those types (not Delphi 2009)
  PtrInt = NativeInt;
  PtrUInt = NativeUInt;
  {$else}
  /// a CPU-dependent signed integer type cast of a pointer / register
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PtrInt = integer;
  /// a CPU-dependent unsigned integer type cast of a pointer / register
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PtrUInt = cardinal;
  {$endif}
  /// a CPU-dependent unsigned integer type cast of a pointer of pointer
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PPtrUInt = ^PtrUInt;
  /// a CPU-dependent signed integer type cast of a pointer of pointer
  // - used for 64-bit compatibility, native under Free Pascal Compiler
  PPtrInt = ^PtrInt;

  /// unsigned Int64 doesn't exist under older Delphi, but is defined in FPC
  // - and UInt64 is buggy as hell under Delphi 2007 when inlining functions:
  // older compilers will fallback to signed Int64 values
  // - anyway, consider using SortDynArrayQWord() to compare QWord values
  // in a safe and efficient way, under a CPUX86
  // - you may use UInt64 explicitly in your computation (like in SynEcc.pas),
  // if you are sure that Delphi 6-2007 compiler handles your code as expected,
  // but mORMot code will expect to use QWord for its internal process
  // (e.g. ORM/SOA serialization)
  {$ifdef UNICODE}
  QWord = UInt64;
  {$else}
  QWord = {$ifndef DELPHI5OROLDER}type{$endif} Int64;
  {$endif}
  /// points to an unsigned Int64
  PQWord = ^QWord;

  {$ifndef ISDELPHIXE2}
  /// used to store the handle of a system Thread
  TThreadID = cardinal;
  {$endif}

{$endif FPC}

{$ifdef DELPHI6OROLDER}

// some definitions not available prior to Delphi 7
type
  UInt64 = Int64;

{$endif}

{$ifdef DELPHI5OROLDER}
  // Delphi 5 doesn't have those basic types defined :(
const
  varShortInt = $0010;
  varInt64 = $0014; { vt_i8 }
  soBeginning = soFromBeginning;
  soCurrent = soFromCurrent;
  reInvalidPtr = 2;
  PathDelim  = '\';
  sLineBreak = #13#10;

type
  PPointer = ^Pointer;
  PPAnsiChar = ^PAnsiChar;
  PInteger = ^Integer;
  PCardinal = ^Cardinal;
  PWord = ^Word;
  PByte = ^Byte;
  PBoolean = ^Boolean;
  PDouble = ^Double;
  PComp = ^Comp;
  THandle = LongWord;
  PVarData = ^TVarData;
  TVarData = packed record
    // mostly used for varNull, varInt64, varDouble, varString and varAny
    VType: word;
    case Integer of
      0: (Reserved1: Word;
          case Integer of
            0: (Reserved2, Reserved3: Word;
                case Integer of
                  varSmallInt: (VSmallInt: SmallInt);
                  varInteger:  (VInteger: Integer);
                  varSingle:   (VSingle: Single);
                  varDouble:   (VDouble: Double);     // DOUBLE
                  varCurrency: (VCurrency: Currency);
                  varDate:     (VDate: TDateTime);
                  varOleStr:   (VOleStr: PWideChar);
                  varDispatch: (VDispatch: Pointer);
                  varError:    (VError: HRESULT);
                  varBoolean:  (VBoolean: WordBool);
                  varUnknown:  (VUnknown: Pointer);
                  varByte:     (VByte: Byte);
                  varInt64:    (VInt64: Int64);      // INTEGER
                  varString:   (VString: Pointer);   // TEXT
                  varAny:      (VAny: Pointer);
                  varArray:    (VArray: PVarArray);
                  varByRef:    (VPointer: Pointer);
               );
            1: (VLongs: array[0..2] of LongInt); );
  end;
{$endif}

type
  /// RawUnicode is an Unicode String stored in an AnsiString
  // - faster than WideString, which are allocated in Global heap (for COM)
  // - an AnsiChar(#0) is added at the end, for having a true WideChar(#0) at ending
  // - length(RawUnicode) returns memory bytes count: use (length(RawUnicode) shr 1)
  // for WideChar count (that's why the definition of this type since Delphi 2009
  // is AnsiString(1200) and not UnicodeString)
  // - pointer(RawUnicode) is compatible with Win32 'Wide' API call
  // - mimic Delphi 2009 UnicodeString, without the WideString or Ansi conversion overhead
  // - all conversion to/from AnsiString or RawUTF8 must be explicit: the
  // compiler is not able to make valid implicit conversion on CP_UTF16
  {$ifdef HASCODEPAGE}
  RawUnicode = type AnsiString(CP_UTF16); // Codepage for an UnicodeString
  {$else}
  RawUnicode = type AnsiString;
  {$endif}

  /// RawUTF8 is an UTF-8 String stored in an AnsiString
  // - use this type instead of System.UTF8String, which behavior changed
  // between Delphi 2009 compiler and previous versions: our implementation
  // is consistent and compatible with all versions of Delphi compiler
  // - mimic Delphi 2009 UTF8String, without the charset conversion overhead
  // - all conversion to/from AnsiString or RawUnicode must be explicit
  {$ifdef HASCODEPAGE}
  RawUTF8 = type AnsiString(CP_UTF8); // Codepage for an UTF8 string
  {$else}
  RawUTF8 = type AnsiString;
  {$endif}

  /// WinAnsiString is a WinAnsi-encoded AnsiString (code page 1252)
  // - use this type instead of System.String, which behavior changed
  // between Delphi 2009 compiler and previous versions: our implementation
  // is consistent and compatible with all versions of Delphi compiler
  // - all conversion to/from RawUTF8 or RawUnicode must be explicit
  {$ifdef HASCODEPAGE}
  WinAnsiString = type AnsiString(CODEPAGE_US); // WinAnsi Codepage
  {$else}
  WinAnsiString = type AnsiString;
  {$endif}

  {$ifdef HASCODEPAGE}
  {$ifdef FPC}
  // missing declaration
  PRawByteString = ^RawByteString;
  {$endif}
  {$else}
  /// define RawByteString, as it does exist in Delphi 2009+
  // - to be used for byte storage into an AnsiString
  // - use this type if you don't want the Delphi compiler not to do any
  // code page conversions when you assign a typed AnsiString to a RawByteString,
  // i.e. a RawUTF8 or a WinAnsiString
  RawByteString = type AnsiString;
  /// pointer to a RawByteString
  PRawByteString = ^RawByteString;
  {$endif}

  /// RawJSON will indicate that this variable content would stay in raw JSON
  // - i.e. won't be serialized into values
  // - could be any JSON content: number, string, object or array
  // - e.g. interface-based service will use it for efficient and AJAX-ready
  // transmission of TSQLTableJSON result
  RawJSON = type RawUTF8;

  /// SynUnicode is the fastest available Unicode native string type, depending
  //  on the compiler used
  // - this type is native to the compiler, so you can use Length() Copy() and
  //   such functions with it (this is not possible with RawUnicodeString type)
  // - before Delphi 2009+, it uses slow OLE compatible WideString
  //   (with our Enhanced RTL, WideString allocation can be made faster by using
  //   an internal caching mechanism of allocation buffers - WideString allocation
  //   has been made much faster since Windows Vista/Seven)
  // - starting with Delphi 2009, it uses fastest UnicodeString type, which
  //   allow Copy On Write, Reference Counting and fast heap memory allocation
  {$ifdef UNICODE}
  SynUnicode = UnicodeString;
  {$else}
  SynUnicode = WideString;
  {$endif}

  PRawUnicode = ^RawUnicode;
  PRawJSON = ^RawJSON;
  PRawUTF8 = ^RawUTF8;
  PWinAnsiString = ^WinAnsiString;
  PWinAnsiChar = type PAnsiChar;
  PSynUnicode = ^SynUnicode;

  /// a simple wrapper to UTF-8 encoded zero-terminated PAnsiChar
  // - PAnsiChar is used only for Win-Ansi encoded text
  // - the Synopse mORMot framework uses mostly this PUTF8Char type,
  // because all data is internaly stored and expected to be UTF-8 encoded
  PUTF8Char = type PAnsiChar;
  PPUTF8Char = ^PUTF8Char;

  /// a Row/Col array of PUTF8Char, for containing sqlite3_get_table() result
  TPUtf8CharArray = array[0..MaxInt div SizeOf(PUTF8Char)-1] of PUTF8Char;
  PPUtf8CharArray = ^TPUtf8CharArray;

  /// a dynamic array of PUTF8Char pointers
  TPUTF8CharDynArray = array of PUTF8Char;

  /// a dynamic array of UTF-8 encoded strings
  TRawUTF8DynArray = array of RawUTF8;
  PRawUTF8DynArray = ^TRawUTF8DynArray;
  TRawUTF8DynArrayDynArray = array of TRawUTF8DynArray;

  /// a dynamic array of TVarRec, i.e. could match an "array of const" parameter
  TTVarRecDynArray = array of TVarRec;

  {$ifndef NOVARIANTS}
  /// a TVarData values array
  // - is not called TVarDataArray to avoid confusion with the corresponding
  // type already defined in Variants.pas, and used for custom late-binding
  TVarDataStaticArray = array[0..MaxInt div SizeOf(TVarData)-1] of TVarData;
  PVarDataStaticArray = ^TVarDataStaticArray;
  TVariantArray = array[0..MaxInt div SizeOf(Variant)-1] of Variant;
  PVariantArray = ^TVariantArray;
  TVariantDynArray = array of variant;
  {$endif}

  PIntegerDynArray = ^TIntegerDynArray;
  TIntegerDynArray = array of integer;
  TIntegerDynArrayDynArray = array of TIntegerDynArray;
  PCardinalDynArray = ^TCardinalDynArray;
  TCardinalDynArray = array of cardinal;
  PSingleDynArray = ^TSingleDynArray;
  TSingleDynArray = array of Single;
  PInt64DynArray = ^TInt64DynArray;
  TInt64DynArray = array of Int64;
  PQwordDynArray = ^TQwordDynArray;
  TQwordDynArray = array of Qword;
  TPtrUIntDynArray = array of PtrUInt;
  PDoubleDynArray = ^TDoubleDynArray;
  TDoubleDynArray = array of double;
  PCurrencyDynArray = ^TCurrencyDynArray;
  TCurrencyDynArray = array of Currency;
  TWordDynArray = array of word;
  PWordDynArray = ^TWordDynArray;
  TByteDynArray = array of byte;
  PByteDynArray = ^TByteDynArray;
  TObjectDynArray = array of TObject;
  PObjectDynArray = ^TObjectDynArray;
  TPersistentDynArray = array of TPersistent;
  PPersistentDynArray = ^TPersistentDynArray;
  TPointerDynArray = array of pointer;
  PPointerDynArray = ^TPointerDynArray;
  TPPointerDynArray = array of PPointer;
  PPPointerDynArray = ^TPPointerDynArray;
  TMethodDynArray = array of TMethod;
  PMethodDynArray = ^TMethodDynArray;
  TObjectListDynArray = array of TObjectList;
  PObjectListDynArray = ^TObjectListDynArray;
  TFileNameDynArray = array of TFileName;
  PFileNameDynArray = ^TFileNameDynArray;
  TBooleanDynArray = array of boolean;
  PBooleanDynArray = ^TBooleanDynArray;
  TClassDynArray = array of TClass;
  TWinAnsiDynArray = array of WinAnsiString;
  PWinAnsiDynArray = ^TWinAnsiDynArray;
  TRawByteStringDynArray = array of RawByteString;
  TStringDynArray = array of string;
  PStringDynArray = ^TStringDynArray;
  PShortStringDynArray = array of PShortString;
  PPShortStringArray = ^PShortStringArray;
  TShortStringDynArray = array of ShortString;
  TDateTimeDynArray = array of TDateTime;
  PDateTimeDynArray = ^TDateTimeDynArray;
  TWideStringDynArray = array of WideString;
  PWideStringDynArray = ^TWideStringDynArray;
  TSynUnicodeDynArray = array of SynUnicode;
  PSynUnicodeDynArray = ^TSynUnicodeDynArray;
  TGUIDDynArray = array of TGUID;

  PObject = ^TObject;
  PClass = ^TClass;
  PByteArray = ^TByteArray;
  TByteArray = array[0..MaxInt-1] of Byte; // redefine here with {$R-}
  PBooleanArray = ^TBooleanArray;
  TBooleanArray = array[0..MaxInt-1] of Boolean;
  TWordArray  = array[0..MaxInt div SizeOf(word)-1] of word;
  PWordArray = ^TWordArray;
  TIntegerArray = array[0..MaxInt div SizeOf(integer)-1] of integer;
  PIntegerArray = ^TIntegerArray;
  PIntegerArrayDynArray = array of PIntegerArray;
  TPIntegerArray = array[0..MaxInt div SizeOf(PIntegerArray)-1] of PInteger;
  PPIntegerArray = ^TPIntegerArray;
  TCardinalArray = array[0..MaxInt div SizeOf(cardinal)-1] of cardinal;
  PCardinalArray = ^TCardinalArray;
  TInt64Array = array[0..MaxInt div SizeOf(Int64)-1] of Int64;
  PInt64Array = ^TInt64Array;
  TQWordArray = array[0..MaxInt div SizeOf(QWord)-1] of QWord;
  PQWordArray = ^TQWordArray;
  TPtrUIntArray = array[0..MaxInt div SizeOf(PtrUInt)-1] of PtrUInt;
  PPtrUIntArray = ^TPtrUIntArray;
  TSmallIntArray = array[0..MaxInt div SizeOf(SmallInt)-1] of SmallInt;
  PSmallIntArray = ^TSmallIntArray;
  TSingleArray = array[0..MaxInt div SizeOf(Single)-1] of Single;
  PSingleArray = ^TSingleArray;
  TDoubleArray = array[0..MaxInt div SizeOf(Double)-1] of Double;
  PDoubleArray = ^TDoubleArray;
  TDateTimeArray = array[0..MaxInt div SizeOf(TDateTime)-1] of TDateTime;
  PDateTimeArray = ^TDateTimeArray;
  TPAnsiCharArray = array[0..MaxInt div SizeOf(PAnsiChar)-1] of PAnsiChar;
  PPAnsiCharArray = ^TPAnsiCharArray;
  TRawUTF8Array = array[0..MaxInt div SizeOf(RawUTF8)-1] of RawUTF8;
  PRawUTF8Array = ^TRawUTF8Array;
  TRawByteStringArray = array[0..MaxInt div SizeOf(RawByteString)-1] of RawByteString;
  PRawByteStringArray = ^TRawByteStringArray;
  PShortStringArray = array[0..MaxInt div SizeOf(pointer)-1] of PShortString;
  PointerArray = array [0..MaxInt div SizeOf(Pointer)-1] of Pointer;
  PPointerArray = ^PointerArray;
  TObjectArray = array [0..MaxInt div SizeOf(TObject)-1] of TObject;
  PObjectArray = ^TObjectArray;
  TPtrIntArray = array[0..MaxInt div SizeOf(PtrInt)-1] of PtrInt;
  PPtrIntArray = ^TPtrIntArray;
  PInt64Rec = ^Int64Rec;
  PPShortString = ^PShortString;

  {$ifndef DELPHI5OROLDER}
  PIInterface = ^IInterface;
  TInterfaceDynArray = array of IInterface;
  PInterfaceDynArray = ^TInterfaceDynArray;
  {$endif}

  {$ifndef LVCL}
  TCollectionClass = class of TCollection;
  TCollectionItemClass = class of TCollectionItem;
  {$endif}

  /// class-reference type (metaclass) of a TStream
  TStreamClass = class of TStream;

  /// class-reference type (metaclass) of a TInterfacedObject
  TInterfacedObjectClass = class of TInterfacedObject;


{ ************ fast UTF-8 / Unicode / Ansi types and conversion routines **** }

type
  {$ifndef ISDELPHI2007ANDUP}
  TBytes = array of byte;
  {$endif}

  /// kind of adding in a TTextWriter
  TTextWriterKind = (twNone, twJSONEscape, twOnSameLine);

  /// an abstract class to handle Ansi to/from Unicode translation
  // - implementations of this class will handle efficiently all Code Pages
  // - this default implementation will use the Operating System APIs
  // - you should not create your own class instance by yourself, but should
  // better retrieve an instance using TSynAnsiConvert.Engine(), which will
  // initialize either a TSynAnsiFixedWidth or a TSynAnsiConvert instance on need
  TSynAnsiConvert = class
  protected
    fCodePage: cardinal;
    fAnsiCharShift: byte;
    {$ifdef KYLIX3}
    fIConvCodeName: RawUTF8;
    {$endif}
    procedure InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
      DestTextWriter: TObject; Escape: TTextWriterKind); virtual;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); reintroduce; virtual;
    /// returns the engine corresponding to a given code page
    // - a global list of TSynAnsiConvert instances is handled by the unit -
    // therefore, caller should not release the returned instance
    // - will return nil in case of unhandled code page
    // - is aCodePage is 0, will return CurrentAnsiConvert value
    class function Engine(aCodePage: cardinal): TSynAnsiConvert;
    /// direct conversion of a PAnsiChar buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - this default implementation will use the Operating System APIs
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; overload; virtual;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    // - this default implementation will use the Operating System APIs
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; overload; virtual;
    /// convert any Ansi Text into an UTF-16 Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(const AnsiText: RawByteString): RawUnicode; overload;
    /// convert any Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; overload; virtual;
    /// convert any Ansi buffer into an Unicode String
    // - returns a SynUnicode, i.e. Delphi 2009+ UnicodeString or a WideString
    function AnsiToUnicodeString(Source: PAnsiChar; SourceChars: Cardinal): SynUnicode; overload;
    /// convert any Ansi buffer into an Unicode String
    // - returns a SynUnicode, i.e. Delphi 2009+ UnicodeString or a WideString
    function AnsiToUnicodeString(const Source: RawByteString): SynUnicode; overload;
    /// convert any Ansi Text into an UTF-8 encoded String
    // - internaly calls AnsiBufferToUTF8 virtual method
    function AnsiToUTF8(const AnsiText: RawByteString): RawUTF8; virtual;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded string
    // - will call AnsiBufferToUnicode() overloaded virtual method
    function AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8; overload; virtual;
    /// direct conversion of an Unicode buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - this default implementation will rely on the Operating System for
    // all non ASCII-7 chars
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; overload; virtual;
    /// direct conversion of an Unicode buffer into an Ansi Text
    function UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString; overload; virtual;
    /// convert any Unicode-encoded String into Ansi Text
    // - internaly calls UnicodeBufferToAnsi virtual method
    function RawUnicodeToAnsi(const Source: RawUnicode): RawByteString;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; overload; virtual;
    /// convert any UTF-8 encoded buffer into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// convert any UTF-8 encoded buffer into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    procedure UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
      var result: RawByteString); overload; virtual;
    /// convert any UTF-8 encoded String into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8ToAnsi(const UTF8: RawUTF8): RawByteString; virtual;
    /// direct conversion of a UTF-8 encoded string into a WinAnsi buffer
    // - will truncate the destination string to DestSize bytes (including the
    // trailing #0), with a maximum handled size of 2048 bytes
    // - returns the number of bytes stored in Dest^ (i.e. the position of #0)
    function Utf8ToAnsiBuffer(const S: RawUTF8; Dest: PAnsiChar; DestSize: integer): integer;
    /// convert any Ansi Text (providing a From converted) into Ansi Text
    function AnsiToAnsi(From: TSynAnsiConvert; const Source: RawByteString): RawByteString; overload;
    /// convert any Ansi buffer (providing a From converted) into Ansi Text
    function AnsiToAnsi(From: TSynAnsiConvert; Source: PAnsiChar; SourceChars: cardinal): RawByteString; overload;
    /// corresponding code page
    property CodePage: Cardinal read fCodePage;
  end;

  /// a class to handle Ansi to/from Unicode translation of fixed width encoding
  // (i.e. non MBCS)
  // - this class will handle efficiently all Code Page availables without MBCS
  // encoding - like WinAnsi (1252) or Russian (1251)
  // - it will use internal fast look-up tables for such encodings
  // - this class could take some time to generate, and will consume more than
  // 64 KB of memory: you should not create your own class instance by yourself,
  // but should better retrieve an instance using TSynAnsiConvert.Engine(), which
  // will initialize either a TSynAnsiFixedWidth or a TSynAnsiConvert instance
  // on need
  // - this class has some additional methods (e.g. IsValid*) which take
  // advantage of the internal lookup tables to provide some fast process
  TSynAnsiFixedWidth = class(TSynAnsiConvert)
  protected
    fAnsiToWide: TWordDynArray;
    fWideToAnsi: TByteDynArray;
    procedure InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
      DestTextWriter: TObject; Escape: TTextWriterKind); override;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); override;
    /// direct conversion of a PAnsiChar buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; override;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; override;
    /// convert any Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; override;
    /// direct conversion of an Unicode buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - this overridden version will use internal lookup tables for fast process
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; override;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; override;
    /// conversion of a wide char into the corresponding Ansi character
    // - return -1 for an unknown WideChar in the current code page
    function WideCharToAnsiChar(wc: cardinal): integer;
    /// return TRUE if the supplied unicode buffer only contains characters of
    // the corresponding Ansi code page
    // - i.e. if the text can be displayed using this code page
    function IsValidAnsi(WideText: PWideChar; Length: integer): boolean; overload;
    /// return TRUE if the supplied unicode buffer only contains characters of
    // the corresponding Ansi code page
    // - i.e. if the text can be displayed using this code page
    function IsValidAnsi(WideText: PWideChar): boolean; overload;
    /// return TRUE if the supplied UTF-8 buffer only contains characters of
    // the corresponding Ansi code page
    // - i.e. if the text can be displayed using this code page
    function IsValidAnsiU(UTF8Text: PUTF8Char): boolean;
    /// return TRUE if the supplied UTF-8 buffer only contains 8 bits characters
    // of the corresponding Ansi code page
    // - i.e. if the text can be displayed with only 8 bit unicode characters
    // (e.g. no "tm" or such) within this code page
    function IsValidAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
    /// direct access to the Ansi-To-Unicode lookup table
    // - use this array like AnsiToWide: array[byte] of word
    property AnsiToWide: TWordDynArray read fAnsiToWide;
    /// direct access to the Unicode-To-Ansi lookup table
    // - use this array like WideToAnsi: array[word] of byte
    // - any unhandled WideChar will return ord('?')
    property WideToAnsi: TByteDynArray read fWideToAnsi;
  end;

  /// a class to handle UTF-8 to/from Unicode translation
  // - match the TSynAnsiConvert signature, for code page CP_UTF8
  // - this class is mostly a non-operation for conversion to/from UTF-8
  TSynAnsiUTF8 = class(TSynAnsiConvert)
  private
    function UnicodeBufferToUTF8(Dest: PAnsiChar; DestChars: Cardinal;
      Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
  protected
    procedure InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
      DestTextWriter: TObject; Escape: TTextWriterKind); override;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); override;
    /// direct conversion of a PAnsiChar UTF-8 buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; override;
    /// direct conversion of a PAnsiChar UTF-8 buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; override;
    /// convert any UTF-8 Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; override;
    /// direct conversion of an Unicode buffer into a PAnsiChar UTF-8 buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; override;
    /// direct conversion of an Unicode buffer into an Ansi Text
    function UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString; override;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar UTF-8 buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; override;
    /// convert any UTF-8 encoded buffer into Ansi Text
    procedure UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
      var result: RawByteString); override;
    /// convert any UTF-8 encoded String into Ansi Text
    // - directly assign the input as result, since no conversion is needed
    function UTF8ToAnsi(const UTF8: RawUTF8): RawByteString; override;
    /// convert any Ansi Text into an UTF-8 encoded String
    // - directly assign the input as result, since no conversion is needed
    function AnsiToUTF8(const AnsiText: RawByteString): RawUTF8; override;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded string
    function AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8; override;
  end;

  /// a class to handle UTF-16 to/from Unicode translation
  // - match the TSynAnsiConvert signature, for code page CP_UTF16
  // - even if UTF-16 is not an Ansi format, code page CP_UTF16 may have been
  // used to store UTF-16 encoded binary content
  // - this class is mostly a non-operation for conversion to/from Unicode
  TSynAnsiUTF16 = class(TSynAnsiConvert)
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: cardinal); override;
    /// direct conversion of a PAnsiChar UTF-16 buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - will append a trailing #0 to the returned PWideChar, unless
    // NoTrailingZero is set
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PWideChar; override;
    /// direct conversion of a PAnsiChar UTF-16 buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - will append a trailing #0 to the returned PUTF8Char, unless
    // NoTrailingZero is set
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
      SourceChars: Cardinal; NoTrailingZero: boolean=false): PUTF8Char; override;
    /// convert any UTF-16 Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; override;
    /// direct conversion of an Unicode buffer into a PAnsiChar UTF-16 buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; override;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar UTF-16 buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    // - no trailing #0 is appended to the buffer
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
      SourceChars: Cardinal): PAnsiChar; override;
  end;


  /// implements a stack-based storage of some (UTF-8 or binary) text
  // - could be used e.g. to make a temporary copy when JSON is parsed in-place
  // - call one of the Init() overloaded methods, then Done to release its memory
  // - will avoid temporary memory allocation via the heap for up to 4KB of data
  // - all Init() methods will allocate 16 more bytes, for a trailing #0 and
  // to ensure our fast JSON parsing won't trigger any GPF (since it may read
  // up to 4 bytes ahead via its PInteger() trick) or any SSE4.2 function
  {$ifdef FPC_OR_UNICODE}TSynTempBuffer = record{$else}TSynTempBuffer = object{$endif}
  public
    /// the text/binary length, in bytes, excluding the trailing #0
    len: integer;
    /// where the text/binary is available (and any Source has been copied)
    // - equals nil if len=0
    buf: pointer;
    /// initialize a temporary copy of the content supplied as RawByteString
    // - will also allocate and copy the ending #0 (even for binary)
    procedure Init(const Source: RawByteString); overload;
    /// initialize a temporary copy of the supplied text buffer, ending with #0
    function Init(Source: PUTF8Char): PUTF8Char; overload;
    /// initialize a temporary copy of the supplied text buffer
    procedure Init(Source: pointer; SourceLen: integer); overload;
    /// initialize a new temporary buffer of a given number of bytes
    function Init(SourceLen: integer): pointer; overload; {$ifdef HASINLINE}inline;{$endif}
    /// initialize the buffer returning the internal buffer size (4095 bytes)
    // - could be used e.g. for an API call, first trying with plain temp.Init
    // and using temp.buf and temp.len safely in the call, only calling
    // temp.Init(expectedsize) if the API returned an error about an insufficient
    // buffer space
    function Init: integer; overload; {$ifdef HASINLINE}inline;{$endif}
    /// initialize a new temporary buffer of a given number of random bytes
    // - will fill the buffer via FillRandom() calls
    function InitRandom(RandomLen: integer; forcegsl: boolean=true): pointer;
    /// initialize a new temporary buffer filled with integer increasing values
    function InitIncreasing(Count: integer; Start: integer=0): PIntegerArray;
    /// initialize a new temporary buffer of a given number of zero bytes
    function InitZero(ZeroLen: integer): pointer;
    /// finalize the temporary storage
    procedure Done; overload; {$ifdef HASINLINE}inline;{$endif}
    /// finalize the temporary storage, and create a RawUTF8 string from it
    procedure Done(EndBuf: pointer; var Dest: RawUTF8); overload; {$ifdef HASINLINE}inline;{$endif}
  private
    // default 4KB buffer allocated on stack
    tmp: array[0..4095] of AnsiChar;
  end;

  /// implements a stack-based writable storage of binary content
  // - memory allocation is performed via a TSynTempBuffer
  {$ifdef FPC_OR_UNICODE}TSynTempWriter = record private
  {$else}TSynTempWriter = object protected{$endif}
    tmp: TSynTempBuffer;
  public
    /// the current writable position in tmp.buf
    pos: PAnsiChar;
    /// initialize a new temporary buffer of a given number of bytes
    // - if maxsize is left to its 0 default value, the default stack-allocated
    // memory size is used, i.e. 4 KB
    procedure Init(maxsize: integer=0);
    /// finalize the temporary storage
    procedure Done;
    /// append some binary to the internal buffer
    // - will raise an ESynException in case of potential overflow
    procedure wr(const val; len: integer);
    /// append some shortstring as binary to the internal buffer
    procedure wrss(const str: shortstring);
    /// append some 8-bit value as binary to the internal buffer
    procedure wrb(b: byte);
    /// append some 16-bit value as binary to the internal buffer
    procedure wrw(w: word);
    /// append some 32-bit value as binary to the internal buffer
    procedure wrint(int: integer);
    /// append some 32-bit/64-bit pointer value as binary to the internal buffer
    procedure wrptr(ptr: pointer);
    /// append some 32-bit/64-bit integer as binary to the internal buffer
    procedure wrptrint(int: PtrInt);
    /// append some fixed-value bytes as binary to the internal buffer
    // - returns a pointer to the first byte of the added memory chunk
    function wrfillchar(count: integer; value: byte): PAnsiChar;
    /// returns the current offset position in the internal buffer
    function Position: integer;
    /// returns the buffer as a RawByteString instance
    function AsBinary: RawByteString;
  end;

  /// function prototype to be used for hashing of an element
  // - it must return a cardinal hash, with as less collision as possible
  // - TDynArrayHashed.Init will use crc32c() if no custom function is supplied,
  // which will run either as software or SSE4.2 hardware, with good colision
  // for most used kind of data
  THasher = function(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

var
  /// global TSynAnsiConvert instance to handle WinAnsi encoding (code page 1252)
  // - this instance is global and instantied during the whole program life time
  // - it will be created from hard-coded values, and not using the system API,
  // since it appeared that some systems (e.g. in Russia) did tweak the registry
  // so that 1252 code page maps 1251 code page
  WinAnsiConvert: TSynAnsiFixedWidth;

  /// global TSynAnsiConvert instance to handle current system encoding
  // - this is the encoding as used by the AnsiString Delphi, so will be used
  // before Delphi 2009 to speed-up VCL string handling (especially for UTF-8)
  // - this instance is global and instantied during the whole program life time
  CurrentAnsiConvert: TSynAnsiConvert;

  /// global TSynAnsiConvert instance to handle UTF-8 encoding (code page CP_UTF8)
  // - this instance is global and instantied during the whole program life time
  UTF8AnsiConvert: TSynAnsiUTF8;


const
  /// HTTP header name for the content type, as defined in the corresponding RFC
  HEADER_CONTENT_TYPE = 'Content-Type: ';

  /// HTTP header name for the content type, in upper case
  // - as defined in the corresponding RFC
  // - could be used e.g. with IdemPChar() to retrieve the Content-Type value
  HEADER_CONTENT_TYPE_UPPER = 'CONTENT-TYPE: ';

  /// HTTP header name for the client IP, in upper case
  // - as defined in our HTTP server classes
  // - could be used e.g. with IdemPChar() to retrieve the remote IP address
  HEADER_REMOTEIP_UPPER = 'REMOTEIP: ';

  /// HTTP header name for the authorization token, in upper case
  // - could be used e.g. with IdemPChar() to retrieve a JWT value
  HEADER_BEARER_UPPER = 'AUTHORIZATION: BEARER ';

  /// MIME content type used for JSON communication (as used by the Microsoft
  // WCF framework and the YUI framework)
  JSON_CONTENT_TYPE = 'application/json; charset=UTF-8';

  /// HTTP header for MIME content type used for plain JSON
  JSON_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+JSON_CONTENT_TYPE;

  /// MIME content type used for plain JSON, in upper case
  // - could be used e.g. with IdemPChar() to retrieve the Content-Type value
  JSON_CONTENT_TYPE_UPPER = 'APPLICATION/JSON';

  /// HTTP header for MIME content type used for plain JSON, in upper case
  // - could be used e.g. with IdemPChar() to retrieve the Content-Type value
  JSON_CONTENT_TYPE_HEADER_UPPER = HEADER_CONTENT_TYPE_UPPER+JSON_CONTENT_TYPE_UPPER;

  /// MIME content type used for plain UTF-8 text
  TEXT_CONTENT_TYPE = 'text/plain; charset=UTF-8';

  /// HTTP header for MIME content type used for plain UTF-8 text
  TEXT_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+TEXT_CONTENT_TYPE;

  /// MIME content type used for UTF-8 encoded HTML
  HTML_CONTENT_TYPE = 'text/html; charset=UTF-8';

  /// HTTP header for MIME content type used for UTF-8 encoded HTML
  HTML_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+HTML_CONTENT_TYPE;

  /// MIME content type used for UTF-8 encoded XML
  XML_CONTENT_TYPE = 'text/xml; charset=UTF-8';

  /// HTTP header for MIME content type used for UTF-8 encoded XML
  XML_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+XML_CONTENT_TYPE;

  /// MIME content type used for raw binary data
  BINARY_CONTENT_TYPE = 'application/octet-stream';

  /// MIME content type used for raw binary data, in upper case
  BINARY_CONTENT_TYPE_UPPER = 'APPLICATION/OCTET-STREAM';

  /// HTTP header for MIME content type used for raw binary data
  BINARY_CONTENT_TYPE_HEADER = HEADER_CONTENT_TYPE+BINARY_CONTENT_TYPE;

  /// MIME content type used for a JPEG picture
  JPEG_CONTENT_TYPE = 'image/jpeg';

var
  /// MIME content type used for JSON communication
  // - this global will be initialized with JSON_CONTENT_TYPE constant, to
  // avoid a memory allocation each time it is assigned to a variable
  JSON_CONTENT_TYPE_VAR: RawUTF8;

  /// HTTP header for MIME content type used for plain JSON
  // - this global will be initialized with JSON_CONTENT_TYPE_HEADER constant,
  // to avoid a memory allocation each time it is assigned to a variable
  JSON_CONTENT_TYPE_HEADER_VAR: RawUTF8;

  /// can be used to avoid a memory allocation for res := 'null'
  NULL_STR_VAR: RawUTF8;

/// compute the new capacity when expanding an array of items
// - handle small, medium and large sizes properly to reduce memory usage and
// maximize performance
function NextGrow(capacity: integer): integer;

/// equivalence to SetString(s,nil,len) function
// - faster especially under FPC
procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);

/// equivalence to SetString(s,nil,len) function with a specific code page
// - faster especially under FPC
procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);

/// initialize a RawByteString, ensuring returned "aligned" pointer is 16-bytes aligned
// - to be used e.g. for proper SSE process
procedure GetMemAligned(var s: RawByteString; p: pointer; len: PtrInt;
  out aligned: pointer);

/// equivalence to @UTF8[1] expression to ensure a RawUTF8 variable is unique
// - will ensure that the string refcount is 1, and return a pointer to the text
// - under FPC, @UTF8[1] does not call UniqueString() as it does with Delphi
// - if UTF8 is a constant (refcount=-1), will create a temporary copy in heap
function UniqueRawUTF8(var UTF8: RawUTF8): pointer;
  {$ifdef HASINLINE}inline;{$endif}

/// will fast replace all #0 chars as ~
// - could be used after UniqueRawUTF8() on a in-placed modified JSON buffer,
// in which all values have been ended with #0
// - you can optionally specify a maximum size, in bytes (this won't reallocate
// the string, but just add a #0 at some point in the UTF8 buffer)
// - could allow logging of parsed input e.g. after an exception
procedure UniqueRawUTF8ZeroToTilde(var UTF8: RawUTF8; MaxSize: integer=maxInt);

/// conversion of a wide char into a WinAnsi (CodePage 1252) char
// - return '?' for an unknown WideChar in code page 1252
function WideCharToWinAnsiChar(wc: cardinal): AnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// conversion of a wide char into a WinAnsi (CodePage 1252) char index
// - return -1 for an unknown WideChar in code page 1252
function WideCharToWinAnsi(wc: cardinal): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PC: PAnsiChar): boolean; overload;

/// return TRUE if the supplied buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PC: PAnsiChar; Len: integer): boolean; overload;

/// return TRUE if the supplied buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PW: PWideChar): boolean; overload;

/// return TRUE if the supplied text only contains 7-bits Ansi characters
function IsAnsiCompatible(const Text: RawByteString): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied buffer only contains 7-bits Ansi characters
function IsAnsiCompatible(PW: PWideChar; Len: integer): boolean; overload;

/// return TRUE if the supplied unicode buffer only contains WinAnsi characters
// - i.e. if the text can be displayed using ANSI_CHARSET
function IsWinAnsi(WideText: PWideChar): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied unicode buffer only contains WinAnsi characters
// - i.e. if the text can be displayed using ANSI_CHARSET
function IsWinAnsi(WideText: PWideChar; Length: integer): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied UTF-8 buffer only contains WinAnsi characters
// - i.e. if the text can be displayed using ANSI_CHARSET
function IsWinAnsiU(UTF8Text: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// return TRUE if the supplied UTF-8 buffer only contains WinAnsi 8 bit characters
// - i.e. if the text can be displayed using ANSI_CHARSET with only 8 bit unicode
// characters (e.g. no "tm" or such)
function IsWinAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// UTF-8 encode one UTF-16 character into Dest
// - return the number of bytes written into Dest (i.e. 1,2 or 3)
// - this method does NOT handle UTF-16 surrogate pairs
function WideCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// UTF-8 encode one UTF-16 encoded UCS4 character into Dest
// - return the number of bytes written into Dest (i.e. from 1 up to 6)
// - Source will contain the next UTF-16 character
// - this method DOES handle UTF-16 surrogate pairs
function UTF16CharToUtf8(Dest: PUTF8Char; var Source: PWord): integer;

/// UTF-8 encode one UCS4 character into Dest
// - return the number of bytes written into Dest (i.e. from 1 up to 6)
// - this method DOES handle UTF-16 surrogate pairs
function UCS4ToUTF8(ucs4: cardinal; Dest: PUTF8Char): integer;

/// direct conversion of an AnsiString with an unknown code page into an
// UTF-8 encoded String
// - will assume CurrentAnsiConvert.CodePage prior to Delphi 2009
// - newer UNICODE versions of Delphi will retrieve the code page from string
procedure AnyAnsiToUTF8(const s: RawByteString; var result: RawUTF8); overload;

/// direct conversion of an AnsiString with an unknown code page into an
// UTF-8 encoded String
// - will assume CurrentAnsiConvert.CodePage prior to Delphi 2009
// - newer UNICODE versions of Delphi will retrieve the code page from string
function AnyAnsiToUTF8(const s: RawByteString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi (CodePage 1252) string into a UTF-8 encoded String
// - faster than SysUtils: don't use Utf8Encode(WideString) -> no Windows.Global(),
// and use a fixed pre-calculated array for individual chars conversion
function WinAnsiToUtf8(const S: WinAnsiString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi (CodePage 1252) string into a UTF-8 encoded String
// - faster than SysUtils: don't use Utf8Encode(WideString) -> no Windows.Global(),
// and use a fixed pre-calculated array for individual chars conversion
function WinAnsiToUtf8(WinAnsi: PAnsiChar; WinAnsiLen: integer): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi PAnsiChar buffer into a UTF-8 encoded buffer
// - Dest^ buffer must be reserved with at least SourceChars*3
// - call internally WinAnsiConvert fast conversion class
function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi shortstring into a UTF-8 text
// - call internally WinAnsiConvert fast conversion class
function ShortStringToUTF8(const source: ShortString): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a WinAnsi (CodePage 1252) string into a Unicode encoded String
// - very fast, by using a fixed pre-calculated array for individual chars conversion
function WinAnsiToRawUnicode(const S: WinAnsiString): RawUnicode;

/// direct conversion of a WinAnsi (CodePage 1252) string into a Unicode buffer
// - very fast, by using a fixed pre-calculated array for individual chars conversion
// - text will be truncated if necessary to avoid buffer overflow in Dest[]
procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: integer);
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded string into a WinAnsi String
function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded zero terminated buffer into a WinAnsi String
function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded zero terminated buffer into a RawUTF8 String
procedure Utf8ToRawUTF8(P: PUTF8Char; var result: RawUTF8);
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded buffer into a WinAnsi PAnsiChar buffer
function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a UTF-8 encoded buffer into a WinAnsi shortstring buffer
procedure UTF8ToShortString(var dest: shortstring; source: PUTF8Char);

/// direct conversion of an ANSI-7 shortstring into an AnsiString
// - can be used e.g. for names retrieved from RTTI to convert them into RawUTF8
function ShortStringToAnsi7String(const source: shortstring): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of an ANSI-7 shortstring into an AnsiString
// - can be used e.g. for names retrieved from RTTI to convert them into RawUTF8
procedure ShortStringToAnsi7String(const source: shortstring; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an UTF-8 encoded text into a WideChar (UTF-16) buffer
// - faster than System.UTF8ToUnicode
// - sourceBytes can by 0, therefore length is computed from zero terminated source
// - enough place must be available in dest buffer (guess is sourceBytes*3+2)
// - a WideChar(#0) is added at the end (if something is written) unless
// NoTrailingZero is TRUE
// - returns the BYTE count written in dest, excluding the ending WideChar(#0)
function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char; sourceBytes: PtrInt=0;
  NoTrailingZero: boolean=false): PtrInt; overload;

/// convert an UTF-8 encoded text into a WideChar (UTF-16) buffer
// - faster than System.UTF8ToUnicode
// - this overloaded function expect a MaxDestChars parameter
// - sourceBytes can not be 0 for this function
// - enough place must be available in dest buffer (guess is sourceBytes*3+2)
// - a WideChar(#0) is added at the end (if something is written) unless
// NoTrailingZero is TRUE
// - returns the BYTE COUNT (not WideChar count) written in dest, excluding the
// ending WideChar(#0)
function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char;
  MaxDestChars, sourceBytes: PtrInt; NoTrailingZero: boolean=false): PtrInt; overload;

/// calculate the UTF-16 Unicode characters count, UTF-8 encoded in source^
// - count may not match the UCS4 glyphs number, in case of UTF-16 surrogates
// - faster than System.UTF8ToUnicode with dest=nil
function Utf8ToUnicodeLength(source: PUTF8Char): PtrUInt;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding
// - will stop when the buffer contains #0
function IsValidUTF8(source: PUTF8Char): Boolean; overload;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding
// - will also refuse #0 characters within the buffer
function IsValidUTF8(source: PUTF8Char; sourcelen: PtrInt): Boolean; overload;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding
// - will also refuse #0 characters within the buffer
function IsValidUTF8(const source: RawUTF8): Boolean; overload;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding with no #1..#31
// control characters
// - supplied input is a pointer to a #0 ended text buffer
function IsValidUTF8WithoutControlChars(source: PUTF8Char): Boolean; overload;

/// returns TRUE if the supplied buffer has valid UTF-8 encoding with no #0..#31
// control characters
// - supplied input is a RawUTF8 variable
function IsValidUTF8WithoutControlChars(const source: RawUTF8): Boolean; overload;

/// will truncate the supplied UTF-8 value if its length exceeds the specified
// UTF-16 Unicode characters count
// - count may not match the UCS4 glyphs number, in case of UTF-16 surrogates
// - returns FALSE if text was not truncated, TRUE otherwise
function Utf8TruncateToUnicodeLength(var text: RawUTF8; maxUtf16: integer): boolean;

/// will truncate the supplied UTF-8 value if its length exceeds the specified
// bytes count
// - this function will ensure that the returned content will contain only valid
// UTF-8 sequence, i.e. will trim the whole trailing UTF-8 sequence
// - returns FALSE if text was not truncated, TRUE otherwise
function Utf8TruncateToLength(var text: RawUTF8; maxBytes: cardinal): boolean;

/// compute the truncated length of the supplied UTF-8 value if it exceeds the
// specified bytes count
// - this function will ensure that the returned content will contain only valid
// UTF-8 sequence, i.e. will trim the whole trailing UTF-8 sequence
// - returns maxUTF8 if text was not truncated, or the number of fitting bytes
function Utf8TruncatedLength(const text: RawUTF8; maxBytes: cardinal): integer; overload;

/// compute the truncated length of the supplied UTF-8 value if it exceeds the
// specified bytes count
// - this function will ensure that the returned content will contain only valid
// UTF-8 sequence, i.e. will trim the whole trailing UTF-8 sequence
// - returns maxUTF8 if text was not truncated, or the number of fitting bytes
function Utf8TruncatedLength(text: PAnsiChar; textlen,maxBytes: cardinal): integer; overload;

/// calculate the UTF-16 Unicode characters count of the UTF-8 encoded first line
// - count may not match the UCS4 glyphs number, in case of UTF-16 surrogates
// - end the parsing at first #13 or #10 character
function Utf8FirstLineToUnicodeLength(source: PUTF8Char): PtrInt;

/// convert a UTF-8 encoded buffer into a RawUnicode string
// - if L is 0, L is computed from zero terminated P buffer
// - RawUnicode is ended by a WideChar(#0)
// - faster than System.Utf8Decode() which uses slow widestrings
function Utf8DecodeToRawUnicode(P: PUTF8Char; L: integer): RawUnicode; overload;

/// convert a UTF-8 string into a RawUnicode string
function Utf8DecodeToRawUnicode(const S: RawUTF8): RawUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a UTF-8 string into a RawUnicode string
// - this version doesn't resize the length of the result RawUnicode
// and is therefore useful before a Win32 Unicode API call (with nCount=-1)
// - if DestLen is not nil, the resulting length (in bytes) will be stored within
function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; DestLen: PInteger=nil): RawUnicode; overload;

/// convert a UTF-8 string into a RawUnicode string
// - returns the resulting length (in bytes) will be stored within Dest
function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; var Dest: RawUnicode): integer; overload;

type
  /// option set for RawUnicodeToUtf8() conversion
  TCharConversionFlags = set of (
    ccfNoTrailingZero, ccfReplacementCharacterForUnmatchedSurrogate);

/// convert a RawUnicode PWideChar into a UTF-8 string
procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  var result: RawUTF8; Flags: TCharConversionFlags = [ccfNoTrailingZero]); overload;

/// convert a RawUnicode PWideChar into a UTF-8 string
function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  Flags: TCharConversionFlags = [ccfNoTrailingZero]): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUnicode UTF-16 PWideChar into a UTF-8 buffer
// - replace system.UnicodeToUtf8 implementation, which is rather slow
// since Delphi 2009+
// - append a trailing #0 to the ending PUTF8Char, unless ccfNoTrailingZero is set
// - if ccfReplacementCharacterForUnmatchedSurrogate is set, this function will identify
// unmatched surrogate pairs and replace them with EF BF BD / FFFD  Unicode
// Replacement character - see https://en.wikipedia.org/wiki/Specials_(Unicode_block)
function RawUnicodeToUtf8(Dest: PUTF8Char; DestLen: PtrInt;
  Source: PWideChar; SourceLen: PtrInt; Flags: TCharConversionFlags): PtrInt; overload;

/// convert a RawUnicode PWideChar into a UTF-8 string
// - this version doesn't resize the resulting RawUTF8 string, but return
// the new resulting RawUTF8 byte count into UTF8Length
function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  out UTF8Length: integer): RawUTF8; overload;

/// convert a RawUnicode string into a UTF-8 string
function RawUnicodeToUtf8(const Unicode: RawUnicode): RawUTF8; overload;

/// convert a SynUnicode string into a UTF-8 string
function SynUnicodeToUtf8(const Unicode: SynUnicode): RawUTF8;

/// convert a WideString into a UTF-8 string
function WideStringToUTF8(const aText: WideString): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// direct conversion of a Unicode encoded buffer into a WinAnsi PAnsiChar buffer
procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: integer);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUnicode PWideChar into a WinAnsi (code page 1252) string
function RawUnicodeToWinAnsi(WideChar: PWideChar; WideCharCount: integer): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUnicode string into a WinAnsi (code page 1252) string
function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a WideString into a WinAnsi (code page 1252) string
function WideStringToWinAnsi(const Wide: WideString): WinAnsiString;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an AnsiChar buffer (of a given code page) into a UTF-8 string
procedure AnsiCharToUTF8(P: PAnsiChar; L: Integer; var result: RawUTF8; ACP: integer);

/// convert any Raw Unicode encoded String into a generic SynUnicode Text
function RawUnicodeToSynUnicode(const Unicode: RawUnicode): SynUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Raw Unicode encoded String into a generic SynUnicode Text
function RawUnicodeToSynUnicode(WideChar: PWideChar; WideCharCount: integer): SynUnicode; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an Unicode buffer into a WinAnsi (code page 1252) string
procedure UnicodeBufferToWinAnsi(source: PWideChar; out Dest: WinAnsiString);

/// convert an Unicode buffer into a generic VCL string
function UnicodeBufferToString(source: PWideChar): string;

{$ifdef HASVARUSTRING}

/// convert a Delphi 2009+ or FPC Unicode string into our UTF-8 string
function UnicodeStringToUtf8(const S: UnicodeString): RawUTF8; inline;

// this function is the same as direct RawUTF8=AnsiString(CP_UTF8) assignment
// but is faster, since it uses no Win32 API call
function UTF8DecodeToUnicodeString(const S: RawUTF8): UnicodeString; overload; inline;

/// convert our UTF-8 encoded buffer into a Delphi 2009+ Unicode string
// - this function is the same as direct assignment, since RawUTF8=AnsiString(CP_UTF8),
// but is faster, since use no Win32 API call
procedure UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer; var result: UnicodeString); overload;

/// convert a Delphi 2009+ Unicode string into a WinAnsi (code page 1252) string
function UnicodeStringToWinAnsi(const S: string): WinAnsiString; inline;

/// convert our UTF-8 encoded buffer into a Delphi 2009+ Unicode string
// - this function is the same as direct assignment, since RawUTF8=AnsiString(CP_UTF8),
// but is faster, since use no Win32 API call
function UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer): UnicodeString; overload; inline;

/// convert a Win-Ansi encoded buffer into a Delphi 2009+ Unicode string
// - this function is faster than default RTL, since use no Win32 API call
function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: integer): UnicodeString; overload;

/// convert a Win-Ansi string into a Delphi 2009+ Unicode string
// - this function is faster than default RTL, since use no Win32 API call
function WinAnsiToUnicodeString(const WinAnsi: WinAnsiString): UnicodeString; inline; overload;

{$endif HASVARUSTRING}

/// convert any generic VCL Text into an UTF-8 encoded String
// - in the VCL context, it's prefered to use TLanguageFile.StringToUTF8()
//  method from mORMoti18n, which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToUTF8(const Text: string): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text buffer into an UTF-8 encoded String
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
procedure StringToUTF8(Text: PChar; TextLen: integer; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into an UTF-8 encoded String
// - this overloaded function use a faster by-reference parameter for the result
procedure StringToUTF8(const Text: string; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into an UTF-8 encoded String
function ToUTF8(const Text: string): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded shortstring Text into an UTF-8 encoded String
// - expects the supplied content to be already ASCII-7 or UTF-8 encoded, e.g.
// a RTTI type or property name: it won't work with Ansi-encoded strings
function ToUTF8(const Ansi7Text: ShortString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TGUID into UTF-8 encoded text
// - will return e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301' (without the {})
// - if you need the embracing { }, use GUIDToRawUTF8() function instead
function ToUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8; overload;

{$ifndef NOVARIANTS}

type
  /// function prototype used internally for variant comparaison
  // - used in mORMot.pas unit e.g. by TDocVariantData.SortByValue
  TVariantCompare = function(const V1,V2: variant): PtrInt;

/// TVariantCompare-compatible case-sensitive comparison function
// - just a wrapper around SortDynArrayVariantComp(caseInsensitive=false)
function VariantCompare(const V1,V2: variant): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// TVariantCompare-compatible case-insensitive comparison function
// - just a wrapper around SortDynArrayVariantComp(caseInsensitive=true)
function VariantCompareI(const V1,V2: variant): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
function VariantToUTF8(const V: Variant): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
function ToUTF8(const V: Variant): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
// - wasString is set if the V value was a text
// - empty and null variants will be stored as 'null' text - as expected by JSON
// - custom variant types (e.g. TDocVariant) will be stored as JSON
procedure VariantToUTF8(const V: Variant; var result: RawUTF8;
  var wasString: boolean); overload;

/// convert any Variant into UTF-8 encoded String
// - use VariantSaveJSON() instead if you need a conversion to JSON with
// custom parameters
// - returns TRUE if the V value was a text, FALSE if was not (e.g. a number)
// - empty and null variants will be stored as 'null' text - as expected by JSON
// - custom variant types (e.g. TDocVariant) will be stored as JSON
function VariantToUTF8(const V: Variant; var Text: RawUTF8): boolean; overload;

/// convert any date/time Variant into a TDateTime value
// - would handle varDate kind of variant, or use a string conversion and
// ISO-8601 parsing if possible
function VariantToDateTime(const V: Variant; var Value: TDateTime): boolean;

/// fast conversion from hexa chars, supplied as a variant string, into a binary buffer
function VariantHexDisplayToBin(const Hex: variant; Bin: PByte; BinBytes: integer): boolean;

/// fast conversion of a binary buffer into hexa chars, as a variant string
function BinToHexDisplayLowerVariant(Bin: pointer; BinBytes: integer): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// fast comparison of a Variant and UTF-8 encoded String (or number)
// - slightly faster than plain V=Str, which computes a temporary variant
// - here Str='' equals unassigned, null or false
// - if CaseSensitive is false, will use IdemPropNameU() for comparison
function VariantEquals(const V: Variant; const Str: RawUTF8;
  CaseSensitive: boolean=true): boolean; overload;

/// convert any Variant into a VCL string type
// - expects any varString value to be stored as a RawUTF8
// - prior to Delphi 2009, use VariantToString(aVariant) instead of
// string(aVariant) to safely retrieve a string=AnsiString value from a variant
// generated by our framework units - otherwise, you may loose encoded characters
// - for Unicode versions of Delphi, there won't be any potential data loss,
// but this version may be slightly faster than a string(aVariant)
function VariantToString(const V: Variant): string;

/// convert any Variant into a value encoded as with :(..:) inlined parameters
// in FormatUTF8(Format,Args,Params)
procedure VariantToInlineValue(const V: Variant; var result: RawUTF8);

/// convert any Variant into another Variant storing an RawUTF8 of the value
// - e.g. VariantToVariantUTF8('toto')='toto' and VariantToVariantUTF8(12)='12'
function VariantToVariantUTF8(const V: Variant): variant;

/// faster alternative to Finalize(aVariantDynArray)
// - this function will take account and optimize the release of a dynamic
// array of custom variant types values
// - for instance, an array of TDocVariant will be optimized for speed
procedure VariantDynArrayClear(var Value: TVariantDynArray);

/// crc32c-based hash of a variant value
// - complex string types will make up to 255 uppercase characters conversion
// if CaseInsensitive is true
// - you can specify your own hashing function if crc32c is not what you expect
function VariantHash(const value: variant; CaseInsensitive: boolean;
  Hasher: THasher=nil): cardinal;

{$endif NOVARIANTS}

{ note: those VariantToInteger*() functions are expected to be there }

/// convert any numerical Variant into a 32-bit integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return FALSE and won't change the
// Value variable content
function VariantToInteger(const V: Variant; var Value: integer): boolean;

/// convert any numerical Variant into a 64-bit integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return FALSE and won't change the
// Value variable content
function VariantToInt64(const V: Variant; var Value: Int64): boolean;

/// convert any numerical Variant into a 64-bit integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return the supplied DefaultValue
function VariantToInt64Def(const V: Variant; DefaultValue: Int64): Int64;

/// convert any numerical Variant into a floating point value
function VariantToDouble(const V: Variant; var Value: double): boolean;

/// convert any numerical Variant into a floating point value
function VariantToDoubleDef(const V: Variant; const default: double=0): double;

/// convert any numerical Variant into a fixed decimals floating point value
function VariantToCurrency(const V: Variant; var Value: currency): boolean;

/// convert any numerical Variant into a boolean value
function VariantToBoolean(const V: Variant; var Value: Boolean): boolean;

/// convert any numerical Variant into an integer
// - it will expect true numerical Variant and won't convert any string nor
// floating-pointer Variant, which will return the supplied DefaultValue
function VariantToIntegerDef(const V: Variant; DefaultValue: integer): integer; overload;

/// convert any generic VCL Text buffer into an UTF-8 encoded buffer
// - Dest must be able to receive at least SourceChars*3 bytes
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char; overload;

/// convert any generic VCL 0-terminated Text buffer into an UTF-8 string
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
procedure StringBufferToUtf8(Source: PChar; out result: RawUTF8); overload;

/// convert any generic VCL Text into a Raw Unicode encoded String
// - it's prefered to use TLanguageFile.StringToUTF8() method in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToRawUnicode(const S: string): RawUnicode; overload;

/// convert any generic VCL Text into a SynUnicode encoded String
// - it's prefered to use TLanguageFile.StringToUTF8() method in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToSynUnicode(const S: string): SynUnicode;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any generic VCL Text into a Raw Unicode encoded String
// - it's prefered to use TLanguageFile.StringToUTF8() method in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function StringToRawUnicode(P: PChar; L: integer): RawUnicode; overload;

/// convert any Raw Unicode encoded string into a generic VCL Text
function RawUnicodeToString(const U: RawUnicode): string; overload;

/// convert any Raw Unicode encoded buffer into a generic VCL Text
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;

/// convert any Raw Unicode encoded buffer into a generic VCL Text
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;

/// convert any SynUnicode encoded string into a generic VCL Text
function SynUnicodeToString(const U: SynUnicode): string;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic VCL Text
// - it's prefered to use TLanguageFile.UTF8ToString() in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function UTF8ToString(const Text: RawUTF8): string;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded buffer into a generic VCL Text
// - it's prefered to use TLanguageFile.UTF8ToString() in mORMoti18n,
// which will handle full i18n of your application
// - it will work as is with Delphi 2009+ (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
function UTF8DecodeToString(P: PUTF8Char; L: integer): string; overload;
  {$ifdef UNICODE}inline;{$endif}

/// convert any UTF-8 encoded buffer into a generic VCL Text
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string); overload;

/// convert any UTF-8 encoded String into a generic WideString Text
function UTF8ToWideString(const Text: RawUTF8): WideString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic WideString Text
procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic WideString Text
procedure UTF8ToWideString(Text: PUTF8Char; Len: integer; var result: WideString); overload;

/// convert any UTF-8 encoded String into a generic SynUnicode Text
function UTF8ToSynUnicode(const Text: RawUTF8): SynUnicode; overload;

/// convert any UTF-8 encoded String into a generic SynUnicode Text
procedure UTF8ToSynUnicode(const Text: RawUTF8; var result: SynUnicode); overload;

/// convert any UTF-8 encoded buffer into a generic SynUnicode Text
procedure UTF8ToSynUnicode(Text: PUTF8Char; Len: integer; var result: SynUnicode); overload;

/// convert any Ansi 7 bit encoded String into a generic VCL Text
// - the Text content must contain only 7 bit pure ASCII characters
function Ansi7ToString(const Text: RawByteString): string; overload;
  {$ifndef UNICODE}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert any Ansi 7 bit encoded String into a generic VCL Text
// - the Text content must contain only 7 bit pure ASCII characters
function Ansi7ToString(Text: PWinAnsiChar; Len: integer): string; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert any Ansi 7 bit encoded String into a generic VCL Text
// - the Text content must contain only 7 bit pure ASCII characters
procedure Ansi7ToString(Text: PWinAnsiChar; Len: integer; var result: string); overload;

/// convert any generic VCL Text into Ansi 7 bit encoded String
// - the Text content must contain only 7 bit pure ASCII characters
function StringToAnsi7(const Text: string): RawByteString;

/// convert any generic VCL Text into WinAnsi (Win-1252) 8 bit encoded String
function StringToWinAnsi(const Text: string): WinAnsiString;
  {$ifdef UNICODE}inline;{$endif}

/// fast Format() function replacement, optimized for RawUTF8
// - only supported token is %, which will be written in the resulting string
// according to each Args[] supplied items - so you will never get any exception
// as with the SysUtils.Format() when a specifier is incorrect
// - resulting string has no length limit and uses fast concatenation
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
function FormatUTF8(const Format: RawUTF8; const Args: array of const): RawUTF8; overload;
  {$ifdef FPC}inline;{$endif}

/// fast Format() function replacement, optimized for RawUTF8
// - overloaded function, which avoid a temporary RawUTF8 instance on stack
procedure FormatUTF8(const Format: RawUTF8; const Args: array of const;
  out result: RawUTF8); overload;

/// fast Format() function replacement, for UTF-8 content stored in shortstring
// - use the same single token % (and implementation) than FormatUTF8()
// - shortstring allows fast stack allocation, so is perfect for small content
// - truncate result if the text size exceeds 255 bytes
procedure FormatShort(const Format: RawUTF8; const Args: array of const;
  var result: shortstring);

/// fast Format() function replacement, for UTF-8 content stored in shortstring
function FormatToShort(const Format: RawUTF8; const Args: array of const): shortstring;

/// fast Format() function replacement, tuned for small content
// - use the same single token % (and implementation) than FormatUTF8()
procedure FormatString(const Format: RawUTF8; const Args: array of const;
  out result: string); overload;

/// fast Format() function replacement, tuned for small content
// - use the same single token % (and implementation) than FormatUTF8()
function FormatString(const Format: RawUTF8; const Args: array of const): string; overload;
  {$ifdef FPC}inline;{$endif}

type
  /// used e.g. by PointerToHexShort/CardinalToHexShort/Int64ToHexShort/FormatShort16
  // - such result type would avoid a string allocation on heap, so are highly
  // recommended e.g. when logging small pieces of information
  TShort16 = string[16];
  PShort16 = ^TShort16;

/// fast Format() function replacement, for UTF-8 content stored in TShort16
// - truncate result if the text size exceeds 16 bytes
procedure FormatShort16(const Format: RawUTF8; const Args: array of const;
  var result: TShort16);

/// fast Format() function replacement, handling % and ? parameters
// - will include Args[] for every % in Format
// - will inline Params[] for every ? in Format, handling special "inlined"
// parameters, as exected by mORMot.pas unit, i.e. :(1234): for numerical
// values, and :('quoted '' string'): for textual values
// - if optional JSONFormat parameter is TRUE, ? parameters will be written
// as JSON quoted strings, without :(...): tokens, e.g. "quoted "" string"
// - resulting string has no length limit and uses fast concatenation
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
function FormatUTF8(const Format: RawUTF8; const Args, Params: array of const;
  JSONFormat: boolean=false): RawUTF8; overload;

/// read and store text into values[] according to fmt specifiers
// - %d as PInteger, %D as PInt64, %u as PCardinal, %U as PQWord, %f as PDouble,
// %F as PCurrency, %x as 8 hexa chars to PInteger, %X as 16 hexa chars to PInt64,
// %s as PShortString (UTF-8 encoded), %S as PRawUTF8, %L as PRawUTF8 (getting
// all text until the end of the line)
// - optionally, specifiers and any whitespace separated identifiers may be
// extracted and stored into the ident[] array, e.g. '%dFirstInt %s %DOneInt64'
// will store ['dFirstInt','s','DOneInt64'] into ident
function ScanUTF8(const text, fmt: RawUTF8; const values: array of pointer;
  ident: PRawUTF8DynArray=nil): integer; overload;
  {$ifdef FPC}inline;{$endif}

/// read text from P/PLen and store it into values[] according to fmt specifiers
function ScanUTF8(P: PUTF8Char; PLen: integer; const fmt: RawUTF8;
  const values: array of pointer; ident: PRawUTF8DynArray): integer; overload;

/// convert an open array (const Args: array of const) argument to an UTF-8
// encoded text
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8;
  wasString: PBoolean=nil);

type
  /// a memory structure which avoids a temporary RawUTF8 allocation
  // - used by VarRecToTempUTF8() and FormatUTF8()/FormatShort()
  TTempUTF8 = record
    Len: PtrInt;
    Text: PUTF8Char;
    TempRawUTF8: pointer;
    Temp: array[0..23] of AnsiChar;
  end;
  PTempUTF8 = ^TTempUTF8;

/// convert an open array (const Args: array of const) argument to an UTF-8
// encoded text, using a specified temporary buffer
// - this function would allocate a RawUTF8 in TempRawUTF8 only if needed,
// but use the supplied Res.Temp[] buffer for numbers to text conversion -
// caller should ensure to make RawUTF8(TempRawUTF8) := '' on the entry
// - it would return the number of UTF-8 bytes, i.e. Res.Len
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
function VarRecToTempUTF8(const V: TVarRec; var Res: TTempUTF8): integer;

/// convert an open array (const Args: array of const) argument to an UTF-8
// encoded text, returning FALSE if the argument was not a string value
function VarRecToUTF8IsString(const V: TVarRec; var value: RawUTF8): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an open array (const Args: array of const) argument to an Int64
// - returns TRUE and set Value if the supplied argument is a vtInteger, vtInt64
// or vtBoolean
// - returns FALSE if the argument is not an integer
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function VarRecToInt64(const V: TVarRec; out value: Int64): boolean;

/// convert an open array (const Args: array of const) argument to a floating
// point value
// - returns TRUE and set Value if the supplied argument is a number (e.g.
// vtInteger, vtInt64, vtCurrency or vtExtended)
// - returns FALSE if the argument is not a number
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function VarRecToDouble(const V: TVarRec; out value: double): boolean;

/// convert an open array (const Args: array of const) argument to a value
// encoded as with :(...): inlined parameters in FormatUTF8(Format,Args,Params)
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - any supplied TObject instance will be written as their class name
procedure VarRecToInlineValue(const V: TVarRec; var result: RawUTF8);

/// get an open array (const Args: array of const) character argument
// - only handle varChar and varWideChar kind of arguments
function VarRecAsChar(const V: TVarRec): integer;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// function prototype used internally for UTF-8 buffer comparaison
  // - used in mORMot.pas unit during TSQLTable rows sort and by TSQLQuery
  TUTF8Compare = function(P1,P2: PUTF8Char): PtrInt;

/// convert the endianness of a given unsigned 32-bit integer into BigEndian
function bswap32(a: cardinal): cardinal;
  {$ifdef FPC}inline;{$endif}

/// convert the endianness of a given unsigned 64-bit integer into BigEndian
function bswap64(const a: QWord): QWord;
  {$ifdef FPC}inline;{$endif}

/// convert the endianness of an array of unsigned 64-bit integer into BigEndian
// - n is required to be > 0
// - warning: on x86, a should be <> b
procedure bswap64array(a,b: PQWordArray; n: PtrInt);

/// fast concatenation of several AnsiStrings
function RawByteStringArrayConcat(const Values: array of RawByteString): RawByteString;

/// creates a TBytes from a RawByteString memory buffer
procedure RawByteStringToBytes(const buf: RawByteString; out bytes: TBytes);

/// creates a RawByteString memory buffer from a TBytes content
procedure BytesToRawByteString(const bytes: TBytes; out buf: RawByteString);
  {$ifdef HASINLINE}inline;{$endif}

/// creates a RawByteString memory buffer from an embedded resource
// - returns '' if the resource is not found
// - warning: resources size may be rounded up to alignment
// - you can specify a library (dll) resource instance handle, if needed
procedure ResourceToRawByteString(const ResName: string; ResType: PChar;
  out buf: RawByteString; Instance: THandle=0);

/// creates a RawByteString memory buffer from an SynLZ-compressed embedded resource
// - returns '' if the resource is not found
// - this method would use SynLZDecompress() after ResourceToRawByteString(),
// with a ResType=PChar(10) (i.e. RC_DATA)
// - you can specify a library (dll) resource instance handle, if needed
procedure ResourceSynLZToRawByteString(const ResName: string;
  out buf: RawByteString; Instance: THandle=0);

{$ifndef ENHANCEDRTL} { is our Enhanced Runtime (or LVCL) library not installed? }

/// fast dedicated RawUTF8 version of Trim()
// - implemented using x86 asm, if possible
// - this Trim() is seldom used, but this RawUTF8 specific version is needed
// e.g. by Delphi 2009+, to avoid two unnecessary conversions into UnicodeString
function Trim(const S: RawUTF8): RawUTF8;

{$define OWNNORMTOUPPER} { NormToUpper[] exists only in our enhanced RTL }

{$endif ENHANCEDRTL}

/// our fast version of CompareMem() with optimized asm for x86 and tune pascal
function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;

{$ifdef HASINLINE}
function CompareMemFixed(P1, P2: Pointer; Length: PtrInt): Boolean; inline;
{$else}
/// a CompareMem()-like function designed for small and fixed-sized content
// - here, Length is expected to be a constant value - typically from sizeof() -
// so that inlining has better performance than calling the CompareMem() function
var CompareMemFixed: function(P1, P2: Pointer; Length: PtrInt): Boolean = CompareMem;
{$endif HASINLINE}

/// a CompareMem()-like function designed for small (a few bytes) content
function CompareMemSmall(P1, P2: Pointer; Length: PtrInt): Boolean; {$ifdef HASINLINE}inline;{$endif}

/// convert an IPv4 'x.x.x.x' text into its 32-bit value
// - returns TRUE if the text was a valid IPv4 text, unserialized as 32-bit aValue
// - returns FALSE on parsing error, also setting aValue=0
// - '' or '127.0.0.1' will also return false
function IPToCardinal(P: PUTF8Char; out aValue: cardinal): boolean; overload;

/// convert an IPv4 'x.x.x.x' text into its 32-bit value
// - returns TRUE if the text was a valid IPv4 text, unserialized as 32-bit aValue
// - returns FALSE on parsing error, also setting aValue=0
// - '' or '127.0.0.1' will also return false
function IPToCardinal(const aIP: RawUTF8; out aValue: cardinal): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an IPv4 'x.x.x.x' text into its 32-bit value, 0 or localhost
// - returns <> 0 value if the text was a valid IPv4 text, 0 on parsing error
// - '' or '127.0.0.1' will also return 0
function IPToCardinal(const aIP: RawUTF8): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert some ASCII-7 text into binary, using Emile Baudot code
// - as used in telegraphs, covering #10 #13 #32 a-z 0-9 - ' , ! : ( + ) $ ? @ . / ;
// charset, following a custom static-huffman-like encoding with 5-bit masks
// - any upper case char will be converted into lowercase during encoding
// - other characters (e.g. UTF-8 accents, or controls chars) will be ignored
// - resulting binary will consume 5 (or 10) bits per character
// - reverse of the BaudotToAscii() function
// - the "baud" symbol rate measurement comes from Emile's name ;)
function AsciiToBaudot(P: PAnsiChar; len: integer): RawByteString; overload;

/// convert some ASCII-7 text into binary, using Emile Baudot code
// - as used in telegraphs, covering #10 #13 #32 a-z 0-9 - ' , ! : ( + ) $ ? @ . / ;
// charset, following a custom static-huffman-like encoding with 5-bit masks
// - any upper case char will be converted into lowercase during encoding
// - other characters (e.g. UTF-8 accents, or controls chars) will be ignored
// - resulting binary will consume 5 (or 10) bits per character
// - reverse of the BaudotToAscii() function
// - the "baud" symbol rate measurement comes from Emile's name ;)
function AsciiToBaudot(const Text: RawUTF8): RawByteString; overload;

/// convert some Baudot code binary, into ASCII-7 text
// - reverse of the AsciiToBaudot() function
// - any uppercase character would be decoded as lowercase - and some characters
// may have disapeared
// - the "baud" symbol rate measurement comes from Emile's name ;)
function BaudotToAscii(Baudot: PByteArray; len: integer): RawUTF8; overload;

/// convert some Baudot code binary, into ASCII-7 text
// - reverse of the AsciiToBaudot() function
// - any uppercase character would be decoded as lowercase - and some characters
// may have disapeared
// - the "baud" symbol rate measurement comes from Emile's name ;)
function BaudotToAscii(const Baudot: RawByteString): RawUTF8; overload;

{$ifdef UNICODE}
/// our fast RawUTF8 version of Pos(), for Unicode only compiler
// - this Pos() is seldom used, but this RawUTF8 specific version is needed
// by Delphi 2009+, to avoid two unnecessary conversions into UnicodeString
// - just a wrapper around PosEx(substr,str,1)
function Pos(const substr, str: RawUTF8): Integer; overload; inline;
{$endif UNICODE}

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - only useful if our Enhanced Runtime (or LVCL) library is not installed
function Int64ToUtf8(Value: Int64): RawUTF8; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// fast RawUTF8 version of IntToStr(), with proper QWord conversion
procedure UInt64ToUtf8(Value: QWord; var result: RawUTF8);

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - only useful if our Enhanced Runtime (or LVCL) library is not installed
function Int32ToUtf8(Value: PtrInt): RawUTF8; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - result as var parameter saves a local assignment and a try..finally
procedure Int32ToUTF8(Value: PtrInt; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast RawUTF8 version of IntToStr()
// - without any slow UnicodeString=String->AnsiString conversion for Delphi 2009
// - result as var parameter saves a local assignment and a try..finally
procedure Int64ToUtf8(Value: Int64; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast RawUTF8 version of IntToStr()
function ToUTF8(Value: PtrInt): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef CPU64}
/// use our fast RawUTF8 version of IntToStr()
function ToUTF8(Value: Int64): RawUTF8; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}
{$endif}

/// optimized conversion of a cardinal into RawUTF8
function UInt32ToUtf8(Value: PtrUInt): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// optimized conversion of a cardinal into RawUTF8
procedure UInt32ToUtf8(Value: PtrUInt; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// faster version than default SysUtils.IntToStr implementation
function IntToString(Value: integer): string; overload;

/// faster version than default SysUtils.IntToStr implementation
function IntToString(Value: cardinal): string; overload;

/// faster version than default SysUtils.IntToStr implementation
function IntToString(Value: Int64): string; overload;

/// convert a floating-point value to its numerical text equivalency
function DoubleToString(Value: Double): string;

/// convert a currency value from its Int64 binary representation into
// its numerical text equivalency
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
function Curr64ToString(Value: Int64): string;

type
  /// used to store a set of 8-bit encoded characters
  TSynAnsicharSet = set of AnsiChar;
  /// used to store a set of 8-bit unsigned integers
  TSynByteSet = set of Byte;
  /// used to store a set of 8-bit unsigned integers as 256 booleans
  TSynByteBoolean = array[byte] of boolean;

/// returns the supplied text content, without any control char
// - a control char has an ASCII code #0 .. #32, i.e. text[]<=' '
// - you can specify a custom char set to be excluded, if needed
function TrimControlChars(const text: RawUTF8; const controls: TSynAnsicharSet=[#0..' ']): RawUTF8;

var
  /// best possible precision when rendering a "single" kind of float
  // - can be used as parameter for ExtendedToString/ExtendedToStr
  // - is defined as a var, so that you may be able to override the default
  // settings, for the whole process
  SINGLE_PRECISION: integer = 8;
  /// best possible precision when rendering a "double" kind of float
  // - can be used as parameter for ExtendedToString/ExtendedToStr
  // - is defined as a var, so that you may be able to override the default
  // settings, for the whole process
  DOUBLE_PRECISION: integer = 15;
  /// best possible precision when rendering a "extended" kind of float
  // - can be used as parameter for ExtendedToString/ExtendedToStr
  // - is defined as a var, so that you may be able to override the default
  // settings, for the whole process
  EXTENDED_PRECISION: integer = 18;

type
  {$ifdef CPUARM}
  // ARM does not support 80bit extended -> 64bit double is enough for us
  TSynExtended = double;
  {$else}
  {$ifdef CPU64}
  TSynExtended = double;
  {$else}
  /// the floating-point type to be used for best precision and speed
  // - will allow to fallback to double e.g. on x64 and ARM CPUs
  TSynExtended = extended;
  {$endif}
  {$endif}
  /// the non-number values potentially stored in an IEEE floating point
  TSynExtendedNan = (seNumber, seNan, seInf, seNegInf);

const
  /// the JavaScript-like values of non-number IEEE constants
  // - as recognized by ExtendedToStringNan, and used by TTextWriter.Add()
  // when serializing such single/double/extended floating-point values
  JSON_NAN: array[TSynExtendedNan] of string[11] = (
    '', '"NaN"', '"Infinity"', '"-Infinity"');

/// compare to floating point values, with IEEE 754 double precision
// - use this function instead of raw = operator
// - the precision is calculated from the A and B value range
// - faster equivalent than SameValue() in Math unit
// - if you know the precision range of A and B, it's faster to check abs(A-B)<range
function SameValue(const A, B: Double; DoublePrec: double = 1E-12): Boolean;

/// compare to floating point values, with IEEE 754 double precision
// - use this function instead of raw = operator
// - the precision is calculated from the A and B value range
// - faster equivalent than SameValue() in Math unit
// - if you know the precision range of A and B, it's faster to check abs(A-B)<range
function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended = 1E-12): Boolean;

/// a comparison function for sorting IEEE 754 double precision values
function CompareFloat(const A, B: double): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 32-bit signed integer values
function CompareInteger(const A, B: integer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 64-bit signed integer values
function CompareInt64(const A, B: Int64): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 32-bit unsigned integer values
function CompareCardinal(const A, B: cardinal): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// a comparison function for sorting 64-bit unsigned integer values
// - note that QWord(A)>QWord(B) is wrong on older versions of Delphi, so you
// should better use this function or SortDynArrayQWord() to properly compare
// two QWord values over CPUX86
function CompareQWord(A, B: QWord): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the sum of values, using a running compensation for lost low-order bits
// - a naive "Sum := Sum + Data" will be restricted to 53 bits of resolution,
// so will eventually result in an incorrect number
// - Kahan algorithm keeps track of the accumulated error in integer operations,
// to achieve a precision of more than 100 bits
// - see https://en.wikipedia.org/wiki/Kahan_summation_algorithm
procedure KahanSum(const Data: double; var Sum, Carry: double);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a floating-point value to its numerical text equivalency
// - depending on the platform, it may either call ExtendedToStringNoExp or
// use FloatToText() in ffGeneral mode (the shortest possible decimal string
// using fixed or scientific format)
// - returns the count of chars stored into S (S[0] is not set)
function ExtendedToString(var S: ShortString; Value: TSynExtended; Precision: integer): integer;
  {$ifdef FPC}inline;{$endif}

/// convert a floating-point value to its numerical text equivalency without
// scientification notation
// - returns the count of chars stored into S (S[0] is not set)
// - call str(Value:0:Precision,S) to avoid any Exponent notation
function ExtendedToStringNoExp(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;

/// check if the supplied text is NAN/INF/+INF/-INF, i.e. not a number
// - as returned by ExtendedToString() textual conversion
// - such values do appear as IEEE floating points, but are not defined in JSON
function ExtendedToStringNan(const s: shortstring): TSynExtendedNan;
  {$ifdef HASINLINE}inline;{$endif}

/// check if the supplied text is NAN/INF/+INF/-INF, i.e. not a number
// - as returned by ExtendedToString() textual conversion
// - such values do appear as IEEE floating points, but are not defined in JSON
function ExtendedToStrNan(const s: RawUTF8): TSynExtendedNan;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a floating-point value to its numerical text equivalency
function ExtendedToStr(Value: TSynExtended; Precision: integer): RawUTF8; overload;

/// convert a floating-point value to its numerical text equivalency
procedure ExtendedToStr(Value: TSynExtended; Precision: integer; var result: RawUTF8); overload;

/// convert a floating-point value to its numerical text equivalency
function DoubleToStr(Value: Double): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// fast retrieve the position of a given character
function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// fast retrieve the position of any value of a given set of characters
function PosCharAny(Str: PUTF8Char; Characters: PAnsiChar): PUTF8Char;

/// a non case-sensitive RawUTF8 version of Pos()
// - uppersubstr is expected to be already in upper case
// - this version handle only 7 bit ASCII (no accentuated characters)
function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): PtrInt;

/// a non case-sensitive version of Pos()
// - uppersubstr is expected to be already in upper case
// - this version handle only 7 bit ASCII (no accentuated characters)
function StrPosI(uppersubstr,str: PUTF8Char): PUTF8Char;

/// a non case-sensitive RawUTF8 version of Pos()
// - substr is expected to be already in upper case
// - this version will decode the UTF-8 content before using NormToUpper[]
function PosIU(substr: PUTF8Char; const str: RawUTF8): Integer;

/// internal fast integer val to text conversion
// - expect the last available temporary char position in P
// - return the last written char position (write in reverse order in P^)
// - typical use:
//  !function Int32ToUTF8(Value: PtrInt): RawUTF8;
//  !var tmp: array[0..23] of AnsiChar;
//  !    P: PAnsiChar;
//  !begin
//  !  P := StrInt32(@tmp[23],Value);
//  !  SetString(result,P,@tmp[23]-P);
//  !end;
// - convert the input value as PtrInt, so as Int64 on 64-bit CPUs
// - not to be called directly: use IntToStr() or Int32ToUTF8() instead
function StrInt32(P: PAnsiChar; val: PtrInt): PAnsiChar;

/// internal fast unsigned integer val to text conversion
// - expect the last available temporary char position in P
// - return the last written char position (write in reverse order in P^)
// - convert the input value as PtrUInt, so as QWord on 64-bit CPUs
function StrUInt32(P: PAnsiChar; val: PtrUInt): PAnsiChar;

/// internal fast Int64 val to text conversion
// - same calling convention as with StrInt32() above
function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// internal fast unsigned Int64 val to text conversion
// - same calling convention as with StrInt32() above
function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
  {$ifdef CPU64}inline;{$endif}

/// fast add some characters to a RawUTF8 string
// - faster than SetString(tmp,Buffer,BufferLen); Text := Text+tmp;
procedure AppendBufferToRawUTF8(var Text: RawUTF8; Buffer: pointer; BufferLen: PtrInt);

/// fast add one character to a RawUTF8 string
// - faster than Text := Text + ch;
procedure AppendCharToRawUTF8(var Text: RawUTF8; Ch: AnsiChar);

/// fast add some characters to a RawUTF8 string
// - faster than Text := Text+RawUTF8(Buffers[0])+RawUTF8(Buffers[0])+...
procedure AppendBuffersToRawUTF8(var Text: RawUTF8; const Buffers: array of PUTF8Char);

/// fast add some characters from a RawUTF8 string into a given buffer
// - warning: the Buffer should contain enough space to store the Text, otherwise
// you may encounter buffer overflows and random memory errors
function AppendRawUTF8ToBuffer(Buffer: PUTF8Char; const Text: RawUTF8): PUTF8Char;

/// fast add text conversion of a 32-bit signed integer value into a given buffer
// - warning: the Buffer should contain enough space to store the text, otherwise
// you may encounter buffer overflows and random memory errors
function AppendUInt32ToBuffer(Buffer: PUTF8Char; Value: cardinal): PUTF8Char;


/// buffer-safe version of StrComp(), to be used with PUTF8Char/PAnsiChar
// - pure pascal StrComp() won't access the memory beyond the string, but this
// function is defined for compatibility with SSE 4.2 expectations
function StrCompFast(Str1, Str2: pointer): PtrInt;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// fastest available version of StrComp(), to be used with PUTF8Char/PAnsiChar
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely StrCompSSE42() if you are confident on your input
var StrComp: function (Str1, Str2: pointer): PtrInt = StrCompFast;

/// pure pascal version of strspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 3 bytes beyond
// accept but never after s end, so is safe e.g. over memory mapped files
function strspnpas(s,accept: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// pure pascal version of strcspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 3 bytes beyond
// reject but never after s end, so is safe e.g. over memory mapped files
function strcspnpas(s,reject: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// fastest available version of strspn(), to be used with PUTF8Char/PAnsiChar
// - returns size of initial segment of s which appears in accept chars, e.g.
// ! strspn('abcdef','debca')=5
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely strspnsse42() if you are confident on your input
var strspn: function (s,accept: pointer): integer = strspnpas;

/// fastest available version of strcspn(), to be used with PUTF8Char/PAnsiChar
// - returns size of initial segment of s which doesn't appears in reject chars, e.g.
// ! strcspn('1234,6789',',')=4
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely strcspnsse42() if you are confident on your input
var strcspn: function (s,reject: pointer): integer = strcspnpas;

{$ifndef ABSOLUTEPASCAL}
{$ifdef CPUINTEL}
{$ifdef HASAESNI}
/// SSE 4.2 version of StrComp(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of StrComp() when you are confident about your
// Str1/Str2 input buffers, checking if cfSSE42 in CpuFeatures
function StrCompSSE42(Str1, Str2: pointer): PtrInt;

// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of StrLen() when you are confident about your
// S input buffers, checking if cfSSE42 in CpuFeatures
function StrLenSSE42(S: pointer): PtrInt;
{$endif HASAESNI}

/// SSE 4.2 version of strspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of strspn() when you are confident about your
// s/accept input buffers, checking if cfSSE42 in CpuFeatures
function strspnsse42(s,accept: pointer): integer;

/// SSE 4.2 version of strcspn(), to be used with PUTF8Char/PAnsiChar
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of strcspn() when you are confident about your
// s/reject input buffers, checking if cfSSE42 in CpuFeatures
function strcspnsse42(s,reject: pointer): integer;
{$endif CPUINTEL}
{$endif ABSOLUTEPASCAL}

/// use our fast version of StrIComp(), to be used with PUTF8Char/PAnsiChar
function StrIComp(Str1, Str2: pointer): PtrInt;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// slower version of StrLen(), but which will never read beyond the string
// - this version won't access the memory beyond the string, so may be
// preferred to StrLen(), when using e.g. memory mapped files or any memory
// protected buffer
function StrLenPas(S: pointer): PtrInt;

/// our fast version of StrLen(), to be used with PUTF8Char/PAnsiChar
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely StrLenSSE42() if you are confident on your input
var StrLen: function(S: pointer): PtrInt = StrLenPas;

/// our fast version of FillChar()
// - this version will use fast SSE2 instructions (if available), on both Win32
// and Win64 platforms, or an optimized X86 revision on older CPUs
var FillcharFast: procedure(var Dest; count: PtrInt; Value: byte);

/// our fast version of move()
// - this version will use fast SSE2 instructions (if available), on both Win32
// and Win64 platforms, or an optimized X86 revision on older CPUs
var MoveFast: procedure(const Source; var Dest; Count: PtrInt);

/// our fast version of StrLen(), to be used with PWideChar
function StrLenW(S: PWideChar): PtrInt;

/// use our fast version of StrComp(), to be used with PWideChar
function StrCompW(Str1, Str2: PWideChar): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast version of StrCompL(), to be used with PUTF8Char
function StrCompL(P1,P2: PUTF8Char; L, Default: Integer): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// use our fast version of StrCompIL(), to be used with PUTF8Char
function StrCompIL(P1,P2: PUTF8Char; L: Integer; Default: Integer=0): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

{$ifdef USENORMTOUPPER}
{$ifdef OWNNORMTOUPPER}
type
  TNormTable = packed array[AnsiChar] of AnsiChar;
  PNormTable = ^TNormTable;
  TNormTableByte = packed array[byte] of byte;
  PNormTableByte = ^TNormTableByte;

var
  /// the NormToUpper[] array is defined in our Enhanced RTL: define it now
  //  if it was not installed
  // - handle 8 bit upper chars as in WinAnsi / code page 1252 (e.g. accents)
  NormToUpper: TNormTable;
  NormToUpperByte: TNormTableByte absolute NormToUpper;

  /// the NormToLower[] array is defined in our Enhanced RTL: define it now
  //  if it was not installed
  // - handle 8 bit upper chars as in WinAnsi / code page 1252 (e.g. accents)
  NormToLower: TNormTable;
  NormToLowerByte: TNormTableByte absolute NormToLower;
{$endif}
{$else}
{$undef OWNNORMTOUPPER}
{$endif}

var
  /// this table will convert 'a'..'z' into 'A'..'Z'
  // - so it will work with UTF-8 without decoding, whereas NormToUpper[] expects
  // WinAnsi encoding
  NormToUpperAnsi7: TNormTable;
  NormToUpperAnsi7Byte: TNormTableByte absolute NormToUpperAnsi7;
  /// case sensitive NormToUpper[]/NormToLower[]-like table
  // - i.e. NormToNorm[c] = c
  NormToNorm: TNormTable;
  NormToNormByte: TNormTableByte absolute NormToNorm;


/// get the signed 32-bit integer value stored in P^
// - we use the PtrInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
// - will end parsing when P^ does not contain any number (e.g. it reaches any
// ending #0 char)
function GetInteger(P: PUTF8Char): PtrInt; overload;

/// get the signed 32-bit integer value stored in P^..PEnd^
// - will end parsing when P^ does not contain any number (e.g. it reaches any
// ending #0 char), or when P reached PEnd (avoiding any buffer overflow)
function GetInteger(P,PEnd: PUTF8Char): PtrInt; overload;

/// get the signed 32-bit integer value stored in P^
// - if P if nil or not start with a valid numerical value, returns Default
function GetIntegerDef(P: PUTF8Char; Default: PtrInt): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 32-bit integer value stored in P^
// - this version return 0 in err if no error occured, and 1 if an invalid
// character was found, not its exact index as for the val() function
function GetInteger(P: PUTF8Char; var err: integer): PtrInt; overload;

/// get the unsigned 32-bit integer value stored in P^
// - we use the PtrUInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
function GetCardinal(P: PUTF8Char): PtrUInt;

/// get the unsigned 32-bit integer value stored in P^
// - if P if nil or not start with a valid numerical value, returns Default
function GetCardinalDef(P: PUTF8Char; Default: PtrUInt): PtrUInt;

/// get the unsigned 32-bit integer value stored as Unicode string in P^
function GetCardinalW(P: PWideChar): PtrUInt;

/// get a boolean value stored as true/false text in P^
// - would also recognize any non 0 integer as true
function GetBoolean(P: PUTF8Char): boolean;

/// get the 64-bit integer value stored in P^
function GetInt64(P: PUTF8Char): Int64; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get the 64-bit integer value stored in P^
// - if P if nil or not start with a valid numerical value, returns Default
function GetInt64Def(P: PUTF8Char; const Default: Int64): Int64;

/// get the 64-bit signed integer value stored in P^
procedure SetInt64(P: PUTF8Char; var result: Int64);
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit unsigned integer value stored in P^
procedure SetQWord(P: PUTF8Char; var result: QWord);
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit signed integer value stored in P^
// - set the err content to the index of any faulty character, 0 if conversion
// was successful (same as the standard val function)
function GetInt64(P: PUTF8Char; var err: integer): Int64; overload;
  {$ifdef CPU64}inline;{$endif}

/// get the 64-bit unsigned integer value stored in P^
// - set the err content to the index of any faulty character, 0 if conversion
// was successful (same as the standard val function)
function GetQWord(P: PUTF8Char; var err: integer): QWord;

/// get the extended floating point value stored in P^
// - set the err content to the index of any faulty character, 0 if conversion
// was successful (same as the standard val function)
function GetExtended(P: PUTF8Char; out err: integer): TSynExtended; overload;

/// get the extended floating point value stored in P^
// - this overloaded version returns 0 as a result if the content of P is invalid
function GetExtended(P: PUTF8Char): TSynExtended; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get the WideChar stored in P^ (decode UTF-8 if necessary)
// - any surrogate (UCS4>$ffff) will be returned as '?'
function GetUTF8Char(P: PUTF8Char): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// get the UCS4 char stored in P^ (decode UTF-8 if necessary)
function NextUTF8UCS4(var P: PUTF8Char): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 32-bit integer value stored in a RawUTF8 string
// - we use the PtrInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
function UTF8ToInteger(const value: RawUTF8; Default: PtrInt=0): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get and check range of a signed 32-bit integer stored in a RawUTF8 string
// - we use the PtrInt result type, even if expected to be 32-bit, to use
// native CPU register size (don't want any 32-bit overflow here)
function UTF8ToInteger(const value: RawUTF8; Min,max: PtrInt; Default: PtrInt=0): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 32-bit integer value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into an integer
function ToInteger(const text: RawUTF8; out value: integer): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get the unsigned 32-bit cardinal value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into a cardinal
function ToCardinal(const text: RawUTF8; out value: cardinal; minimal: cardinal=0): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 64-bit integer value stored in a RawUTF8 string
// - returns TRUE if the supplied text was successfully converted into an Int64
function ToInt64(const text: RawUTF8; out value: Int64): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// get the signed 64-bit integer value stored in a RawUTF8 string
// - returns the default value if the supplied text was not successfully
// converted into an Int64
function UTF8ToInt64(const text: RawUTF8; const default: Int64=0): Int64;

/// encode a string to be compatible with URI encoding
function UrlEncode(const svar: RawUTF8): RawUTF8; overload;

/// encode a string to be compatible with URI encoding
function UrlEncode(Text: PUTF8Char): RawUTF8; overload;

/// encode supplied parameters to be compatible with URI encoding
// - parameters must be supplied two by two, as Name,Value pairs, e.g.
// ! url := UrlEncode(['select','*','where','ID=12','offset',23,'object',aObject]);
// - parameters names should be plain ASCII-7 RFC compatible identifiers
// (0..9a..zA..Z_.~), otherwise their values are skipped
// - parameters values can be either textual, integer or extended, or any TObject
// - TObject serialization into UTF-8 will be processed by the ObjectToJSON()
// function
function UrlEncode(const NameValuePairs: array of const): RawUTF8; overload;

/// encode a JSON object UTF-8 buffer into URI parameters
// - you can specify property names to ignore during the object decoding
function UrlEncodeJsonObject(const URIName: RawUTF8; ParametersJSON: PUTF8Char;
  const PropNamesToIgnore: array of RawUTF8): RawUTF8;

/// decode a string compatible with URI encoding into its original value
// - you can specify the decoding range (as in copy(s,i,len) function)
function UrlDecode(const s: RawUTF8; i: PtrInt = 1; len: PtrInt = -1): RawUTF8; overload;

/// decode a string compatible with URI encoding into its original value
function UrlDecode(U: PUTF8Char): RawUTF8; overload;

/// decode a specified parameter compatible with URI encoding into its original
// textual value
// - UrlDecodeValue('select=%2A&where=LastName%3D%27M%C3%B4net%27','SELECT=',V,@Next)
// will return Next^='where=...' and V='*'
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeValue(U: PUTF8Char; const Upper: RawUTF8; var Value: RawUTF8;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// integer numerical value
// - UrlDecodeInteger('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
// will return Next^='where=...' and O=20
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeInteger(U: PUTF8Char; const Upper: RawUTF8; var Value: integer;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// cardinal numerical value
// - UrlDecodeCardinal('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
// will return Next^='where=...' and O=20
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeCardinal(U: PUTF8Char; const Upper: RawUTF8; var Value: Cardinal;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// Int64 numerical value
// - UrlDecodeInt64('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
// will return Next^='where=...' and O=20
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeInt64(U: PUTF8Char; const Upper: RawUTF8; var Value: Int64;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// floating-point value
// - UrlDecodeExtended('price=20.45&where=LastName%3D%27M%C3%B4net%27','PRICE=',P,@Next)
// will return Next^='where=...' and P=20.45
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeExtended(U: PUTF8Char; const Upper: RawUTF8; var Value: TSynExtended;
  Next: PPUTF8Char=nil): boolean;

/// decode a specified parameter compatible with URI encoding into its original
// floating-point value
// - UrlDecodeDouble('price=20.45&where=LastName%3D%27M%C3%B4net%27','PRICE=',P,@Next)
// will return Next^='where=...' and P=20.45
// - if Upper is not found, Value is not modified, and result is FALSE
// - if Upper is found, Value is modified with the supplied content, and result is TRUE
function UrlDecodeDouble(U: PUTF8Char; const Upper: RawUTF8; var Value: double;
  Next: PPUTF8Char=nil): boolean;

/// returns TRUE if all supplied parameters do exist in the URI encoded text
// - CSVNames parameter shall provide as a CSV list of names
// - e.g. UrlDecodeNeedParameters('price=20.45&where=LastName%3D','price,where')
// will return TRUE
function UrlDecodeNeedParameters(U, CSVNames: PUTF8Char): boolean;

/// decode the next Name=Value&.... pair from input URI
// - Name is returned directly (should be plain ASCII 7 bit text)
// - Value is returned after URI decoding (from %.. patterns)
// - if a pair is decoded, return a PUTF8Char pointer to the next pair in
// the input buffer, or points to #0 if all content has been processed
// - if a pair is not decoded, return nil
function UrlDecodeNextNameValue(U: PUTF8Char; var Name,Value: RawUTF8): PUTF8Char;

/// decode a URI-encoded Value from an input buffer
// - decoded value is set in Value out variable
// - returns a pointer just after the decoded value (may points e.g. to
// #0 or '&') - it is up to the caller to continue the process or not
function UrlDecodeNextValue(U: PUTF8Char; out Value: RawUTF8): PUTF8Char;

/// decode a URI-encoded Name from an input buffer
// - decoded value is set in Name out variable
// - returns a pointer just after the decoded name, after the '='
// - returns nil if there was no name=... pattern in U
function UrlDecodeNextName(U: PUTF8Char; out Name: RawUTF8): PUTF8Char;

/// checks if the supplied UTF-8 text don't need URI encoding
// - returns TRUE if all its chars are non-void plain ASCII-7 RFC compatible
// identifiers (0..9a..zA..Z-_.~)
function IsUrlValid(P: PUTF8Char): boolean;

/// checks if the supplied UTF-8 text values don't need URI encoding
// - returns TRUE if all its chars of all strings are non-void plain ASCII-7 RFC
// compatible identifiers (0..9a..zA..Z-_.~)
function AreUrlValid(const Url: array of RawUTF8): boolean;

/// ensure the supplied URI contains a trailing '/' charater
function IncludeTrailingURIDelimiter(const URI: RawByteString): RawByteString;

/// encode name/value pairs into CSV/INI raw format
function CSVEncode(const NameValuePairs: array of const;
  const KeySeparator: RawUTF8='='; const ValueSeparator: RawUTF8=#13#10): RawUTF8;

/// find a given name in name/value pairs, and returns the value as RawUTF8
function ArrayOfConstValueAsText(const NameValuePairs: array of const;
  const aName: RawUTF8): RawUTF8;

/// returns TRUE if the given text buffer contains a..z,A..Z,0..9,_ characters
// - should match most usual property names values or other identifier names
// in the business logic source code
// - i.e. can be tested via IdemPropName*() functions, and the MongoDB-like
// extended JSON syntax as generated by dvoSerializeAsExtendedJson
// - first char must be alphabetical or '_', following chars can be
// alphanumerical or '_'
function PropNameValid(P: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if the given text buffers contains A..Z,0..9,_ characters
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this function won't check the first char the same way than PropNameValid()
function PropNamesValid(const Values: array of RawUTF8): boolean;

/// returns TRUE if the given text buffer contains simple characters as
// recognized by JSON extended syntax
// - follow GetJSONPropName and GotoNextJSONObjectOrArray expectations
function JsonPropNameValid(P: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if the given text buffers would be escaped when written as JSON
// - e.g. if contains " or \ characters, as defined by
// http://www.ietf.org/rfc/rfc4627.txt
function NeedsJsonEscape(const Text: RawUTF8): boolean;

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
function IdemPropName(const P1,P2: shortstring): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P2 to be a PAnsiChar with a specified length
function IdemPropName(const P1: shortstring; P2: PUTF8Char; P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P1 and P2 to be a PAnsiChar with specified lengths
function IdemPropName(P1,P2: PUTF8Char; P1Len,P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P2 to be a PAnsiChar with specified length
function IdemPropNameU(const P1: RawUTF8; P2: PUTF8Char; P2Len: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case insensitive comparison of ASCII identifiers of same length
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
// - this version expects P1 and P2 to be a PAnsiChar with an already checked
// identical length, so may be used for a faster process, e.g. in a loop
// - if P1 and P2 are RawUTF8, you should better call overloaded function
// IdemPropNameU(const P1,P2: RawUTF8), which would be slightly faster by
// using the length stored before the actual text buffer of each RawUTF8
function IdemPropNameUSameLen(P1,P2: PUTF8Char; P1P2Len: PtrInt): boolean;
  {$ifndef ANDROID}{$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}{$endif}

/// case insensitive comparison of ASCII identifiers
// - use it with property names values (i.e. only including A..Z,0..9,_ chars)
function IdemPropNameU(const P1,P2: RawUTF8): boolean; overload;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// returns true if the beginning of p^ is the same as up^
// - ignore case - up^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters): but when
// you only need to search for field names e.g. IdemPChar() is prefered, because
// it'll be faster than IdemPCharU(), if UTF-8 decoding is not mandatory
// - if p is nil, will return FALSE
// - if up is nil, will return TRUE
function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// returns true if the beginning of p^ is the same as up^, ignoring white spaces
// - ignore case - up^ must be already Upper
// - any white space in the input p^ buffer is just ignored
// - chars are compared as 7 bit Ansi only (no accentuated characters): but when
// you only need to search for field names e.g. IdemPChar() is prefered, because
// it'll be faster than IdemPCharU(), if UTF-8 decoding is not mandatory
// - if p is nil, will return FALSE
// - if up is nil, will return TRUE
function IdemPCharWithoutWhiteSpace(p: PUTF8Char; up: PAnsiChar): boolean;

/// returns the index of a matching beginning of p^ in upArray[]
// - returns -1 if no item matched
// - ignore case - upArray^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
// - warning: this function expects upArray[] items to have AT LEAST TWO
// CHARS (it will use a fast comparison of initial 2 bytes)
function IdemPCharArray(p: PUTF8Char; const upArray: array of PAnsiChar): integer; overload;

/// returns the index of a matching beginning of p^ in upArray two characters
// - returns -1 if no item matched
// - ignore case - upArray^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
function IdemPCharArray(p: PUTF8Char; const upArrayBy2Chars: RawUTF8): integer; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns true if the beginning of p^ is the same as up^
// - ignore case - up^ must be already Upper
// - this version will decode the UTF-8 content before using NormToUpper[], so
// it will be slower than the IdemPChar() function above, but will handle
// WinAnsi accentuated characters (e.g. 'e' acute will be matched as 'E')
function IdemPCharU(p, up: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns true if the beginning of p^ is same as up^
// - ignore case - up^ must be already Upper
// - this version expects p^ to point to an Unicode char array
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;

/// check matching ending of p^ in upText
// - returns true if the item matched
// - ignore case - upText^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
function EndWith(const text, upText: RawUTF8): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the index of a matching ending of p^ in upArray[]
// - returns -1 if no item matched
// - ignore case - upArray^ must be already Upper
// - chars are compared as 7 bit Ansi only (no accentuated characters)
function EndWithArray(const text: RawUTF8; const upArray: array of RawUTF8): integer;

/// returns true if the file name extension contained in p^ is the same same as extup^
// - ignore case - extup^ must be already Upper
// - chars are compared as WinAnsi (codepage 1252), not as UTF-8
// - could be used e.g. like IdemFileExt(aFileName,'.JP');
function IdemFileExt(p: PUTF8Char; extup: PAnsiChar; sepChar: AnsiChar='.'): Boolean;

/// internal function, used to retrieve a UCS4 char (>127) from UTF-8
// - not to be called directly, but from inlined higher-level functions
// - here U^ shall be always >= #80
// - typical use is as such:
// !  ch := ord(P^);
// !  if ch and $80=0 then
// !    inc(P) else
// !    ch := GetHighUTF8UCS4(P);
function GetHighUTF8UCS4(var U: PUTF8Char): PtrUInt;

/// retrieve the next UCS4 value stored in U, then update the U pointer
// - this function will decode the UTF-8 content before using NormToUpper[]
// - will return '?' if the UCS4 value is higher than #255: so use this function
// only if you need to deal with ASCII characters (e.g. it's used for Soundex
// and for ContainsUTF8 function)
function GetNextUTF8Upper(var U: PUTF8Char): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// points to the beginning of the next word stored in U
// - returns nil if reached the end of U (i.e. #0 char)
// - here a "word" is a Win-Ansi word, i.e. '0'..'9', 'A'..'Z'
function FindNextUTF8WordBegin(U: PUTF8Char): PUTF8Char;

/// return true if up^ is contained inside the UTF-8 buffer p^
// - search up^ at the beginning of every UTF-8 word (aka in Soundex)
// - here a "word" is a Win-Ansi word, i.e. '0'..'9', 'A'..'Z'
// - up^ must be already Upper
function ContainsUTF8(p, up: PUTF8Char): boolean;

/// returns TRUE if the supplied uppercased text is contained in the text buffer
function GetLineContains(p,pEnd, up: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// copy source into a 256 chars dest^ buffer with 7 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be defined e.g. as
// array[byte] of AnsiChar on the caller stack)
function UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PAnsiChar; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// copy source^ into a 256 chars dest^ buffer with 7 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be defined e.g. as
// array[byte] of AnsiChar on the caller stack)
// - won't use SSE4.2 instructions on supported CPUs by default, which may read
// some bytes beyond the s string, so should be avoided e.g. over memory mapped
// files - call explicitely UpperCopy255BufSSE42() if you are confident on your input
var UpperCopy255Buf: function(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;

/// copy source^ into a 256 chars dest^ buffer with 7 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - this version is written in optimized pascal
// - you should not have to call this function, but rely on UpperCopy255Buf()
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be defined e.g. as
// array[byte] of AnsiChar on the caller stack)
function UpperCopy255BufPas(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;

{$ifndef PUREPASCAL}
{$ifndef DELPHI5OROLDER}
/// SSE 4.2 version of UpperCopy255Buf()
// - copy source^ into a 256 chars dest^ buffer with 7 bits upper case conversion
// - please note that this optimized version may read up to 15 bytes
// beyond the string; this is rarely a problem but it may generate protection
// violations, which could trigger fatal SIGABRT or SIGSEGV on Posix system
// - could be used instead of UpperCopy255Buf() when you are confident about your
// dest/source input buffers, checking if cfSSE42 in CpuFeatures
function UpperCopy255BufSSE42(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
{$endif DELPHI5OROLDER}
{$endif PUREPASCAL}

/// copy source into dest^ with WinAnsi 8 bits upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopyWin255(dest: PWinAnsiChar; const source: RawUTF8): PWinAnsiChar;

/// copy WideChar source into dest^ with upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopy255W(dest: PAnsiChar; const source: SynUnicode): PAnsiChar; overload;

/// copy WideChar source into dest^ with upper case conversion
// - used internally for short keys match or case-insensitive hash
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopy255W(dest: PAnsiChar; source: PWideChar; L: integer): PAnsiChar; overload;

/// copy source into dest^ with 7 bits upper case conversion
// - returns final dest pointer
// - will copy up to the source buffer end: so Dest^ should be big enough -
// which will the case e.g. if Dest := pointer(source)
function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;

/// copy source into dest^ with 7 bits upper case conversion
// - returns final dest pointer
// - this special version expect source to be a shortstring
function UpperCopyShort(dest: PAnsiChar; const source: shortstring): PAnsiChar;

{$ifdef USENORMTOUPPER}

/// fast UTF-8 comparaison using the NormToUpper[] array for all 8 bits values
// - this version expects u1 and u2 to be zero-terminated
// - this version will decode each UTF-8 glyph before using NormToUpper[]
// - current implementation handles UTF-16 surrogates
function UTF8IComp(u1, u2: PUTF8Char): PtrInt;

/// copy WideChar source into dest^ with upper case conversion, using the
// NormToUpper[] array for all 8 bits values, encoding the result as UTF-8
// - returns final dest pointer
// - current implementation handles UTF-16 surrogates
function UTF8UpperCopy(Dest, Source: PUTF8Char; SourceChars: Cardinal): PUTF8Char;

/// copy WideChar source into dest^ with upper case conversion, using the
// NormToUpper[] array for all 8 bits values, encoding the result as UTF-8
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar), with UTF-8 encoding
function UTF8UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// fast UTF-8 comparaison using the NormToUpper[] array for all 8 bits values
// - this version expects u1 and u2 not to be necessary zero-terminated, but
// uses L1 and L2 as length for u1 and u2 respectively
// - use this function for SQLite3 collation (TSQLCollateFunc)
// - this version will decode the UTF-8 content before using NormToUpper[]
// - current implementation handles UTF-16 surrogates
function UTF8ILComp(u1, u2: PUTF8Char; L1,L2: cardinal): PtrInt;

/// fast case-insensitive Unicode comparaison
// - use the NormToUpperAnsi7Byte[] array, i.e. compare 'a'..'z' as 'A'..'Z'
// - this version expects u1 and u2 to be zero-terminated
function AnsiICompW(u1, u2: PWideChar): PtrInt;

/// SameText() overloaded function with proper UTF-8 decoding
// - fast version using NormToUpper[] array for all Win-Ansi characters
// - this version will decode each UTF-8 glyph before using NormToUpper[]
// - current implementation handles UTF-16 surrogates as UTF8IComp()
function SameTextU(const S1, S2: RawUTF8): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion of the supplied text into 8 bit uppercase
// - this will not only convert 'a'..'z' into 'A'..'Z', but also accentuated
// latin characters ('e' acute into 'E' e.g.), using NormToUpper[] array
// - it will therefore decode the supplied UTF-8 content to handle more than
// 7 bit of ascii characters (so this function is dedicated to WinAnsi code page
// 1252 characters set)
function UpperCaseU(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into 8 bit lowercase
// - this will not only convert 'A'..'Z' into 'a'..'z', but also accentuated
// latin characters ('E' acute into 'e' e.g.), using NormToLower[] array
// - it will therefore decode the supplied UTF-8 content to handle more than
// 7 bit of ascii characters
function LowerCaseU(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into 8 bit case sensitivity
// - convert the text in-place, returns the resulting length
// - it will decode the supplied UTF-8 content to handle more than 7 bit
// of ascii characters during the conversion (leaving not WinAnsi characters
// untouched)
// - will not set the last char to #0 (caller must do that if necessary)
function ConvertCaseUTF8(P: PUTF8Char; const Table: TNormTableByte): PtrInt;

{$endif USENORMTOUPPER}

/// check if the supplied text has some case-insentitive 'a'..'z','A'..'Z' chars
// - will therefore be correct with true UTF-8 content, but only for 7 bit
function IsCaseSensitive(const S: RawUTF8): boolean; overload;

/// check if the supplied text has some case-insentitive 'a'..'z','A'..'Z' chars
// - will therefore be correct with true UTF-8 content, but only for 7 bit
function IsCaseSensitive(P: PUTF8Char; PLen: integer): boolean; overload;

/// fast conversion of the supplied text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
function UpperCase(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure UpperCaseCopy(Text: PUTF8Char; Len: integer; var result: RawUTF8); overload;

/// fast conversion of the supplied text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure UpperCaseCopy(const Source: RawUTF8; var Dest: RawUTF8); overload;

/// fast in-place conversion of the supplied variable text into uppercase
// - this will only convert 'a'..'z' into 'A'..'Z' (no NormToUpper use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure UpperCaseSelf(var S: RawUTF8);

/// fast conversion of the supplied text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore be correct with true UTF-8 content
function LowerCase(const S: RawUTF8): RawUTF8;

/// fast conversion of the supplied text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore be correct with true UTF-8 content
procedure LowerCaseCopy(Text: PUTF8Char; Len: integer; var result: RawUTF8);

/// fast in-place conversion of the supplied variable text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore be correct with true UTF-8 content, but only for 7 bit
procedure LowerCaseSelf(var S: RawUTF8);

/// accurate conversion of the supplied UTF-8 content into the corresponding
// upper-case Unicode characters
// - this version will use the Operating System API, and will therefore be
// much slower than UpperCase/UpperCaseU versions, but will handle all
// kind of unicode characters
function UpperCaseUnicode(const S: RawUTF8): RawUTF8;

/// accurate conversion of the supplied UTF-8 content into the corresponding
// lower-case Unicode characters
// - this version will use the Operating System API, and will therefore be
// much slower than LowerCase/LowerCaseU versions, but will handle all
// kind of unicode characters
function LowerCaseUnicode(const S: RawUTF8): RawUTF8;

///  trims leading whitespace characters from the string by removing
// new line, space, and tab characters
function TrimLeft(const S: RawUTF8): RawUTF8;

/// trims trailing whitespace characters from the string by removing trailing
// newline, space, and tab characters
function TrimRight(const S: RawUTF8): RawUTF8;

/// fast WinAnsi comparaison using the NormToUpper[] array for all 8 bits values
function AnsiIComp(Str1, Str2: PWinAnsiChar): PtrInt;
  {$ifndef USENORMTOUPPER} {$ifdef PUREPASCAL}
  {$ifdef HASINLINE}inline;{$endif} {$endif} {$endif}

/// extract a line from source array of chars
// - next will contain the beginning of next line, or nil if source if ended
function GetNextLine(source: PUTF8Char; out next: PUTF8Char): RawUTF8;

{$ifdef UNICODE}
/// extract a line from source array of chars
// - next will contain the beginning of next line, or nil if source if ended
// - this special version expect UnicodeString pointers, and return an UnicodeString
function GetNextLineW(source: PWideChar; out next: PWideChar): string;

/// find the Value of UpperName in P, till end of current section
// - expect UpperName as 'NAME='
// - this special version expect UnicodeString pointer, and return a VCL string
function FindIniNameValueW(P: PWideChar; UpperName: PUTF8Char): string;

/// find a Name= Value in a [Section] of a INI Unicode Content
// - this function scans the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', find the Name= value before any [Section]
function FindIniEntryW(const Content: string; const Section, Name: RawUTF8): string;
{$endif UNICODE}

{$ifdef PUREPASCAL}
{$ifdef HASINLINE}
function PosExPas(pSub, p: PUTF8Char; Offset: PtrUInt): PtrInt;
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt=1): PtrInt; inline;
{$else}
var PosEx: function(const SubStr, S: RawUTF8; Offset: PtrUInt=1): PtrInt;
{$endif}
{$else}

/// faster RawUTF8 Equivalent of standard StrUtils.PosEx
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt=1): integer;

{$endif PUREPASCAL}

/// optimized version of PosEx() with search text as one AnsiChar
function PosExChar(Chr: AnsiChar; const Str: RawUTF8): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// split a RawUTF8 string into two strings, according to SepStr separator
// - if SepStr is not found, LeftStr=Str and RightStr=''
// - if ToUpperCase is TRUE, then LeftStr and RightStr will be made uppercase
procedure Split(const Str, SepStr: RawUTF8; var LeftStr, RightStr: RawUTF8; ToUpperCase: boolean=false); overload;

/// split a RawUTF8 string into two strings, according to SepStr separator
// - this overloaded function returns the right string as function result
// - if SepStr is not found, LeftStr=Str and result=''
// - if ToUpperCase is TRUE, then LeftStr and result will be made uppercase
function Split(const Str, SepStr: RawUTF8; var LeftStr: RawUTF8; ToUpperCase: boolean=false): RawUTF8; overload;

/// returns the left part of a RawUTF8 string, according to SepStr separator
// - if SepStr is found, returns Str first chars until (and excluding) SepStr
// - if SepStr is not found, returns Str
function Split(const Str, SepStr: RawUTF8; StartPos: integer=1): RawUTF8; overload;

/// split a RawUTF8 string into several strings, according to SepStr separator
// - this overloaded function will fill a DestPtr[] array of PRawUTF8
// - if any DestPtr[]=nil, the item will be skipped
procedure Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
  const DestPtr: array of PRawUTF8); overload;

/// returns the last occurence of the given SepChar separated context
// - e.g. SplitRight('01/2/34','/')='34'
// - if SepChar doesn't appear, will return Str, e.g. SplitRight('123','/')='123'
// - if LeftStr is supplied, the RawUTF8 it points to will be filled with
// the left part just before SepChar ('' if SepChar doesn't appear)
function SplitRight(const Str: RawUTF8; SepChar: AnsiChar; LeftStr: PRawUTF8=nil): RawUTF8;

/// returns the last occurence of the given SepChar separated context
// - e.g. SplitRight('path/one\two/file.ext','/\')='file.ext', i.e.
// SepChars='/\' will be like ExtractFileName() over RawUTF8 string
// - if SepChar doesn't appear, will return Str, e.g. SplitRight('123','/')='123'
function SplitRights(const Str, SepChar: RawUTF8): RawUTF8;

/// fast version of StringReplace(S, OldPattern, NewPattern,[rfReplaceAll]);
function StringReplaceAll(const S, OldPattern, NewPattern: RawUTF8): RawUTF8;

/// fast replace of a specified char by a given string
function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;

/// fast replace of all #9 chars by a given string
function StringReplaceTabs(const Source,TabText: RawUTF8): RawUTF8;

/// format a text content with SQL-like quotes
// - UTF-8 version of the function available in SysUtils
// - this function implements what is specified in the official SQLite3
// documentation: "A string constant is formed by enclosing the string in single
// quotes ('). A single quote within the string can be encoded by putting two
// single quotes in a row - as in Pascal."
function QuotedStr(const S: RawUTF8; Quote: AnsiChar=''''): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// format a buffered text content with SQL-like quotes
// - this function implements what is specified in the official SQLite3
// documentation: "A string constant is formed by enclosing the string in single
// quotes ('). A single quote within the string can be encoded by putting two
// single quotes in a row - as in Pascal."
function QuotedStr(Text: PUTF8Char; Quote: AnsiChar): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// format a buffered text content with SQL-like quotes
// - this function implements what is specified in the official SQLite3
// documentation: "A string constant is formed by enclosing the string in single
// quotes ('). A single quote within the string can be encoded by putting two
// single quotes in a row - as in Pascal."
procedure QuotedStr(Text: PUTF8Char; Quote: AnsiChar; var result: RawUTF8); overload;

/// convert a buffered text content into a JSON string
// - with proper escaping of the content, and surounding " characters
procedure QuotedStrJSON(const aText: RawUTF8; var result: RawUTF8;
  const aPrefix: RawUTF8=''; const aSuffix: RawUTF8='');

/// unquote a SQL-compatible string
// - the first character in P^ must be either ', either " then double quotes
// are transformed into single quotes
// - 'text '' end'   -> text ' end
// - "text "" end"   -> text " end
// - returns nil if P doesn't contain a valid SQL string
// - returns a pointer just after the quoted text otherwise
function UnQuoteSQLStringVar(P: PUTF8Char; out Value: RawUTF8): PUTF8Char;

/// unquote a SQL-compatible string
function UnQuoteSQLString(const Value: RawUTF8): RawUTF8;

/// unquote a SQL-compatible symbol name
// - e.g. '[symbol]' -> 'symbol' or '"symbol"' -> 'symbol'
function UnQuotedSQLSymbolName(const ExternalDBSymbol: RawUTF8): RawUTF8;

/// get the next character after a quoted buffer
// - the first character in P^ must be either ', either "
// - it will return the latest quote position, ignoring double quotes within
function GotoEndOfQuotedString(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character after a quoted buffer
// - the first character in P^ must be "
// - it will return the latest " position, ignoring \" within
function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character not in [#1..' ']
function GotoNextNotSpace(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// get the next character in [#1..' ']
function GotoNextSpace(P: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// check if the next character not in [#1..' '] matchs a given value
// - first ignore any non space character
// - then returns TRUE if P^=ch, setting P to the character after ch
// - or returns FALSE if P^<>ch, leaving P at the level of the unexpected char
function NextNotSpaceCharIs(var P: PUTF8Char; ch: AnsiChar): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// go to the beginning of the SQL statement, ignoring all blanks and comments
// - used to check the SQL statement command (e.g. is it a SELECT?)
function SQLBegin(P: PUTF8Char): PUTF8Char;

/// add a condition to a SQL WHERE clause, with an ' and ' if where is not void
procedure SQLAddWhereAnd(var where: RawUTF8; const condition: RawUTF8);

/// return true if the parameter is void or begin with a 'SELECT' SQL statement
// - used to avoid code injection and to check if the cache must be flushed
// - VACUUM, PRAGMA, or EXPLAIN statements also return true, since they won't
// change the data content
// - WITH recursive statement expect no INSERT/UPDATE/DELETE pattern in the SQL
// - if P^ is a SELECT and SelectClause is set to a variable, it would
// contain the field names, from SELECT ...field names... FROM
function isSelect(P: PUTF8Char; SelectClause: PRawUTF8=nil): boolean;

/// return true if IdemPChar(source,searchUp), and go to the next line of source
function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;

/// return true if IdemPChar(source,searchUp), and retrieve the value item
// - typical use may be:
// ! if IdemPCharAndGetNextItem(P,
// !   'CONTENT-DISPOSITION: FORM-DATA; NAME="',Name,'"') then ...
function IdemPCharAndGetNextItem(var source: PUTF8Char; const searchUp: RawUTF8;
  var Item: RawUTF8; Sep: AnsiChar=#13): boolean;

/// fast go to next text line, ended by #13 or #13#10
// - returns the beginning of next line, or nil if source^=#0 was reached
function GotoNextLine(source: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the line length from a size-delimited source array of chars
// - will use fast assembly on x86-64 CPU, and expects TextEnd to be not nil
// - is likely to read some bytes after the TextEnd buffer, so GetLineSize()
// may be preferred, e.g. on memory mapped files
function BufferLineLength(Text, TextEnd: PUTF8Char): PtrInt;
  {$ifndef CPUX64}{$ifdef FPC}inline;{$endif}{$endif}

/// compute the line length from source array of chars
// - if PEnd = nil, end counting at either #0, #13 or #10
// - otherwise, end counting at either #13 or #10
function GetLineSize(P,PEnd: PUTF8Char): PtrUInt;

/// returns true if the line length from source array of chars is not less than
// the specified count
function GetLineSizeSmallerThan(P,PEnd: PUTF8Char; aMinimalCount: integer): boolean;

/// return next CSV string from P
// - P=nil after call when end of text is reached
function GetNextItem(var P: PUTF8Char; Sep: AnsiChar= ','): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return next CSV string from P
// - P=nil after call when end of text is reached
procedure GetNextItem(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8); overload;

/// return next CSV string (unquoted if needed) from P
// - P=nil after call when end of text is reached
procedure GetNextItem(var P: PUTF8Char; Sep, Quote: AnsiChar; var result: RawUTF8); overload;

/// return trimmed next CSV string from P
// - P=nil after call when end of text is reached
procedure GetNextItemTrimed(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8);

/// return next CRLF separated value string from P, ending #10 or #13#10 trimmed
// - any kind of line feed (CRLF or LF) will be handled, on all operating systems
// - as used e.g. by TSynNameValue.InitFromCSV and TDocVariantData.InitCSV
// - P=nil after call when end of text is reached
procedure GetNextItemTrimedCRLF(var P: PUTF8Char; var result: RawUTF8);

/// return next CSV string from P, nil if no more
// - this function returns the generic string type of the compiler, and
// therefore can be used with ready to be displayed text (e.g. for the VCL)
function GetNextItemString(var P: PChar; Sep: Char= ','): string;

/// return next string delimited with #13#10 from P, nil if no more
// - this function returns a RawUnicode string type
function GetNextStringLineToRawUnicode(var P: PChar): RawUnicode;

/// append some text lines with the supplied Values[]
// - if any Values[] item is '', no line is added
// - otherwise, appends 'Caption: Value', with Caption taken from CSV
procedure AppendCSVValues(const CSV: string; const Values: array of string;
  var Result: string; const AppendBefore: string=#13#10);

/// return a CSV list of the iterated same value
// - e.g. CSVOfValue('?',3)='?,?,?'
function CSVOfValue(const Value: RawUTF8; Count: cardinal; const Sep: RawUTF8=','): RawUTF8;

 /// retrieve the next CSV separated bit index
// - each bit was stored as BitIndex+1, i.e. 0 to mark end of CSV chunk
// - several bits set to one can be regrouped via 'first-last,' syntax
procedure SetBitCSV(var Bits; BitsCount: integer; var P: PUTF8Char);

/// convert a set of bit into a CSV content
// - each bit is stored as BitIndex+1, and separated by a ','
// - several bits set to one can be regrouped via 'first-last,' syntax
// - ',0' is always appended at the end of the CSV chunk to mark its end
function GetBitCSV(const Bits; BitsCount: integer): RawUTF8;

/// return next CSV string from P, nil if no more
// - output text would be trimmed from any left or right space
procedure GetNextItemShortString(var P: PUTF8Char; out Dest: ShortString; Sep: AnsiChar= ',');

/// decode next CSV hexadecimal string from P, nil if no more or not matching BinBytes
// - Bin is filled with 0 if the supplied CSV content is invalid
// - if Sep is #0, it will read the hexadecimal chars until a whitespace is reached
function GetNextItemHexDisplayToBin(var P: PUTF8Char; Bin: PByte; BinBytes: integer;
  Sep: AnsiChar= ','): boolean;


type
  /// some stack-allocated zero-terminated character buffer
  // - as used by GetNextTChar64
  TChar64 = array[0..63] of AnsiChar;

/// return next CSV string from P as a #0-ended buffer, false if no more
// - if Sep is #0, will copy all characters until next whitespace char
// - returns the number of bytes stored into Buf[]
function GetNextTChar64(var P: PUTF8Char; Sep: AnsiChar; out Buf: TChar64): PtrInt;

/// return next CSV string as unsigned integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemCardinal(var P: PUTF8Char; Sep: AnsiChar=','): PtrUInt;

/// return next CSV string as signed integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemInteger(var P: PUTF8Char; Sep: AnsiChar=','): PtrInt;

/// return next CSV string as 64-bit signed integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemInt64(var P: PUTF8Char; Sep: AnsiChar=','): Int64;

/// return next CSV string as 64-bit unsigned integer from P, 0 if no more
// - if Sep is #0, it won't be searched for
function GetNextItemQWord(var P: PUTF8Char; Sep: AnsiChar=','): QWord;

/// return next CSV hexadecimal string as 64-bit unsigned integer from P
// - returns 0 if no valid hexadecimal text is available in P
// - if Sep is #0, it won't be searched for
// - will first fill the 64-bit value with 0, then decode each two hexadecimal
// characters available in P
// - could be used to decode TTextWriter.AddBinToHexDisplayMinChars() output
function GetNextItemHexa(var P: PUTF8Char; Sep: AnsiChar=','): QWord;

/// return next CSV string as unsigned integer from P, 0 if no more
// - P^ will point to the first non digit character (the item separator, e.g.
// ',' for CSV)
function GetNextItemCardinalStrict(var P: PUTF8Char): PtrUInt;

/// return next CSV string as unsigned integer from P, 0 if no more
// - this version expects P^ to point to an Unicode char array
function GetNextItemCardinalW(var P: PWideChar; Sep: WideChar=','): PtrUInt;

/// return next CSV string as double from P, 0.0 if no more
// - if Sep is #0, will return all characters until next whitespace char
function GetNextItemDouble(var P: PUTF8Char; Sep: AnsiChar=','): double;

/// return next CSV string as currency from P, 0.0 if no more
// - if Sep is #0, will return all characters until next whitespace char
function GetNextItemCurrency(var P: PUTF8Char; Sep: AnsiChar=','): currency; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return next CSV string as currency from P, 0.0 if no more
// - if Sep is #0, will return all characters until next whitespace char
procedure GetNextItemCurrency(var P: PUTF8Char; out result: currency; Sep: AnsiChar=','); overload;

/// return n-th indexed CSV string in P, starting at Index=0 for first one
function GetCSVItem(P: PUTF8Char; Index: PtrUInt; Sep: AnsiChar=','): RawUTF8; overload;

/// return n-th indexed CSV string (unquoted if needed) in P, starting at Index=0 for first one
function GetUnQuoteCSVItem(P: PUTF8Char; Index: PtrUInt; Sep: AnsiChar=','; Quote: AnsiChar=''''): RawUTF8; overload;

/// return n-th indexed CSV string in P, starting at Index=0 for first one
// - this function return the generic string type of the compiler, and
// therefore can be used with ready to be displayed text (i.e. the VCL)
function GetCSVItemString(P: PChar; Index: PtrUInt; Sep: Char=','): string;

/// return last CSV string in the supplied UTF-8 content
function GetLastCSVItem(const CSV: RawUTF8; Sep: AnsiChar=','): RawUTF8;

/// return the index of a Value in a CSV string
// - start at Index=0 for first one
// - return -1 if specified Value was not found in CSV items
function FindCSVIndex(CSV: PUTF8Char; const Value: RawUTF8; Sep: AnsiChar = ',';
  CaseSensitive: boolean=true; TrimValue: boolean=false): integer;

/// add the strings in the specified CSV text into a dynamic array of UTF-8 strings
procedure CSVToRawUTF8DynArray(CSV: PUTF8Char; var Result: TRawUTF8DynArray;
  Sep: AnsiChar=','; TrimItems: boolean=false; AddVoidItems: boolean=false); overload;

/// add the strings in the specified CSV text into a dynamic array of UTF-8 strings
procedure CSVToRawUTF8DynArray(const CSV,Sep,SepEnd: RawUTF8; var Result: TRawUTF8DynArray); overload;

/// return the corresponding CSV text from a dynamic array of UTF-8 strings
function RawUTF8ArrayToCSV(const Values: array of RawUTF8; const Sep: RawUTF8= ','): RawUTF8;

/// return the corresponding CSV quoted text from a dynamic array of UTF-8 strings
// - apply QuoteStr() function to each Values[] item
function RawUTF8ArrayToQuotedCSV(const Values: array of RawUTF8; const Sep: RawUTF8=',';
  Quote: AnsiChar=''''): RawUTF8;

/// append some prefix to all CSV values
// ! AddPrefixToCSV('One,Two,Three','Pre')='PreOne,PreTwo,PreThree'
function AddPrefixToCSV(CSV: PUTF8Char; const Prefix: RawUTF8;
  Sep: AnsiChar = ','): RawUTF8;

/// append a Value to a CSV string
procedure AddToCSV(const Value: RawUTF8; var CSV: RawUTF8; const Sep: RawUTF8 = ',');
  {$ifdef HASINLINE}inline;{$endif}

/// change a Value within a CSV string
function RenameInCSV(const OldValue, NewValue: RawUTF8; var CSV: RawUTF8;
  const Sep: RawUTF8 = ','): boolean;

/// quick helper to initialize a dynamic array of RawUTF8 from some constants
// - can be used e.g. as:
// ! MyArray := TRawUTF8DynArrayFrom(['a','b','c']);
function TRawUTF8DynArrayFrom(const Values: array of RawUTF8): TRawUTF8DynArray;

/// append one or several values to a local "array of const" variable
procedure AddArrayOfConst(var Dest: TTVarRecDynArray; const Values: array of const);

/// return the index of Value in Values[], -1 if not found
function FindRawUTF8(const Values: TRawUTF8DynArray; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer; overload;

/// return the index of Value in Values[], -1 if not found
// - can optionally call IdemPropNameU() for property matching
function FindRawUTF8(const Values: TRawUTF8DynArray; ValuesCount: integer;
  const Value: RawUTF8; SearchPropName: boolean): integer; overload;

/// return the index of Value in Values[], -1 if not found
function FindRawUTF8(const Values: array of RawUTF8; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer; overload;

/// return the index of Value in Values[], -1 if not found
// - here name search would use fast IdemPropNameU() function
function FindPropName(const Names: array of RawUTF8; const Name: RawUTF8): integer;

/// true if Value was added successfully in Values[]
function AddRawUTF8(var Values: TRawUTF8DynArray; const Value: RawUTF8;
  NoDuplicates: boolean=false; CaseSensitive: boolean=true): boolean; overload;

/// add the Value to Values[], with an external count variable, for performance
procedure AddRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8); overload;

type
  /// simple stack-allocated type for handling a type names list
  {$ifdef FPC_OR_UNICODE}TPropNameList = record{$else}TPropNameList = object{$endif}
  public
    Values: TRawUTF8DynArray;
    Count: Integer;
    /// initialize the list
    // - set Count := 0
    procedure Init;
    /// search for a Value within Values[0..Count-1] using IdemPropNameU()
    function FindPropName(const Value: RawUTF8): Integer;
    /// if Value is in Values[0..Count-1] using IdemPropNameU() returns FALSE
    // - otherwise, returns TRUE and add Value to Values[]
    function AddPropName(const Value: RawUTF8): Boolean;
  end;

/// true if both TRawUTF8DynArray are the same
// - comparison is case-sensitive
function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray): boolean; overload;

/// true if both TRawUTF8DynArray are the same for a given number of items
// - A and B are expected to have at least Count items
// - comparison is case-sensitive
function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray; Count: integer): boolean; overload;

/// convert the string dynamic array into a dynamic array of UTF-8 strings
procedure StringDynArrayToRawUTF8DynArray(const Source: TStringDynArray;
  var Result: TRawUTF8DynArray);

/// convert the string list into a dynamic array of UTF-8 strings
procedure StringListToRawUTF8DynArray(Source: TStringList; var Result: TRawUTF8DynArray);

/// find a Name= Value in a [Section] of a INI RawUTF8 Content
// - this function scans the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', find the Name= value before any [Section]
function FindIniEntry(const Content, Section,Name: RawUTF8): RawUTF8;

/// find a Name= Value in a [Section] of a INI WinAnsi Content
// - same as FindIniEntry(), but the value is converted from WinAnsi into UTF-8
function FindWinAnsiIniEntry(const Content, Section,Name: RawUTF8): RawUTF8;

/// find a Name= numeric Value in a [Section] of a INI RawUTF8 Content and
// return it as an integer, or 0 if not found
// - this function scans the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', find the Name= value before any [Section]
function FindIniEntryInteger(const Content, Section,Name: RawUTF8): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// find a Name= Value in a [Section] of a .INI file
// - if Section equals '', find the Name= value before any [Section]
// - use internaly fast FindIniEntry() function above
function FindIniEntryFile(const FileName: TFileName; const Section,Name: RawUTF8): RawUTF8;

/// update a Name= Value in a [Section] of a INI RawUTF8 Content
// - this function scans and update the Content memory buffer, and is
// therefore very fast (no temporary TMemIniFile is created)
// - if Section equals '', update the Name= value before any [Section]
procedure UpdateIniEntry(var Content: RawUTF8; const Section,Name,Value: RawUTF8);

/// update a Name= Value in a [Section] of a .INI file
// - if Section equals '', update the Name= value before any [Section]
// - use internaly fast UpdateIniEntry() function above
procedure UpdateIniEntryFile(const FileName: TFileName; const Section,Name,Value: RawUTF8);

/// find the position of the [SEARCH] section in source
// - return true if [SEARCH] was found, and store pointer to the line after it in source
function FindSectionFirstLine(var source: PUTF8Char; search: PAnsiChar): boolean;

/// find the position of the [SEARCH] section in source
// - return true if [SEARCH] was found, and store pointer to the line after it in source
// - this version expects source^ to point to an Unicode char array
function FindSectionFirstLineW(var source: PWideChar; search: PUTF8Char): boolean;

/// retrieve the whole content of a section as a string
// - SectionFirstLine may have been obtained by FindSectionFirstLine() function above
function GetSectionContent(SectionFirstLine: PUTF8Char): RawUTF8; overload;

/// retrieve the whole content of a section as a string
// - use SectionFirstLine() then previous GetSectionContent()
function GetSectionContent(const Content, SectionName: RawUTF8): RawUTF8; overload;

/// delete a whole [Section]
// - if EraseSectionHeader is TRUE (default), then the [Section] line is also
// deleted together with its content lines
// - return TRUE if something was changed in Content
// - return FALSE if [Section] doesn't exist or is already void
function DeleteSection(var Content: RawUTF8; const SectionName: RawUTF8;
  EraseSectionHeader: boolean=true): boolean; overload;

/// delete a whole [Section]
// - if EraseSectionHeader is TRUE (default), then the [Section] line is also
// deleted together with its content lines
// - return TRUE if something was changed in Content
// - return FALSE if [Section] doesn't exist or is already void
// - SectionFirstLine may have been obtained by FindSectionFirstLine() function above
function DeleteSection(SectionFirstLine: PUTF8Char; var Content: RawUTF8;
  EraseSectionHeader: boolean=true): boolean; overload;

/// replace a whole [Section] content by a new content
// - create a new [Section] if none was existing
procedure ReplaceSection(var Content: RawUTF8; const SectionName,
  NewSectionContent: RawUTF8); overload;

/// replace a whole [Section] content by a new content
// - create a new [Section] if none was existing
// - SectionFirstLine may have been obtained by FindSectionFirstLine() function above
procedure ReplaceSection(SectionFirstLine: PUTF8Char;
  var Content: RawUTF8; const NewSectionContent: RawUTF8); overload;

/// return TRUE if Value of UpperName does exist in P, till end of current section
// - expect UpperName as 'NAME='
function ExistsIniName(P: PUTF8Char; UpperName: PAnsiChar): boolean;

/// find the Value of UpperName in P, till end of current section
// - expect UpperName as 'NAME='
function FindIniNameValue(P: PUTF8Char; UpperName: PAnsiChar): RawUTF8;

/// return TRUE if one of the Value of UpperName exists in P, till end of
// current section
// - expect UpperName e.g. as 'CONTENT-TYPE: '
// - expect UpperValues to be any upper value with left side matching, e.g. as
// used by IsHTMLContentTypeTextual() function:
// ! result := ExistsIniNameValue(htmlHeaders,HEADER_CONTENT_TYPE_UPPER,
// !  ['TEXT/','APPLICATION/JSON','APPLICATION/XML']);
// - warning: this function calls IdemPCharArray(), so expects UpperValues[]
/// items to have AT LEAST TWO CHARS (it will use fast initial 2 bytes compare)
function ExistsIniNameValue(P: PUTF8Char; const UpperName: RawUTF8;
  const UpperValues: array of PAnsiChar): boolean;

/// find the integer Value of UpperName in P, till end of current section
// - expect UpperName as 'NAME='
// - return 0 if no NAME= entry was found
function FindIniNameValueInteger(P: PUTF8Char; UpperName: PAnsiChar): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// replace a value from a given set of name=value lines
// - expect UpperName as 'UPPERNAME=', otherwise returns false
// - if no UPPERNAME= entry was found, then Name+NewValue is added to Content
// - a typical use may be:
// ! UpdateIniNameValue(headers,HEADER_CONTENT_TYPE,HEADER_CONTENT_TYPE_UPPER,contenttype);
function UpdateIniNameValue(var Content: RawUTF8; const Name, UpperName, NewValue: RawUTF8): boolean;

/// read a File content into a String
// - content can be binary or text
// - returns '' if file was not found or any read error occured
// - wil use GetFileSize() API by default, unless HasNoSize is defined,
// and read will be done using a buffer (required e.g. for char files under Linux)
// - uses RawByteString for byte storage, whatever the codepage is
function StringFromFile(const FileName: TFileName; HasNoSize: boolean=false): RawByteString;

/// create a File from a string content
// - uses RawByteString for byte storage, whatever the codepage is
function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean=false; FileDate: TDateTime=0): boolean;

/// get text File contents (even Unicode or UTF8) and convert it into a
// Charset-compatible AnsiString (for Delphi 7) or an UnicodeString (for Delphi
// 2009 and up) according to any BOM marker at the beginning of the file
// - before Delphi 2009, the current string code page is used (i.e. CurrentAnsiConvert)
function AnyTextFileToString(const FileName: TFileName; ForceUTF8: boolean=false): string;

/// get text file contents (even Unicode or UTF8) and convert it into an
// Unicode string according to any BOM marker at the beginning of the file
// - any file without any BOM marker will be interpreted as plain ASCII: in this
// case, the current string code page is used (i.e. CurrentAnsiConvert class)
function AnyTextFileToSynUnicode(const FileName: TFileName; ForceUTF8: boolean=false): SynUnicode;

/// get text file contents (even Unicode or UTF8) and convert it into an
// UTF-8 string according to any BOM marker at the beginning of the file
// - if AssumeUTF8IfNoBOM is FALSE, the current string code page is used (i.e.
// CurrentAnsiConvert class) for conversion from ANSI into UTF-8
// - if AssumeUTF8IfNoBOM is TRUE, any file without any BOM marker will be
// interpreted as UTF-8
function AnyTextFileToRawUTF8(const FileName: TFileName; AssumeUTF8IfNoBOM: boolean=false): RawUTF8;

/// read a TStream content into a String
// - it will read binary or text content from the current position until the
// end (using TStream.Size)
// - uses RawByteString for byte storage, whatever the codepage is
function StreamToRawByteString(aStream: TStream): RawByteString;

/// create a TStream from a string content
// - uses RawByteString for byte storage, whatever the codepage is
// - in fact, the returned TStream is a TRawByteString instance, since this
// function is just a wrapper around:
// ! result := TRawByteStringStream.Create(aString);
function RawByteStringToStream(const aString: RawByteString): TStream;
  {$ifdef HASINLINE}inline;{$endif}

/// read an UTF-8 text from a TStream
// - format is Length(Integer):Text, i.e. the one used by WriteStringToStream
// - will return '' if there is no such text in the stream
// - you can set a MaxAllowedSize value, if you know how long the size should be
// - it will read from the current position in S: so if you just write into S,
// it could be a good idea to rewind it before call, e.g.:
// !  WriteStringToStream(Stream,aUTF8Text);
// !  Stream.Seek(0,soBeginning);
// !  str := ReadStringFromStream(Stream);
function ReadStringFromStream(S: TStream; MaxAllowedSize: integer=255): RawUTF8;

/// write an UTF-8 text into a TStream
// - format is Length(Integer):Text, i.e. the one used by ReadStringFromStream
function WriteStringToStream(S: TStream; const Text: RawUTF8): boolean;

/// get a file date and time, from its name
// - returns 0 if file doesn't exist
// - under Windows, will use GetFileAttributesEx fast API
function FileAgeToDateTime(const FileName: TFileName): TDateTime;

/// get a file size, from its name
// - returns 0 if file doesn't exist
// - under Windows, will use GetFileAttributesEx fast API
function FileSize(const FileName: TFileName): Int64; overload;

/// get a file size, from its handle
// - returns 0 if file doesn't exist
function FileSize(F: THandle): Int64; overload;

/// get low-level file information, in a cross-platform way
// - returns true on success
// - here file write/creation time are given as TUnixMSTime values, for better
// cross-platform process - note that FileCreateDateTime may not be supported
// by most Linux file systems, so the oldest timestamp available is returned
// as failover on such systems (probably the latest file metadata writing)
function FileInfoByHandle(aFileHandle: THandle; out FileId, FileSize,
  LastWriteAccess, FileCreateDateTime: Int64): Boolean;

/// get a file date and time, from a FindFirst/FindNext search
// - the returned timestamp is in local time, not UTC
// - this method would use the F.Timestamp field available since Delphi XE2
function SearchRecToDateTime(const F: TSearchRec): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// check if a FindFirst/FindNext found instance is actually a file
function SearchRecValidFile(const F: TSearchRec): boolean;
  {$ifdef HASINLINE}inline;{$endif}

const
  /// operating-system dependent wildchar to match all files in a folder
  FILES_ALL = {$ifdef MSWINDOWS}'*.*'{$else}'*'{$endif};

/// delete the content of a specified directory
// - only one level of file is deleted within the folder: no recursive deletion
// is processed by this function (for safety)
// - if DeleteOnlyFilesNotDirectory is TRUE, it won't remove the folder itself,
// but just the files found in it
function DirectoryDelete(const Directory: TFileName; const Mask: TFileName=FILES_ALL;
  DeleteOnlyFilesNotDirectory: Boolean=false; DeletedCount: PInteger=nil): Boolean;

/// delete the files older than a given age in a specified directory
// - for instance, to delete all files older than one day:
// ! DirectoryDeleteOlderFiles(FolderName, 1);
// - only one level of file is deleted within the folder: no recursive deletion
// is processed by this function, unless Recursive is TRUE
// - if Recursive=true, caller should set TotalSize^=0 to have an accurate value
function DirectoryDeleteOlderFiles(const Directory: TFileName; TimePeriod: TDateTime;
   const Mask: TFileName=FILES_ALL; Recursive: Boolean=false; TotalSize: PInt64=nil): Boolean;

/// creates a directory if not already existing
// - returns the full expanded directory name, including trailing backslash
// - returns '' on error, unless RaiseExceptionOnCreationFailure=true
function EnsureDirectoryExists(const Directory: TFileName;
  RaiseExceptionOnCreationFailure: boolean=false): TFileName;

/// check if the directory is writable for the current user
// - try to write a small file with a random name
function IsDirectoryWritable(const Directory: TFileName): boolean;

/// compute an unique temporary file name
// - following 'exename_01234567.tmp' pattern, in the system temporary folder
function TemporaryFileName: TFileName;

type
  {$A-}
  /// file found result item, as returned by FindFiles()
  {$ifdef FPC_OR_UNICODE}TFindFiles = record{$else}TFindFiles = object{$endif}
  public
    /// the matching file name, including its folder name
    Name: TFileName;
    /// the matching file attributes
    Attr: Integer;
    /// the matching file size
    Size: Int64;
    /// the matching file date/time
    Timestamp: TDateTime;
    /// fill the item properties from a FindFirst/FindNext's TSearchRec
    procedure FromSearchRec(const Directory: TFileName; const F: TSearchRec);
    /// returns some ready-to-be-loggued text
    function ToText: shortstring;
  end;
  {$A+}
  /// result list, as returned by FindFiles()
  TFindFilesDynArray = array of TFindFiles;

  /// a pointer to a TFileName variable
  PFileName = ^TFileName;

/// search for matching file names
// - just a wrapper around FindFirst/FindNext
// - you may specify several masks in Mask, e.g. as '*.jpg;*.jpeg'
function FindFiles(const Directory,Mask: TFileName;
  const IgnoreFileName: TFileName=''; SortByName: boolean=false;
  IncludesDir: boolean=true; SubFolder: Boolean=false): TFindFilesDynArray;

/// convert a result list, as returned by FindFiles(), into an array of Files[].Name
function FindFilesDynArrayToFileNames(const Files: TFindFilesDynArray): TFileNameDynArray;

{$ifdef DELPHI5OROLDER}

/// DirectoryExists returns a boolean value that indicates whether the
//  specified directory exists (and is actually a directory)
function DirectoryExists(const Directory: string): Boolean;

/// case-insensitive comparison of filenames
function SameFileName(const S1, S2: TFileName): Boolean;

/// retrieve the corresponding environment variable value
function GetEnvironmentVariable(const Name: string): string;

/// retrieve the full path name of the given execution module (e.g. library)
function GetModuleName(Module: HMODULE): TFileName;

/// try to encode a time
function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;

/// alias to ExcludeTrailingBackslash() function
function ExcludeTrailingPathDelimiter(const FileName: TFileName): TFileName;

/// alias to IncludeTrailingBackslash() function
function IncludeTrailingPathDelimiter(const FileName: TFileName): TFileName;

type
  EOSError = class(Exception)
  public
    ErrorCode: DWORD;
  end;

/// raise an EOSError exception corresponding to the last error reported by Windows
procedure RaiseLastOSError;

{$endif DELPHI5OROLDER}

{$ifdef DELPHI6OROLDER}
procedure VarCastError;
{$endif}

/// extract file name, without its extension
// - may optionally return the associated extension, as '.ext'
function GetFileNameWithoutExt(const FileName: TFileName;
  Extension: PFileName=nil): TFileName;

/// extract a file extension from a file name, then compare with a comma
// separated list of extensions
// - e.g. GetFileNameExtIndex('test.log','exe,log,map')=1
// - will return -1 if no file extension match
// - will return any matching extension, starting count at 0
// - extension match is case-insensitive
function GetFileNameExtIndex(const FileName, CSVExt: TFileName): integer;

/// copy one file to another, similar to the Windows API
function CopyFile(const Source, Target: TFileName; FailIfExists: boolean): boolean;

/// copy the date of one file to another
function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;

/// retrieve a property value in a text-encoded class
// - follows the Delphi serialized text object format, not standard .ini
// - if the property is a string, the simple quotes ' are trimed
function FindObjectEntry(const Content, Name: RawUTF8): RawUTF8;

/// retrieve a filename property value in a text-encoded class
// - follows the Delphi serialized text object format, not standard .ini
// - if the property is a string, the simple quotes ' are trimed
// - any file path and any extension are trimmed
function FindObjectEntryWithoutExt(const Content, Name: RawUTF8): RawUTF8;


type
  /// available pronunciations for our fast Soundex implementation
  TSynSoundExPronunciation =
    (sndxEnglish, sndxFrench, sndxSpanish, sndxNone);

  TSoundExValues = array[0..ord('Z')-ord('B')] of byte;
  PSoundExValues = ^TSoundExValues;

  PSynSoundEx = ^TSynSoundEx;
  /// fast search of a text value, using the Soundex approximation mechanism
  // - Soundex is a phonetic algorithm for indexing names by sound,
  //  as pronounced in a given language. The goal is for homophones to be
  //  encoded to the same representation so that they can be matched despite
  //  minor differences in spelling
  // - this implementation is very fast and can be used e.g. to parse and search
  //  in a huge text buffer
  // - this version also handles french and spanish pronunciations on request,
  //  which differs from default Soundex, i.e. English
  {$ifdef FPC_OR_UNICODE}TSynSoundEx = record private
  {$else}TSynSoundEx = object protected{$endif}
    Search, FirstChar: cardinal;
    fValues: PSoundExValues;
  public
    /// prepare for a Soundex search
    // - you can specify another language pronunciation than default english
    function Prepare(UpperValue: PAnsiChar;
      Lang: TSynSoundExPronunciation=sndxEnglish): boolean; overload;
    /// prepare for a custom Soundex search
    // - you can specify any language pronunciation from raw TSoundExValues array
    function Prepare(UpperValue: PAnsiChar; Lang: PSoundExValues): boolean; overload;
    /// return true if prepared value is contained in a text buffer
    // (UTF-8 encoded), by using the SoundEx comparison algorithm
    // - search prepared value at every word beginning in U^
    function UTF8(U: PUTF8Char): boolean;
    /// return true if prepared value is contained in a ANSI text buffer
    // by using the SoundEx comparison algorithm
    // - search prepared value at every word beginning in A^
    function Ansi(A: PAnsiChar): boolean;
  end;

/// Retrieve the Soundex value of a text word, from Ansi buffer
// - Return the soundex value as an easy to use cardinal value, 0 if the
// incoming string contains no valid word
// - if next is defined, its value is set to the end of the encoded word
// (so that you can call again this function to encode a full sentence)
function SoundExAnsi(A: PAnsiChar; next: PPAnsiChar=nil;
  Lang: TSynSoundExPronunciation=sndxEnglish): cardinal; overload;

/// Retrieve the Soundex value of a text word, from Ansi buffer
// - Return the soundex value as an easy to use cardinal value, 0 if the
// incoming string contains no valid word
// - if next is defined, its value is set to the end of the encoded word
// (so that you can call again this function to encode a full sentence)
function SoundExAnsi(A: PAnsiChar; next: PPAnsiChar; Lang: PSoundExValues): cardinal; overload;

/// Retrieve the Soundex value of a text word, from UTF-8 buffer
// - Return the soundex value as an easy to use cardinal value, 0 if the
// incoming string contains no valid word
// - if next is defined, its value is set to the end of the encoded word
// (so that you can call again this function to encode a full sentence)
// - very fast: all UTF-8 decoding is handled on the fly
function SoundExUTF8(U: PUTF8Char; next: PPUTF8Char=nil;
  Lang: TSynSoundExPronunciation=sndxEnglish): cardinal;

const
  /// number of bits to use for each interresting soundex char
  // - default is to use 8 bits, i.e. 4 soundex chars, which is the
  // standard approach
  // - for a more detailled soundex, use 4 bits resolution, which will
  // compute up to 7 soundex chars in a cardinal (that's our choice)
  SOUNDEX_BITS = 4;

/// return true if UpperValue (Ansi) is contained in A^ (Ansi)
// - find UpperValue starting at word beginning, not inside words
function FindAnsi(A, UpperValue: PAnsiChar): boolean;

/// return true if UpperValue (Ansi) is contained in U^ (UTF-8 encoded)
// - find UpperValue starting at word beginning, not inside words
// - UTF-8 decoding is done on the fly (no temporary decoding buffer is used)
function FindUTF8(U: PUTF8Char; UpperValue: PAnsiChar): boolean;

/// return true if Upper (Unicode encoded) is contained in U^ (UTF-8 encoded)
// - will use the slow but accurate Operating System API to perform the
// comparison at Unicode-level
function FindUnicode(PW: PWideChar; Upper: PWideChar; UpperLen: integer): boolean;

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return a PUTF8Char to avoid any memory allocation
function TrimLeftLowerCase(const V: RawUTF8): PUTF8Char;

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return an RawUTF8 string: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return a shortstring: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
function TrimLeftLowerCaseToShort(V: PShortString): ShortString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// trim first lowercase chars ('otDone' will return 'Done' e.g.)
// - return a shortstring: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
procedure TrimLeftLowerCaseToShort(V: PShortString; out result: ShortString); overload;

/// convert a CamelCase string into a space separated one
// - 'OnLine' will return 'On line' e.g., and 'OnMyLINE' will return 'On my LINE'
// - will handle capital words at the beginning, middle or end of the text, e.g.
// 'KLMFlightNumber' will return 'KLM flight number' and 'GoodBBCProgram' will
// return 'Good BBC program'
// - will handle a number at the beginning, middle or end of the text, e.g.
// 'Email12' will return 'Email 12'
// - '_' char is transformed into ' - '
// - '__' chars are transformed into ': '
// - return an RawUTF8 string: enumeration names are pure 7bit ANSI with Delphi 7
// to 2007, and UTF-8 encoded with Delphi 2009+
function UnCamelCase(const S: RawUTF8): RawUTF8; overload;

/// convert a CamelCase string into a space separated one
// - 'OnLine' will return 'On line' e.g., and 'OnMyLINE' will return 'On my LINE'
// - will handle capital words at the beginning, middle or end of the text, e.g.
// 'KLMFlightNumber' will return 'KLM flight number' and 'GoodBBCProgram' will
// return 'Good BBC program'
// - will handle a number at the beginning, middle or end of the text, e.g.
// 'Email12' will return 'Email 12'
// - return the char count written into D^
// - D^ and P^ are expected to be UTF-8 encoded: enumeration and property names
// are pure 7bit ANSI with Delphi 7 to 2007, and UTF-8 encoded with Delphi 2009+
// - '_' char is transformed into ' - '
// - '__' chars are transformed into ': '
function UnCamelCase(D, P: PUTF8Char): integer; overload;

/// convert a string into an human-friendly CamelCase identifier
// - replacing spaces or punctuations by an uppercase character
// - as such, it is not the reverse function to UnCamelCase()
procedure CamelCase(P: PAnsiChar; len: integer; var s: RawUTF8;
  const isWord: TSynByteSet=[ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')]); overload;

/// convert a string into an human-friendly CamelCase identifier
// - replacing spaces or punctuations by an uppercase character
// - as such, it is not the reverse function to UnCamelCase()
procedure CamelCase(const text: RawUTF8; var s: RawUTF8;
  const isWord: TSynByteSet=[ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')]); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// UnCamelCase and translate a char buffer
// - P is expected to be #0 ended
// - return "string" type, i.e. UnicodeString for Delphi 2009+
procedure GetCaptionFromPCharLen(P: PUTF8Char; out result: string);

/// will get a class name as UTF-8
// - will trim 'T', 'TSyn', 'TSQL' or 'TSQLRecord' left side of the class name
// - will encode the class name as UTF-8 (for Unicode Delphi versions)
// - is used e.g. to extract the SQL table name for a TSQLRecord class
function GetDisplayNameFromClass(C: TClass): RawUTF8;

///  UnCamelCase and translate the class name, triming any left 'T', 'TSyn',
// 'TSQL' or 'TSQLRecord'
// - return generic VCL string type, i.e. UnicodeString for Delphi 2009+
function GetCaptionFromClass(C: TClass): string;

/// just a wrapper around vmtClassName to avoid a string conversion
function ClassNameShort(C: TClass): PShortString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtClassName to avoid a string conversion
function ClassNameShort(Instance: TObject): PShortString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtClassName to avoid a string/RawUTF8 conversion
function ToText(C: TClass): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// just a wrapper around vmtClassName to avoid a string/RawUTF8 conversion
procedure ToText(C: TClass; var result: RawUTF8); overload;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// information about one method, as returned by GetPublishedMethods
  TPublishedMethodInfo = record
    /// the method name
    Name: RawUTF8;
    /// a callback to the method, for the given class instance
    Method: TMethod;
  end;
  /// information about all methods, as returned by GetPublishedMethods
  TPublishedMethodInfoDynArray = array of TPublishedMethodInfo;

/// retrieve published methods information about any class instance
// - will optionaly accept a Class, in this case Instance is ignored
// - will work with FPC and Delphi RTTI
function GetPublishedMethods(Instance: TObject; out Methods: TPublishedMethodInfoDynArray; aClass: TClass = nil): integer;

{$ifdef LINUX}
const
  ANSI_CHARSET = 0;
  DEFAULT_CHARSET = 1;
  SYMBOL_CHARSET = 2;
  SHIFTJIS_CHARSET = $80;
  HANGEUL_CHARSET = 129;
  GB2312_CHARSET = 134;
  CHINESEBIG5_CHARSET = 136;
  OEM_CHARSET = 255;
  JOHAB_CHARSET = 130;
  HEBREW_CHARSET = 177;
  ARABIC_CHARSET = 178;
  GREEK_CHARSET = 161;
  TURKISH_CHARSET = 162;
  VIETNAMESE_CHARSET = 163;
  THAI_CHARSET = 222;
  EASTEUROPE_CHARSET = 238;
  RUSSIAN_CHARSET = 204;
  BALTIC_CHARSET = 186;
{$else}
{$ifdef FPC}
const
  VIETNAMESE_CHARSET = 163;
{$endif}
{$endif}

/// convert a char set to a code page
function CharSetToCodePage(CharSet: integer): cardinal;

/// convert a code page to a char set
function CodePageToCharSet(CodePage: Cardinal): Integer;

/// retrieve the MIME content type from a supplied binary buffer
// - return the MIME type, ready to be appended to a 'Content-Type: ' HTTP header
// - returns DefaultContentType if the binary buffer has an unknown layout
function GetMimeContentTypeFromBuffer(Content: Pointer; Len: integer;
  const DefaultContentType: RawUTF8): RawUTF8;

/// retrieve the MIME content type from a supplied binary buffer or file name
// - return the MIME type, ready to be appended to a 'Content-Type: ' HTTP header
// - default is 'application/octet-stream' (BINARY_CONTENT_TYPE) or
// 'application/extension' if FileName was specified
// - see @http://en.wikipedia.org/wiki/Internet_media_type for most common values
function GetMimeContentType(Content: Pointer; Len: integer;
   const FileName: TFileName=''): RawUTF8;

/// retrieve the HTTP header for MIME content type from a supplied binary buffer
// - just append HEADER_CONTENT_TYPE and GetMimeContentType() result
// - can be used as such:
// !  Call.OutHead := GetMimeContentTypeHeader(Call.OutBody,aFileName);
function GetMimeContentTypeHeader(const Content: RawByteString;
  const FileName: TFileName=''): RawUTF8;

/// retrieve if some content is compressed, from a supplied binary buffer
// - returns TRUE, if the header in binary buffer "may" be compressed (this method
// can trigger false positives), e.g. begin with most common already compressed
// zip/gz/gif/png/jpeg/avi/mp3/mp4 markers (aka "magic numbers")
function IsContentCompressed(Content: Pointer; Len: integer): boolean;

/// returns TRUE if the supplied HTML Headers contains 'Content-Type: text/...',
// 'Content-Type: application/json' or 'Content-Type: application/xml'
function IsHTMLContentTypeTextual(Headers: PUTF8Char): Boolean;

/// fast guess of the size, in pixels, of a JPEG memory buffer
// - will only scan for basic JPEG structure, up to the StartOfFrame (SOF) chunk
// - returns TRUE if the buffer is likely to be a JPEG picture, and set the
// Height + Width variable with its dimensions - but there may be false positive
// recognition, and no waranty that the memory buffer holds a valid JPEG picture
// - returns FALSE if the buffer does not have any expected SOI/SOF markers
function GetJpegSize(jpeg: PAnsiChar; len: integer; out Height, Width: integer): boolean; overload;

/// fast guess of the size, in pixels, of a JPEG file
// - will only scan for basic JPEG structure, up to the StartOfFrame (SOF) chunk
// - returns TRUE if the buffer is likely to be a JPEG picture, and set the
// Height + Width variable with its dimensions - but there may be false positive
// recognition, and no waranty that the file is a valid JPEG picture
// - returns FALSE if the file content does not have any expected SOI/SOF markers
function GetJpegSize(const jpeg: TFileName; out Height, Width: integer): boolean; overload;

type
  /// used by MultiPartFormDataDecode() to return one item of its data
  TMultiPart = record
    Name: RawUTF8;
    FileName: RawUTF8;
    ContentType: RawUTF8;
    Encoding: RawUTF8;
    Content: RawByteString;
  end;
  /// used by MultiPartFormDataDecode() to return all its data items
  TMultiPartDynArray = array of TMultiPart;

/// decode multipart/form-data POST request content
// - following RFC1867
function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;

/// encode multipart fields and files
// - only one of them can be used because MultiPartFormDataDecode must implement
// both decodings
// - MultiPart: parts to build the multipart content from, which may be created
// using MultiPartFormDataAddFile/MultiPartFormDataAddField
// - MultiPartContentType: variable returning
// $ Content-Type: multipart/form-data; boundary=xxx
// where xxx is the first generated boundary
// - MultiPartContent: generated multipart content
function MultiPartFormDataEncode(const MultiPart: TMultiPartDynArray;
  var MultiPartContentType, MultiPartContent: RawUTF8): boolean;

/// encode a file in a multipart array
// - FileName: file to encode
// - Multipart: where the part is added
// - Name: name of the part, is empty the name 'File###' is generated
function MultiPartFormDataAddFile(const FileName: TFileName;
  var MultiPart: TMultiPartDynArray; const Name: RawUTF8 = ''): boolean;

/// encode a field in a multipart array
// - FieldName: field name of the part
// - FieldValue: value of the field
// - Multipart: where the part is added
function MultiPartFormDataAddField(const FieldName, FieldValue: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive StrComp (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
// - will use fast O(log(n)) binary search algorithm
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
// - this overloaded function accept a custom comparison function for sorting
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
// - will use fast O(log(n)) binary search algorithm
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt; overload;

/// retrieve the index where is located a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive StrComp (so will work with any PAnsiChar)
// - returns -1 if the specified Value was not found
// - will use fast O(log(n)) binary search algorithm
function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the index where is located a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison will use the specified Compare function
// - returns -1 if the specified Value was not found
// - will use fast O(log(n)) binary search algorithm
function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt; overload;

/// retrieve the index of a PUTF8Char in a PUTF8Char array via a sort indexed
// - will use fast O(log(n)) binary search algorithm
function FastFindIndexedPUTF8Char(P: PPUTF8CharArray; R: PtrInt;
  var SortedIndexes: TCardinalDynArray; Value: PUTF8Char;
  ItemComp: TUTF8Compare): PtrInt;

/// add a RawUTF8 value in an alphaticaly sorted dynamic array of RawUTF8
// - returns the index where the Value was added successfully in Values[]
// - returns -1 if the specified Value was alredy present in Values[]
//  (we must avoid any duplicate for O(log(n)) binary search)
// - if CoValues is set, its content will be moved to allow inserting a new
// value at CoValues[result] position - a typical usage of CoValues is to store
// the corresponding ID to each RawUTF8 item
// - if FastLocatePUTF8CharSorted() has been already called, this index can
// be set to optional ForceIndex parameter
// - by default, exact (case-sensitive) match is used; you can specify a custom
// compare function if needed in Compare optional parameter
function AddSortedRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8; CoValues: PIntegerDynArray=nil; ForcedIndex: PtrInt=-1;
  Compare: TUTF8Compare=nil): PtrInt;

/// delete a RawUTF8 item in a dynamic array of RawUTF8
// - if CoValues is set, the integer item at the same index is also deleted
function DeleteRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  Index: integer; CoValues: PIntegerDynArray=nil): boolean; overload;

/// delete a RawUTF8 item in a dynamic array of RawUTF8;
function DeleteRawUTF8(var Values: TRawUTF8DynArray; Index: integer): boolean; overload;

/// sort a dynamic array of RawUTF8 items
// - if CoValues is set, the integer items are also synchronized
// - by default, exact (case-sensitive) match is used; you can specify a custom
// compare function if needed in Compare optional parameter
procedure QuickSortRawUTF8(var Values: TRawUTF8DynArray; ValuesCount: integer;
  CoValues: PIntegerDynArray=nil; Compare: TUTF8Compare=nil);

/// sort a dynamic array of PUTF8Char items, via an external array of indexes
// - you can use FastFindIndexedPUTF8Char() for fast O(log(n)) binary search
procedure QuickSortIndexedPUTF8Char(Values: PPUtf8CharArray; Count: Integer;
  var SortedIndexes: TCardinalDynArray; CaseSensitive: boolean=false);

/// fast search of an unsigned integer position in an integer array
// - Count is the number of cardinal entries in P^
// - returns P where P^=Value
// - returns nil if Value was not found
function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;

/// fast search of an unsigned integer position in an integer array
// - Count is the number of integer entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;

/// fast search of an integer position in a 64-bit integer array
// - Count is the number of Int64 entries in P^
// - returns P where P^=Value
// - returns nil if Value was not found
function Int64Scan(P: PInt64Array; Count: PtrInt; const Value: Int64): PInt64;

/// fast search of an integer position in a signed 64-bit integer array
// - Count is the number of Int64 entries in P^
// - returns index of P^[index]=Value
// - returns -1 if Value was not found
function Int64ScanIndex(P: PInt64Array; Count: PtrInt; const Value: Int64): PtrInt;

/// fast search of an integer position in an unsigned 64-bit integer array
// - Count is the number of QWord entries in P^
// - returns index of P^[index]=Value
// - returns -1 if Value was not found
function QWordScanIndex(P: PQWordArray; Count: PtrInt; const Value: QWord): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned integer in an integer array
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;

/// fast search of an integer value in a 64-bit integer array
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function Int64ScanExists(P: PInt64Array; Count: PtrInt; const Value: Int64): boolean;

/// fast search of a pointer-sized unsigned integer position
// in an pointer-sized integer array
// - Count is the number of pointer-sized integer entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of a pointer-sized unsigned integer position
// in an pointer-sized integer array
// - Count is the number of pointer-sized integer entries in P^
// - returns true if P^=Value within Count entries
// - returns false if Value was not found
function PtrUIntScanExists(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned Byte value position in a Byte array
// - Count is the number of Byte entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function ByteScanIndex(P: PByteArray; Count: PtrInt; Value: Byte): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// fast search of an unsigned Word value position in a Word array
// - Count is the number of Word entries in P^
// - return index of P^[index]=Value
// - return -1 if Value was not found
function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// sort an Integer array, low values first
procedure QuickSortInteger(ID: PIntegerArray; L, R: PtrInt); overload;

/// sort an Integer array, low values first
procedure QuickSortInteger(ID,CoValues: PIntegerArray; L, R: PtrInt); overload;

/// sort an Integer array, low values first
procedure QuickSortInteger(var ID: TIntegerDynArray); overload;

/// sort a 16 bit unsigned Integer array, low values first
procedure QuickSortWord(ID: PWordArray; L, R: PtrInt);

/// sort a 64-bit signed Integer array, low values first
procedure QuickSortInt64(ID: PInt64Array; L, R: PtrInt); overload;

/// sort a 64-bit unsigned Integer array, low values first
// - QWord comparison are implemented correctly under FPC or Delphi 2009+ -
// older compilers will use fast and exact SortDynArrayQWord()
procedure QuickSortQWord(ID: PQWordArray; L, R: PtrInt); overload;

/// sort a 64-bit Integer array, low values first
procedure QuickSortInt64(ID,CoValues: PInt64Array; L, R: PtrInt); overload;

type
  /// event handler called by NotifySortedIntegerChanges()
  // - Sender is an opaque const value, maybe a TObject or any pointer
  TOnNotifySortedIntegerChange = procedure(const Sender; Value: integer) of object;

/// compares two 32-bit signed sorted integer arrays, and call event handlers
// to notify the corresponding modifications in an O(n) time
// - items in both old[] and new[] arrays are required to be sorted
procedure NotifySortedIntegerChanges(old, new: PIntegerArray; oldn, newn: PtrInt;
  const added, deleted: TOnNotifySortedIntegerChange; const sender);

/// copy an integer array, then sort it, low values first
procedure CopyAndSortInteger(Values: PIntegerArray; ValuesCount: integer;
  var Dest: TIntegerDynArray);

/// copy an integer array, then sort it, low values first
procedure CopyAndSortInt64(Values: PInt64Array; ValuesCount: integer;
  var Dest: TInt64DynArray);

/// fast O(log(n)) binary search of an integer value in a sorted integer array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - return index of P^[result]=Value
// - return -1 if Value was not found
function FastFindIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt; overload;

/// fast O(log(n)) binary search of an integer value in a sorted integer array
// - return index of Values[result]=Value
// - return -1 if Value was not found
function FastFindIntegerSorted(const Values: TIntegerDynArray; Value: integer): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a 16 bit unsigned integer value in a sorted array
function FastFindWordSorted(P: PWordArray; R: PtrInt; Value: Word): PtrInt;

/// fast O(log(n)) binary search of a 64-bit signed integer value in a sorted array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - return index of P^[result]=Value
// - return -1 if Value was not found
function FastFindInt64Sorted(P: PInt64Array; R: PtrInt; const Value: Int64): PtrInt; overload;

/// fast O(log(n)) binary search of a 64-bit unsigned integer value in a sorted array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - return index of P^[result]=Value
// - return -1 if Value was not found
// - QWord comparison are implemented correctly under FPC or Delphi 2009+ -
// older compilers will fast and exact SortDynArrayQWord()
function FastFindQWordSorted(P: PQWordArray; R: PtrInt; const Value: QWord): PtrInt; overload;

/// sort a PtrInt array, low values first
procedure QuickSortPtrInt(P: PPtrIntArray; L, R: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a PtrInt value in a sorted array
function FastFindPtrIntSorted(P: PPtrIntArray; R: PtrInt; Value: PtrInt): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// sort a pointer array, low values first
procedure QuickSortPointer(P: PPointerArray; L, R: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// fast O(log(n)) binary search of a Pointer value in a sorted array
function FastFindPointerSorted(P: PPointerArray; R: PtrInt; Value: Pointer): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the index where to insert an integer value in a sorted integer array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocateIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;

/// retrieve the index where to insert a word value in a sorted word array
// - R is the last index of available integer entries in P^ (i.e. Count-1)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocateWordSorted(P: PWordArray; R: integer; Value: word): PtrInt;

/// add an integer value in a sorted dynamic array of integers
// - returns the index where the Value was added successfully in Values[]
// - returns -1 if the specified Value was already present in Values[]
//  (we must avoid any duplicate for O(log(n)) binary search)
// - if CoValues is set, its content will be moved to allow inserting a new
// value at CoValues[result] position
function AddSortedInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; CoValues: PIntegerDynArray=nil): PtrInt; overload;

/// add an integer value in a sorted dynamic array of integers
// - overloaded function which do not expect an external Count variable
function AddSortedInteger(var Values: TIntegerDynArray;
  Value: integer; CoValues: PIntegerDynArray=nil): PtrInt; overload;

/// insert an integer value at the specified index position of a dynamic array
// of integers
// - if Index is invalid, the Value is inserted at the end of the array
function InsertInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: Integer; Index: PtrInt; CoValues: PIntegerDynArray=nil): PtrInt;

/// add an integer value at the end of a dynamic array of integers
// - returns TRUE if Value was added successfully in Values[], in this case
// length(Values) will be increased
function AddInteger(var Values: TIntegerDynArray; Value: integer;
  NoDuplicates: boolean=false): boolean; overload;

/// add an integer value at the end of a dynamic array of integers
// - this overloaded function will use a separate Count variable (faster)
// - it won't search for any existing duplicate
procedure AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add an integer array at the end of a dynamic array of integer
function AddInteger(var Values: TIntegerDynArray; const Another: TIntegerDynArray): PtrInt; overload;

/// add an integer value at the end of a dynamic array of integers
// - this overloaded function will use a separate Count variable (faster),
// and would allow to search for duplicates
// - returns TRUE if Value was added successfully in Values[], in this case
// ValuesCount will be increased, but length(Values) would stay fixed most
// of the time (since it stores the Values[] array capacity)
function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; NoDuplicates: boolean): boolean; overload;

/// add a 16-bit integer value at the end of a dynamic array of integers
function AddWord(var Values: TWordDynArray; var ValuesCount: integer; Value: Word): PtrInt;

/// add a 64-bit integer value at the end of a dynamic array of integers
function AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: Int64): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add a 64-bit integer value at the end of a dynamic array
function AddInt64(var Values: TInt64DynArray; Value: Int64): PtrInt; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add a 64-bit integer array at the end of a dynamic array
function AddInt64(var Values: TInt64DynArray; const Another: TInt64DynArray): PtrInt; overload;

/// if not already existing, add a 64-bit integer value to a dynamic array
function AddInt64Once(var Values: TInt64DynArray; Value: Int64): PtrInt;

/// if not already existing, add a 64-bit integer value to a sorted dynamic array
procedure AddInt64Sorted(var Values: TInt64DynArray; Value: Int64);

/// delete any 32-bit integer in Values[]
procedure DeleteInteger(var Values: TIntegerDynArray; Index: PtrInt); overload;

/// delete any 32-bit integer in Values[]
procedure DeleteInteger(var Values: TIntegerDynArray; var ValuesCount: Integer; Index: PtrInt); overload;

/// remove some 32-bit integer from Values[]
// - Excluded is declared as var, since it will be sorted in-place during process
// if it contains more than ExcludedSortSize items (i.e. if the sort is worth it)
procedure ExcludeInteger(var Values, Excluded: TIntegerDynArray;
  ExcludedSortSize: Integer=32);

/// ensure some 32-bit integer from Values[] will only contain Included[]
// - Included is declared as var, since it will be sorted in-place during process
// if it contains more than IncludedSortSize items (i.e. if the sort is worth it)
procedure IncludeInteger(var Values, Included: TIntegerDynArray;
  IncludedSortSize: Integer=32);

/// sort and remove any 32-bit duplicated integer from Values[]
procedure DeduplicateInteger(var Values: TIntegerDynArray); overload;

/// sort and remove any 32-bit duplicated integer from Values[]
// - returns the new Values[] length
function DeduplicateInteger(var Values: TIntegerDynArray; Count: integer): integer; overload;

/// low-level function called by DeduplicateInteger()
function DeduplicateIntegerSorted(val: PIntegerArray; last: PtrInt): PtrInt;

/// create a new 32-bit integer dynamic array with the values from another one
procedure CopyInteger(const Source: TIntegerDynArray; out Dest: TIntegerDynArray);

/// delete any 16-bit integer in Values[]
procedure DeleteWord(var Values: TWordDynArray; Index: PtrInt);

/// delete any 64-bit integer in Values[]
procedure DeleteInt64(var Values: TInt64DynArray; Index: PtrInt); overload;

/// delete any 64-bit integer in Values[]
procedure DeleteInt64(var Values: TInt64DynArray; var ValuesCount: Integer; Index: PtrInt); overload;

/// remove some 64-bit integer from Values[]
// - Excluded is declared as var, since it will be sorted in-place during process
// if it contains more than ExcludedSortSize items (i.e. if the sort is worth it)
procedure ExcludeInt64(var Values, Excluded: TInt64DynArray;
  ExcludedSortSize: Integer=32);

/// ensure some 64-bit integer from Values[] will only contain Included[]
// - Included is declared as var, since it will be sorted in-place during process
// if it contains more than IncludedSortSize items (i.e. if the sort is worth it)
procedure IncludeInt64(var Values, Included: TInt64DynArray;
  IncludedSortSize: Integer=32);

/// sort and remove any 64-bit duplicated integer from Values[]
procedure DeduplicateInt64(var Values: TInt64DynArray); overload;

/// sort and remove any 64-bit duplicated integer from Values[]
// - returns the new Values[] length
function DeduplicateInt64(var Values: TInt64DynArray; Count: integer): integer; overload;

/// low-level function called by DeduplicateInt64()
// - warning: caller should ensure that last>0
function DeduplicateInt64Sorted(val: PInt64Array; last: PtrInt): PtrInt;

/// create a new 64-bit integer dynamic array with the values from another one
procedure CopyInt64(const Source: TInt64DynArray; out Dest: TInt64DynArray);

/// find the maximum 32-bit integer in Values[]
function MaxInteger(const Values: TIntegerDynArray; ValuesCount: integer;
  MaxStart: integer=-1): Integer;

/// sum all 32-bit integers in Values[]
function SumInteger(const Values: TIntegerDynArray; ValuesCount: integer): Integer;

/// fill already allocated Reversed[] so that Reversed[Values[i]]=i
procedure Reverse(const Values: TIntegerDynArray; ValuesCount: integer;
  Reversed: PIntegerArray);

/// fill some values with i,i+1,i+2...i+Count-1
procedure FillIncreasing(Values: PIntegerArray; StartValue: integer; Count: PtrUInt);

/// copy some Int64 values into an unsigned integer array
procedure Int64ToUInt32(Values64: PInt64Array; Values32: PCardinalArray; Count: integer);

/// add the strings in the specified CSV text into a dynamic array of integer
procedure CSVToIntegerDynArray(CSV: PUTF8Char; var Result: TIntegerDynArray;
  Sep: AnsiChar= ',');

/// add the strings in the specified CSV text into a dynamic array of integer
procedure CSVToInt64DynArray(CSV: PUTF8Char; var Result: TInt64DynArray;
  Sep: AnsiChar= ','); overload;

/// add the strings in the specified CSV text into a dynamic array of integer
function CSVToInt64DynArray(CSV: PUTF8Char; Sep: AnsiChar= ','): TInt64DynArray; overload;

/// return the corresponding CSV text from a dynamic array of 32-bit integer
// - you can set some custom Prefix and Suffix text
function IntegerDynArrayToCSV(Values: PIntegerArray; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;

/// return the corresponding CSV text from a dynamic array of 32-bit integer
// - you can set some custom Prefix and Suffix text
function IntegerDynArrayToCSV(const Values: TIntegerDynArray;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// return the corresponding CSV text from a dynamic array of 64-bit integers
// - you can set some custom Prefix and Suffix text
function Int64DynArrayToCSV(Values: PInt64Array; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;

/// return the corresponding CSV text from a dynamic array of 64-bit integers
// - you can set some custom Prefix and Suffix text
function Int64DynArrayToCSV(const Values: TInt64DynArray;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''; InlinedValue: boolean=false): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// quick helper to initialize a dynamic array of integer from some constants
// - can be used e.g. as:
// ! MyArray := TIntegerDynArrayFrom([1,2,3]);
// - see also FromI32()
function TIntegerDynArrayFrom(const Values: array of integer): TIntegerDynArray;

/// quick helper to initialize a dynamic array of integer from 64-bit integers
// - will raise a ESynException if any Value[] can not fit into 32-bit, unless
// raiseExceptionOnOverflow is FALSE and the returned array slot is filled
// with maxInt/minInt
function TIntegerDynArrayFrom64(const Values: TInt64DynArray;
  raiseExceptionOnOverflow: boolean=true): TIntegerDynArray;

/// quick helper to initialize a dynamic array of 64-bit integers from 32-bit values
// - see also FromI64() for 64-bit signed integer values input
function TInt64DynArrayFrom(const Values: TIntegerDynArray): TInt64DynArray;

/// quick helper to initialize a dynamic array of 64-bit integers from 32-bit values
// - see also FromU64() for 64-bit unsigned integer values input
function TQWordDynArrayFrom(const Values: TCardinalDynArray): TQWordDynArray;

/// initializes a dynamic array from a set of 32-bit integer signed values
function FromI32(const Values: array of integer): TIntegerDynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initializes a dynamic array from a set of 32-bit integer unsigned values
function FromU32(const Values: array of cardinal): TCardinalDynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initializes a dynamic array from a set of 64-bit integer signed values
function FromI64(const Values: array of Int64): TInt64DynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// initializes a dynamic array from a set of 64-bit integer unsigned values
function FromU64(const Values: array of QWord): TQWordDynArray;
  {$ifdef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}

type
  /// used to store and retrieve Words in a sorted array
  // - is defined either as an object either as a record, due to a bug
  // in Delphi 2009/2010 compiler (at least): this structure is not initialized
  // if defined as an object on the stack, but will be as a record :(
  {$ifdef FPC_OR_UNICODE}TSortedWordArray = record{$else}TSortedWordArray = object{$endif}
  public
    Values: TWordDynArray;
    Count: integer;
    /// add a value into the sorted array
    // - return the index of the new inserted value into the Values[] array
    // - return -(foundindex+1) if this value is already in the Values[] array
    function Add(aValue: Word): PtrInt;
    /// return the index if the supplied value in the Values[] array
    // - return -1 if not found
    function IndexOf(aValue: Word): PtrInt; {$ifdef HASINLINE}inline;{$endif}
  end;

  /// comparison function as expected by MedianQuickSelect()
  // - should return TRUE if Values[IndexA]>Values[IndexB]
  TOnValueGreater = function(IndexA,IndexB: PtrInt): boolean of object;

/// compute the median of an integer serie of values, using "Quickselect"
// - based on the algorithm described in "Numerical recipes in C", Second Edition,
// translated from Nicolas Devillard's C code: http://ndevilla.free.fr/median/median
// - warning: the supplied Integer array is modified in-place during the process,
// and won't be fully sorted on output (this is no QuickSort alternative)
function MedianQuickSelectInteger(Values: PIntegerArray; n: integer): integer;

/// compute the median of a serie of values, using "Quickselect"
// - based on the algorithm described in "Numerical recipes in C", Second Edition
// - expect the values information to be available from a comparison callback
// - this version will use a temporary index list to exchange items order
// (supplied as a TSynTempBuffer), so won't change the supplied values themself
// - returns the index of the median Value
function MedianQuickSelect(const OnCompare: TOnValueGreater; n: integer;
  var TempBuffer: TSynTempBuffer): integer;

/// compute GCD of two integers using substraction-based Euclidean algorithm
function gcd(a, b: cardinal): cardinal;

/// performs a QuickSort using a comparison callback
procedure QuickSortCompare(const OnCompare: TOnValueGreater;
  Index: PIntegerArray; L,R: PtrInt);

/// convert a cardinal into a 32-bit variable-length integer buffer
function ToVarUInt32(Value: PtrUInt; Dest: PByte): PByte;

/// return the number of bytes necessary to store a 32-bit variable-length integer
// - i.e. the ToVarUInt32() buffer size
function ToVarUInt32Length(Value: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// return the number of bytes necessary to store some data with a its
// 32-bit variable-length integer legnth
function ToVarUInt32LengthWithData(Value: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an integer into a 32-bit variable-length integer buffer
// - store negative values as cardinal two-complement, i.e.
// 0=0,1=1,2=-1,3=2,4=-2...
function ToVarInt32(Value: PtrInt; Dest: PByte): PByte;

/// convert a 32-bit variable-length integer buffer into a cardinal
// - fast inlined process for any number < 128
function FromVarUInt32(var Source: PByte): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a 32-bit variable-length integer buffer into a cardinal
// - this version could be called if number is likely to be > $7f, so it
// inlining the first byte won't make any benefit
function FromVarUInt32Big(var Source: PByte): cardinal;

/// convert a 32-bit variable-length integer buffer into a cardinal
// - this version must be called if Source^ has already been checked to be > $7f
// ! result := Source^;
// ! inc(Source);
// ! if result>$7f then
// !   result := (result and $7F) or FromVarUInt32Up128(Source);
function FromVarUInt32Up128(var Source: PByte): cardinal;

/// convert a 32-bit variable-length integer buffer into a cardinal
// - this version must be called if Source^ has already been checked to be > $7f
function FromVarUInt32High(var Source: PByte): cardinal;

/// convert a 32-bit variable-length integer buffer into an integer
// - decode negative values from cardinal two-complement, i.e.
// 0=0,1=1,2=-1,3=2,4=-2...
function FromVarInt32(var Source: PByte): integer;

/// convert a UInt64 into a 64-bit variable-length integer buffer
function ToVarUInt64(Value: QWord; Dest: PByte): PByte;

/// convert a 64-bit variable-length integer buffer into a UInt64
function FromVarUInt64(var Source: PByte): QWord;

/// convert a Int64 into a 64-bit variable-length integer buffer
function ToVarInt64(Value: Int64; Dest: PByte): PByte; {$ifdef HASINLINE}inline;{$endif}

/// convert a 64-bit variable-length integer buffer into a Int64
function FromVarInt64(var Source: PByte): Int64;

/// convert a 64-bit variable-length integer buffer into a Int64
// - this version won't update the Source pointer
function FromVarInt64Value(Source: PByte): Int64;

/// jump a value in the 32-bit or 64-bit variable-length integer buffer
function GotoNextVarInt(Source: PByte): pointer; {$ifdef HASINLINE}inline;{$endif}

/// convert a RawUTF8 into an UTF-8 encoded variable-length buffer
function ToVarString(const Value: RawUTF8; Dest: PByte): PByte;

/// jump a value in variable-length text buffer
function GotoNextVarString(Source: PByte): pointer; {$ifdef HASINLINE}inline;{$endif}

/// retrieve a variable-length UTF-8 encoded text buffer in a newly allocation RawUTF8
function FromVarString(var Source: PByte): RawUTF8; overload;

/// retrieve a variable-length text buffer
// - this overloaded function will set the supplied code page to the AnsiString
procedure FromVarString(var Source: PByte; var Value: RawByteString;
  CodePage: integer); overload;

/// retrieve a variable-length UTF-8 encoded text buffer in a temporary buffer
// - caller should call Value.Done after use of the Value.buf memory
// - this overloaded function would include a trailing #0, so Value.buf could
// be parsed as a valid PUTF8Char buffer (e.g. containing JSON)
procedure FromVarString(var Source: PByte; var Value: TSynTempBuffer); overload;

type
  /// kind of result returned by FromVarBlob() function
  TValueResult = record
    /// start of data value
    Ptr: PAnsiChar;
    /// value length (in bytes)
    Len: integer;
  end;

/// retrieve pointer and length to a variable-length text/blob buffer
function FromVarBlob(Data: PByte): TValueResult; {$ifdef HASINLINE}inline;{$endif}



{ ************ low-level RTTI types and conversion routines ***************** }

type
  /// function prototype to be used for TDynArray Sort and Find method
  // - common functions exist for base types: see e.g. SortDynArrayBoolean,
  // SortDynArrayByte, SortDynArrayWord, SortDynArrayInteger, SortDynArrayCardinal,
  // SortDynArrayInt64, SortDynArrayQWord, SordDynArraySingle, SortDynArrayDouble,
  // SortDynArrayAnsiString, SortDynArrayAnsiStringI, SortDynArrayUnicodeString,
  // SortDynArrayUnicodeStringI, SortDynArrayString, SortDynArrayStringI
  // - any custom type (even records) can be compared then sort by defining
  // such a custom function
  // - must return 0 if A=B, -1 if A<B, 1 if A>B
  TDynArraySortCompare = function(const A,B): integer;

  /// event oriented version of TDynArraySortCompare
  TEventDynArraySortCompare = function(const A,B): integer of object;

  /// optional event called by TDynArray.LoadFrom method after each item load
  // - could be used e.g. for string interning or some custom initialization process
  // - won't be called if the dynamic array has ElemType=nil
  TDynArrayAfterLoadFrom = procedure(var A) of object;

  /// internal enumeration used to specify some standard Delphi arrays
  // - will be used e.g. to match JSON serialization or TDynArray search
  // (see TDynArray and TDynArrayHash InitSpecific method)
  // - djBoolean would generate an array of JSON boolean values
  // - djByte .. djTimeLog match numerical JSON values
  // - djDateTime .. djHash512 match textual JSON values
  // - djVariant will match standard variant JSON serialization (including
  // TDocVariant or other custom types, if any)
  // - djCustom will be used for registered JSON serializer (invalid for
  // InitSpecific methods call)
  // - see also djPointer and djObject constant aliases for a pointer or
  // TObject field hashing / comparison
  // - is used also by TDynArray.InitSpecific() to define the main field type
  TDynArrayKind = (
    djNone,
    djBoolean, djByte, djWord, djInteger, djCardinal, djSingle,
    djInt64, djQWord, djDouble, djCurrency,  djTimeLog,
    djDateTime, djDateTimeMS, djRawUTF8, djWinAnsi, djString,
    djRawByteString, djWideString, djSynUnicode,
    djHash128, djHash256, djHash512,
    djInterface, {$ifndef NOVARIANTS}djVariant,{$endif}
    djCustom);

  /// internal set to specify some standard Delphi arrays
  TDynArrayKinds = set of TDynArrayKind;

  {$ifdef FPC}
  /// map the Delphi/FPC dynamic array header (stored before each instance)
  // - define globally for proper inlining with FPC
  TDynArrayRec = packed record
    /// dynamic array reference count (basic garbage memory mechanism)
    refCnt: PtrInt;
    high: tdynarrayindex;
    function GetLength: sizeint; inline;
    procedure SetLength(len: sizeint); inline;
    property length: sizeint read GetLength write SetLength;
  end;
  PDynArrayRec = ^TDynArrayRec;
  {$endif FPC}

function ToText(k: TDynArrayKind): PShortString; overload;

const
  /// TDynArrayKind alias for a pointer field hashing / comparison
  djPointer = {$ifdef CPU64}djInt64{$else}djCardinal{$endif};

  /// TDynArrayKind alias for a TObject field hashing / comparison
  djObject = djPointer;

type
  /// the available JSON format, for TTextWriter.AddJSONReformat() and its
  // JSONBufferReformat() and JSONReformat() wrappers
  // - jsonCompact is the default machine-friendly single-line layout
  // - jsonHumanReadable will add line feeds and indentation, for a more
  // human-friendly result
  // - jsonUnquotedPropName will emit the jsonHumanReadable layout, but
  // with all property names being quoted only if necessary: this format
  // could be used e.g. for configuration files - this format, similar to the
  // one used in the MongoDB extended syntax, is not JSON compatible: do not
  // use it e.g. with AJAX clients, but is would be handled as expected by all
  // our units as valid JSON input, without previous correction
  // - jsonUnquotedPropNameCompact will emit single-line layout with unquoted
  // property names
  TTextWriterJSONFormat = (
    jsonCompact, jsonHumanReadable,
    jsonUnquotedPropName, jsonUnquotedPropNameCompact);

  TDynArrayObjArray = (oaUnknown, oaFalse, oaTrue);

  /// a wrapper around a dynamic array with one dimension
  // - provide TList-like methods using fast RTTI information
  // - can be used to fast save/retrieve all memory content to a TStream
  // - note that the "const Elem" is not checked at compile time nor runtime:
  // you must ensure that Elem matchs the element type of the dynamic array
  // - can use external Count storage to make Add() and Delete() much faster
  // (avoid most reallocation of the memory buffer)
  // - Note that TDynArray is just a wrapper around an existing dynamic array:
  // methods can modify the content of the associated variable but the TDynArray
  // doesn't contain any data by itself. It is therefore aimed to initialize
  // a TDynArray wrapper on need, to access any existing dynamic array.
  // - is defined either as an object either as a record, due to a bug
  // in Delphi 2009/2010 compiler (at least): this structure is not initialized
  // if defined as an object on the stack, but will be as a record :(
  {$ifdef UNDIRECTDYNARRAY}TDynArray = record private
  {$else}TDynArray = object protected{$endif}
    fValue: PPointer;
    fTypeInfo: pointer;
    fElemType: pointer;
    fCountP: PInteger;
    fCompare: TDynArraySortCompare;
    fElemSize: cardinal;
    fKnownSize: integer;
    fParser: integer; // index to GlobalJSONCustomParsers.fParsers[]
    fSorted: boolean;
    fKnownType: TDynArrayKind;
    fIsObjArray: TDynArrayObjArray;
    function GetCount: integer; {$ifdef HASINLINE}inline;{$endif}
    procedure SetCount(aCount: integer);
    function GetCapacity: integer;
    procedure SetCapacity(aCapacity: integer);
    procedure SetCompare(const aCompare: TDynArraySortCompare); {$ifdef HASINLINE}inline;{$endif}
    function FindIndex(const Elem; aIndex: PIntegerDynArray;
      aCompare: TDynArraySortCompare): PtrInt;
    function GetArrayTypeName: RawUTF8;
    function GetArrayTypeShort: PShortString;
    function GetIsObjArray: boolean; {$ifdef HASINLINE}inline;{$endif}
    function ComputeIsObjArray: boolean;
    procedure SetIsObjArray(aValue: boolean); {$ifdef HASINLINE}inline;{$endif}
    /// will set fKnownType and fKnownOffset/fKnownSize fields
    function ToKnownType(exactType: boolean=false): TDynArrayKind;
    function LoadKnownType(Data,Source: PAnsiChar): boolean;
    /// faster than System.DynArraySetLength() function + handle T*ObjArray
    procedure InternalSetLength(NewLength: PtrUInt);
  public
    /// initialize the wrapper with a one-dimension dynamic array
    // - the dynamic array must have been defined with its own type
    // (e.g. TIntegerDynArray = array of Integer)
    // - if aCountPointer is set, it will be used instead of length() to store
    // the dynamic array items count - it will be much faster when adding
    // elements to the array, because the dynamic array won't need to be
    // resized each time - but in this case, you should use the Count property
    // instead of length(array) or high(array) when accessing the data: in fact
    // length(array) will store the memory size reserved, not the items count
    // - if aCountPointer is set, its content will be set to 0, whatever the
    // array length is, or the current aCountPointer^ value is
    // - a sample usage may be:
    // !var DA: TDynArray;
    // !    A: TIntegerDynArray;
    // !begin
    // !  DA.Init(TypeInfo(TIntegerDynArray),A);
    // ! (...)
    // - a sample usage may be (using a count variable):
    // !var DA: TDynArray;
    // !    A: TIntegerDynArray;
    // !    ACount: integer;
    // !    i: integer;
    // !begin
    // !  DA.Init(TypeInfo(TIntegerDynArray),A,@ACount);
    // !  for i := 1 to 100000 do
    // !    DA.Add(i); // MUCH faster using the ACount variable
    // ! (...)   // now you should use DA.Count or Count instead of length(A)
    procedure Init(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil);
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts to specify how comparison should occur, using
    // TDynArrayKind  kind of first field
    // - djNone and djCustom are too vague, and will raise an exception
    // - no RTTI check is made over the corresponding array layout: you shall
    // ensure that the aKind parameter matches the dynamic array element definition
    // - aCaseInsensitive will be used for djRawUTF8..djHash512 text comparison
    procedure InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
      aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// define the reference to an external count integer variable
    // - Init and InitSpecific methods will reset the aCountPointer to 0: you
    // can use this method to set the external count variable without overriding
    // the current value
    procedure UseExternalCount(var aCountPointer: Integer);
      {$ifdef HASINLINE}inline;{$endif}
    /// check this dynamic array from the GlobalJSONCustomParsers list
    // - returns TRUE if this array has a custom JSON parser
    function HasCustomJSONParser: boolean;
    /// initialize the wrapper to point to no dynamic array
    procedure Void;
    /// check if the wrapper points to a dynamic array
    function IsVoid: boolean;
    /// add an element to the dynamic array
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Add(i+10) e.g.)
    // - returns the index of the added element in the dynamic array
    // - note that because of dynamic array internal memory managment, adding
    // may reallocate the list every time a record is added, unless an external
    // count variable has been specified in Init(...,@Count) method
    function Add(const Elem): PtrInt;
    /// add an element to the dynamic array
    // - this version add a void element to the array, and returns its index
    // - note: if you use this method to add a new item with a reference to the
    // dynamic array, using a local variable is needed under FPC:
    // !    i := DynArray.New;
    // !    with Values[i] do begin // otherwise Values is nil -> GPF
    // !      Field1 := 1;
    // !      ...
    function New: integer;
    /// add an element to the dynamic array at the position specified by Index
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Insert(10,i+10) e.g.)
    procedure Insert(Index: PtrInt; const Elem);
    /// get and remove the last element stored in the dynamic array
    // - Add + Pop/Peek will implement a LIFO (Last-In-First-Out) stack
    // - warning: Elem must be of the same exact type than the dynamic array
    // - returns true if the item was successfully copied and removed
    // - use Peek() if you don't want to remove the item
    function Pop(var Dest): boolean;
    /// get the last element stored in the dynamic array
    // - Add + Pop/Peek will implement a LIFO (Last-In-First-Out) stack
    // - warning: Elem must be of the same exact type than the dynamic array
    // - returns true if the item was successfully copied into Dest
    // - use Pop() if you also want to remove the item
    function Peek(var Dest): boolean;
    /// delete the whole dynamic array content
    // - this method will recognize T*ObjArray types and free all instances
    procedure Clear; {$ifdef HASINLINE}inline;{$endif}
    /// delete the whole dynamic array content, ignoring exceptions
    // - returns true if no exception occured when calling Clear, false otherwise
    // - you should better not call this method, which will catch and ignore
    // all exceptions - but it may somewhat make sense in a destructor
    // - this method will recognize T*ObjArray types and free all instances
    function ClearSafe: boolean;
    /// delete one item inside the dynamic array
    // - the deleted element is finalized if necessary
    // - this method will recognize T*ObjArray types and free all instances
    procedure Delete(aIndex: PtrInt);
    /// search for an element value inside the dynamic array
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - will search for all properties content of the eLement: TList.IndexOf()
    // searches by address, this method searches by content using the RTTI
    // element description (and not the Compare property function)
    // - use the Find() method if you want the search via the Compare property
    // function, or e.g. to search only with some part of the element content
    // - will work with simple types: binaries (byte, word, integer, Int64,
    // Currency, array[0..255] of byte, packed records with no reference-counted
    // type within...), string types (e.g. array of string), and packed records
    // with binary and string types within (like TFileVersion)
    // - won't work with not packed types (like a shorstring, or a record
    // with byte or word fields with {$A+}): in this case, the padding data
    // (i.e. the bytes between the aligned feeds can be filled as random, and
    // there is no way with standard RTTI do know which they are)
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write IndexOf(i+10) e.g.)
    function IndexOf(const Elem): PtrInt;
    /// search for an element value inside the dynamic array
    // - this method will use the Compare property function for the search
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function Find(const Elem): PtrInt; overload;
    /// search for an element value inside the dynamic array, from an external
    // indexed lookup table
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - this method will use a custom comparison function, with an external
    // integer table, as created by the CreateOrderedIndex() method: it allows
    // multiple search orders in the same dynamic array content
    // - if an indexed lookup is supplied, it must already be sorted:
    // this function will then use fast O(log(n)) binary search
    // - if an indexed lookup is not supplied (i.e aIndex=nil),
    // this function will use slower but accurate O(n) iterating search
    // - warning; the lookup index should be synchronized if array content
    // is modified (in case of adding or deletion)
    function Find(const Elem; const aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare): PtrInt; overload;
    /// search for an element value, then fill all properties if match
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if Elem content matches, all Elem fields will be filled with the record
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndFill(var Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// search for an element value, then delete it if match
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if Elem content matches, this item will be deleted from the array
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index deleted (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndDelete(const Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// search for an element value, then update the item if match
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if Elem content matches, this item will be updated with the supplied value
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndUpdate(const Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// search for an element value, then add it if none matched
    // - this method will use the Compare property function for the search,
    // or the supplied indexed lookup table and its associated compare function
    // - if no Elem content matches, the item will added to the array
    // - can be used e.g. as a simple dictionary: if Compare will match e.g. the
    // first string field (i.e. set to SortDynArrayString), you can fill the
    // first string field with the searched value (if returned index is >= 0)
    // - return the index found (0..Count-1), or -1 if Elem was not found and
    // the supplied element has been succesfully added
    // - if the array is sorted, it will use fast O(log(n)) binary search
    // - if the array is not sorted, it will use slower O(n) iterating search
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindAndAddIfNotExisting(const Elem; aIndex: PIntegerDynArray=nil;
      aCompare: TDynArraySortCompare=nil): integer;
    /// sort the dynamic array elements, using the Compare property function
    // - it will change the dynamic array content, and exchange all elements
    // in order to be sorted in increasing order according to Compare function
    procedure Sort(aCompare: TDynArraySortCompare=nil); overload;
    /// sort some dynamic array elements, using the Compare property function
    // - this method allows to sort only some part of the items
    // - it will change the dynamic array content, and exchange all elements
    // in order to be sorted in increasing order according to Compare function
    procedure SortRange(aStart, aStop: integer; aCompare: TDynArraySortCompare=nil);
    /// sort the dynamic array elements, using a Compare method (not function)
    // - it will change the dynamic array content, and exchange all elements
    // in order to be sorted in increasing order according to Compare function,
    // unless aReverse is true
    // - it won't mark the array as Sorted, since the comparer is local
    procedure Sort(const aCompare: TEventDynArraySortCompare; aReverse: boolean=false); overload;
    /// search the elements range which match a given value in a sorted dynamic array
    // - this method will use the Compare property function for the search
    // - returns TRUE and the matching indexes, or FALSE if none found
    // - if the array is not sorted, returns FALSE
    function FindAllSorted(const Elem; out FirstIndex,LastIndex: Integer): boolean;
    /// search for an element value inside a sorted dynamic array
    // - this method will use the Compare property function for the search
    // - will be faster than a manual FindAndAddIfNotExisting+Sort process
    // - returns TRUE and the index of existing Elem, or FALSE and the index
    // where the Elem is to be inserted so that the array remains sorted
    // - you should then call FastAddSorted() later with the returned Index
    // - if the array is not sorted, returns FALSE and Index=-1
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (no FastLocateSorted(i+10) e.g.)
    function FastLocateSorted(const Elem; out Index: Integer): boolean;
    /// insert a sorted element value at the proper place
    // - the index should have been computed by FastLocateSorted(): false
    // - you may consider using FastLocateOrAddSorted() instead
    procedure FastAddSorted(Index: Integer; const Elem);
    /// search and add an element value inside a sorted dynamic array
    // - this method will use the Compare property function for the search
    // - will be faster than a manual FindAndAddIfNotExisting+Sort process
    // - returns the index of the existing Elem and wasAdded^=false
    // - returns the sorted index of the inserted Elem and wasAdded^=true
    // - if the array is not sorted, returns -1 and wasAdded^=false
    // - is just a wrapper around FastLocateSorted+FastAddSorted
    function FastLocateOrAddSorted(const Elem; wasAdded: PBoolean=nil): integer;
    /// delete a sorted element value at the proper place
    // - plain Delete(Index) would reset the fSorted flag to FALSE, so use
    // this method with a FastLocateSorted/FastAddSorted array
    procedure FastDeleteSorted(Index: Integer);
    /// will reverse all array elements, in place
    procedure Reverse;
    /// sort the dynamic array elements using a lookup array of indexes
    // - in comparison to the Sort method, this CreateOrderedIndex won't change
    // the dynamic array content, but only create (or update) the supplied
    // integer lookup array, using the specified comparison function
    // - if aCompare is not supplied, the method will use fCompare (if defined)
    // - you should provide either a void either a valid lookup table, that is
    // a table with one to one lookup (e.g. created with FillIncreasing)
    // - if the lookup table has less elements than the main dynamic array,
    // its content will be recreated
    procedure CreateOrderedIndex(var aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare); overload;
    /// sort the dynamic array elements using a lookup array of indexes
    // - this overloaded method will use the supplied TSynTempBuffer for
    // index storage, so use PIntegerArray(aIndex.buf) to access the values
    // - caller should always make aIndex.Done once done
    procedure CreateOrderedIndex(out aIndex: TSynTempBuffer;
      aCompare: TDynArraySortCompare); overload;
    /// sort using a lookup array of indexes, after a Add()
    // - will resize aIndex if necessary, and set aIndex[Count-1] := Count-1
    procedure CreateOrderedIndexAfterAdd(var aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare);
    /// save the dynamic array content into a (memory) stream
    // - will handle array of binaries values (byte, word, integer...), array of
    // strings or array of packed records, with binaries and string properties
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - Stream position will be set just after the added data
    // - is optimized for memory streams, but will work with any kind of TStream
    procedure SaveToStream(Stream: TStream);
    /// load the dynamic array content from a (memory) stream
    // - stream content must have been created using SaveToStream method
    // - will handle array of binaries values (byte, word, integer...), array of
    // strings or array of packed records, with binaries and string properties
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    procedure LoadFromStream(Stream: TCustomMemoryStream);
    /// save the dynamic array content into an allocated memory buffer
    // - Dest buffer must have been allocated to contain at least the number
    // of bytes returned by the SaveToLength method
    // - return a pointer at the end of the data written in Dest, nil in case
    // of an invalid input buffer
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - this method will raise an ESynException for T*ObjArray types
    // - use TDynArray.LoadFrom or TDynArrayLoadFrom to decode the saved buffer
    function SaveTo(Dest: PAnsiChar): PAnsiChar; overload;
    /// compute the number of bytes needed by SaveTo() to persist a dynamic array
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - this method will raise an ESynException for T*ObjArray types
    function SaveToLength: integer;
    /// save the dynamic array content into a RawByteString
    // - will use a proprietary binary format, with some variable-length encoding
    // of the string length - note that if you change the type definition, any
    // previously-serialized content will fail, maybe triggering unexpected GPF:
    // use SaveToTypeInfoHash if you share this binary data accross executables
    // - this method will raise an ESynException for T*ObjArray types
    // - use TDynArray.LoadFrom or TDynArrayLoadFrom to decode the saved buffer
    function SaveTo: RawByteString; overload;
    /// compute a crc32c-based hash of the RTTI for this dynamic array
    // - can be used to ensure that the TDynArray.SaveTo binary layout
    // is compatible accross executables
    // - won't include the RTTI type kind, as TypeInfoToHash(), but only
    // ElemSize or ElemType information, or any previously registered
    // TTextWriter.RegisterCustomJSONSerializerFromText definition
    function SaveToTypeInfoHash(crc: cardinal=0): cardinal;
    /// load the dynamic array content from a memory buffer
    // - return nil if the Source buffer is incorrect (invalid type or internal
    // checksum e.g.), or return the memory buffer pointer just after the
    // content, as written by TDynArray.SaveTo
    // - this method will raise an ESynException for T*ObjArray types
    // - you can optionally call AfterEach callback for each row loaded
    // - if you don't want to allocate all items on memory, but just want to
    // iterate over all items stored in a TDynArray.SaveTo memory buffer,
    // consider using TDynArrayLoadFrom object
    function LoadFrom(Source: PAnsiChar; AfterEach: TDynArrayAfterLoadFrom=nil;
      NoCheckHash: boolean=false): PAnsiChar;
    /// serialize the dynamic array content as JSON
    // - is just a wrapper around TTextWriter.AddDynArrayJSON()
    // - this method will therefore recognize T*ObjArray types
    function SaveToJSON(EnumSetsAsText: boolean=false;
      reformat: TTextWriterJSONFormat=jsonCompact): RawUTF8; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// serialize the dynamic array content as JSON
    // - is just a wrapper around TTextWriter.AddDynArrayJSON()
    // - this method will therefore recognize T*ObjArray types
    procedure SaveToJSON(out Result: RawUTF8; EnumSetsAsText: boolean=false;
      reformat: TTextWriterJSONFormat=jsonCompact); overload;
    /// load the dynamic array content from an UTF-8 encoded JSON buffer
    // - expect the format as saved by TTextWriter.AddDynArrayJSON method, i.e.
    // handling TBooleanDynArray, TIntegerDynArray, TInt64DynArray, TCardinalDynArray,
    // TDoubleDynArray, TCurrencyDynArray, TWordDynArray, TByteDynArray,
    // TRawUTF8DynArray, TWinAnsiDynArray, TRawByteStringDynArray,
    // TStringDynArray, TWideStringDynArray, TSynUnicodeDynArray,
    // TTimeLogDynArray and TDateTimeDynArray as JSON array - or any customized
    // valid JSON serialization as set by TTextWriter.RegisterCustomJSONSerializer
    // - or any other kind of array as Base64 encoded binary stream precessed
    // via JSON_BASE64_MAGIC (UTF-8 encoded \uFFF0 special code)
    // - typical handled content could be
    // ! '[1,2,3,4]' or '["\uFFF0base64encodedbinary"]'
    // - return a pointer at the end of the data read from P, nil in case
    // of an invalid input buffer
    // - this method will recognize T*ObjArray types, and will first free
    // any existing instance before unserializing, to avoid memory leak
    // - warning: the content of P^ will be modified during parsing: please
    // make a local copy if it will be needed later (using e.g. TSynTempBufer)
    function LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil): PUTF8Char;
    {$ifndef NOVARIANTS}
    /// load the dynamic array content from a TDocVariant instance
    // - will convert the TDocVariant into JSON, the call LoadFromJSON
    function LoadFromVariant(const DocVariant: variant): boolean;
    {$endif NOVARIANTS}
    ///  select a sub-section (slice) of a dynamic array content
    procedure Slice(var Dest; aCount: Cardinal; aFirstIndex: cardinal=0);
    /// add elements from a given dynamic array variable
    // - the supplied source DynArray MUST be of the same exact type as the
    // current used for this TDynArray - warning: pass here a reference to
    // a "array of ..." variable, not another TDynArray instance; if you
    // want to add another TDynArray, use AddDynArray() method
    // - you can specify the start index and the number of items to take from
    // the source dynamic array (leave as -1 to add till the end)
    // - returns the number of items added to the array
    function AddArray(const DynArrayVar; aStartIndex: integer=0; aCount: integer=-1): integer;
    {$ifndef DELPHI5OROLDER}
    /// fast initialize a wrapper for an existing dynamic array of the same type
    // - is slightly faster than
    // ! Init(aAnother.ArrayType,aValue,nil);
    procedure InitFrom(const aAnother: TDynArray; var aValue);
      {$ifdef HASINLINE}inline;{$endif}
    /// add elements from a given TDynArray
    // - the supplied source TDynArray MUST be of the same exact type as the
    // current used for this TDynArray, otherwise it won't do anything
    // - you can specify the start index and the number of items to take from
    // the source dynamic array (leave as -1 to add till the end)
    procedure AddDynArray(const aSource: TDynArray; aStartIndex: integer=0; aCount: integer=-1);
    /// compare the content of the two arrays, returning TRUE if both match
    // - this method compares using any supplied Compare property (unless
    // ignorecompare=true), or by content using the RTTI element description
    // of the whole array items
    // - will call SaveToJSON to compare T*ObjArray kind of arrays
    function Equals(const B: TDynArray; ignorecompare: boolean=false): boolean;
    /// set all content of one dynamic array to the current array
    // - both must be of the same exact type
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure Copy(const Source: TDynArray; ObjArrayByRef: boolean=false);
    /// set all content of one dynamic array to the current array
    // - both must be of the same exact type
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure CopyFrom(const Source; MaxElem: integer; ObjArrayByRef: boolean=false);
    /// set all content of the current dynamic array to another array variable
    // - both must be of the same exact type
    // - resulting length(Dest) will match the exact items count, even if an
    // external Count integer variable is used by this instance
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure CopyTo(out Dest; ObjArrayByRef: boolean=false);
    {$endif DELPHI5OROLDER}
    /// returns a pointer to an element of the array
    // - returns nil if aIndex is out of range
    // - since TDynArray is just a wrapper around an existing array, you should
    // better use direct access to its wrapped variable, and not using this
    // slower and more error prone method (such pointer access lacks of strong
    // typing abilities), which was designed for TDynArray internal use
    function ElemPtr(index: PtrInt): pointer; {$ifdef HASINLINE}inline;{$endif}
    /// will copy one element content from its index into another variable
    // - do nothing if index is out of range
    procedure ElemCopyAt(index: PtrInt; var Dest); {$ifdef FPC}inline;{$endif}
    /// will move one element content from its index into another variable
    // - will erase the internal item after copy
    // - do nothing if index is out of range
    procedure ElemMoveTo(index: PtrInt; var Dest);
    /// will copy one variable content into an indexed element
    // - do nothing if index is out of range
    // - ClearBeforeCopy will call ElemClear() before the copy, which may be safer
    // if the source item is a copy of Values[index] with some dynamic arrays
    procedure ElemCopyFrom(const Source; index: PtrInt;
      ClearBeforeCopy: boolean=false); {$ifdef FPC}inline;{$endif}
    /// compare the content of two elements, returning TRUE if both values equal
    // - this method compares first using any supplied Compare property,
    // then by content using the RTTI element description of the whole record
    function ElemEquals(const A,B): boolean;
    /// will reset the element content
    procedure ElemClear(var Elem);
    /// will copy one element content
    procedure ElemCopy(const A; var B); {$ifdef FPC}inline;{$endif}
    /// will copy the first field value of an array element
    // - will use the array KnownType to guess the copy routine to use
    // - returns false if the type information is not enough for a safe copy
    function ElemCopyFirstField(Source,Dest: Pointer): boolean;
    /// save an array element into a serialized binary content
    // - use the same layout as TDynArray.SaveTo, but for a single item
    // - you can use ElemLoad method later to retrieve its content
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write ElemSave(i+10) e.g.)
    function ElemSave(const Elem): RawByteString;
    /// load an array element as saved by the ElemSave method into Elem variable
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write ElemLoad(P,i+10) e.g.)
    procedure ElemLoad(Source: PAnsiChar; var Elem); overload;
    /// load an array element as saved by the ElemSave method
    // - this overloaded method will retrieve the element as a memory buffer,
    // which should be cleared by ElemLoadClear() before release
    function ElemLoad(Source: PAnsiChar): RawByteString; overload;
    /// search for an array element as saved by the ElemSave method
    // - same as ElemLoad() + Find()/IndexOf() + ElemLoadClear()
    // - will call Find() method if Compare property is set
    // - will call generic IndexOf() method if no Compare property is set
    function ElemLoadFind(Source: PAnsiChar): integer;
    /// finalize a temporary buffer used to store an element via ElemLoad()
    // - will release any managed type referenced inside the RawByteString,
    // then void the variable
    // - is just a wrapper around ElemClear(pointer(ElemTemp)) + ElemTemp := ''
    procedure ElemLoadClear(var ElemTemp: RawByteString);

    /// retrieve or set the number of elements of the dynamic array
    // - same as length(DynArray) or SetLength(DynArray)
    // - this property will recognize T*ObjArray types, so will free any stored
    // instance if the array is sized down
    property Count: integer read GetCount write SetCount;
    /// the internal buffer capacity
    // - if no external Count pointer was set with Init, is the same as Count
    // - if an external Count pointer is set, you can set a value to this
    // property before a massive use of the Add() method e.g.
    // - if no external Count pointer is set, set a value to this property
    // will affect the Count value, i.e. Add() will append after this count
    // - this property will recognize T*ObjArray types, so will free any stored
    // instance if the array is sized down
    property Capacity: integer read GetCapacity write SetCapacity;
    /// the compare function to be used for Sort and Find methods
    // - by default, no comparison function is set
    // - common functions exist for base types: e.g. SortDynArrayByte, SortDynArrayBoolean,
    // SortDynArrayWord, SortDynArrayInteger, SortDynArrayCardinal, SortDynArraySingle,
    // SortDynArrayInt64, SortDynArrayDouble, SortDynArrayAnsiString,
    // SortDynArrayAnsiStringI, SortDynArrayString, SortDynArrayStringI,
    // SortDynArrayUnicodeString, SortDynArrayUnicodeStringI
    property Compare: TDynArraySortCompare read fCompare write SetCompare;
    /// must be TRUE if the array is currently in sorted order according to
    // the compare function
    // - Add/Delete/Insert/Load* methods will reset this property to false
    // - Sort method will set this property to true
    // - you MUST set this property to false if you modify the dynamic array
    // content in your code, so that Find() won't try to wrongly use binary
    // search in an unsorted array, and miss its purpose
    property Sorted: boolean read fSorted write fSorted;
    /// low-level direct access to the storage variable
    property Value: PPointer read fValue;
    /// the known type, possibly retrieved from dynamic array RTTI
    property KnownType: TDynArrayKind read fKnownType;
    /// the known RTTI information of the whole array
    property ArrayType: pointer read fTypeInfo;
    /// the known type name of the whole array, as RawUTF8
    property ArrayTypeName: RawUTF8 read GetArrayTypeName;
    /// the known type name of the whole array, as PShortString
    property ArrayTypeShort: PShortString read GetArrayTypeShort;
    /// the internal in-memory size of one element, as retrieved from RTTI
    property ElemSize: cardinal read fElemSize;
    /// the internal type information of one element, as retrieved from RTTI
    property ElemType: pointer read fElemType;
    /// if this dynamic aray is a T*ObjArray
    property IsObjArray: boolean read GetIsObjArray write SetIsObjArray;
  end;
  /// a pointer to a TDynArray wrapper instance
  PDynArray = ^TDynArray;

  /// allows to iterate over a TDynArray.SaveTo binary buffer
  // - may be used as alternative to TDynArray.LoadFrom, if you don't want
  // to allocate all items at once, but retrieve items one by one
  {$ifdef FPC_OR_UNICODE}TDynArrayLoadFrom = record private
  {$else}TDynArrayLoadFrom = object protected{$endif}
    DynArray: TDynArray; // used to access RTTI
    Hash: PCardinalArray;
  public
    /// how many items were saved in the TDynArray.SaveTo binary buffer
    Count: integer;
    /// the zero-based index of the current item pointed by next Step() call
    // - is in range 0..Count-1 until Step() returns false
    Current: integer;
    /// current position in the TDynArray.SaveTo binary buffer
    // - after Step() returned false, points just after the binary buffer,
    // like a regular TDynArray.LoadFrom
    Position: PAnsiChar;
    /// initialize iteration over a TDynArray.SaveTo binary buffer
    // - returns true on success, with Count and Position being set
    // - returns false if the supplied binary buffer is not correct
    function Init(ArrayTypeInfo: pointer; Source: PAnsiChar): boolean;
    /// iterate over the current stored item
    // - Elem should point to a variable of the exact item type stored in this
    // dynamic array
    // - returns true if Elem was filled with one value, or false if all
    // items were read, and Position contains the end of the binary buffer
    function Step(out Elem): boolean;
    /// extract the first field value of the current stored item
    // - returns true if Field was filled with one value, or false if all
    // items were read, and Position contains the end of the binary buffer
    // - could be called before Step(), to pre-allocate a new item instance,
    // or update an existing instance
    function FirstField(out Field): boolean;
    /// after all items are read by Step(), validate the stored hash
    // - returns true if items hash is correct, false otherwise
    function CheckHash: boolean;
  end;

  /// function prototype to be used for hashing of a dynamic array element
  // - this function must use the supplied hasher on the Elem data
  TDynArrayHashOne = function(const Elem; Hasher: THasher): cardinal;

  /// event handler to be used for hashing of a dynamic array element
  // - can be set as an alternative to TDynArrayHashOne
  TEventDynArrayHashOne = function(const Elem): cardinal of object;

  /// internal structure used to store one item hash
  // - used e.g. by TDynArrayHashed or TObjectHash via TSynHashDynArray
  TSynHash = record
    /// unsigned integer hash of the item
    Hash: cardinal;
    /// index of the item in the main storage array
    Index: cardinal;
  end;

  /// internal structure used to store hashs of items
  // - used e.g. by TDynArrayHashed or TObjectHash
  TSynHashDynArray = array of TSynHash;

  {.$define DYNARRAYHASHCOLLISIONCOUNT}

  /// used to access any dynamic arrray elements using fast hash
  // - by default, binary sort could be used for searching items for TDynArray:
  // using a hash is faster on huge arrays for implementing a dictionary
  // - in this current implementation, modification (update or delete) of an
  // element is not handled yet: you should rehash all content - only
  // TDynArrayHashed.FindHashedForAdding / FindHashedAndUpdate /
  // FindHashedAndDelete will refresh the internal hash
  // - this object extends the TDynArray type, since presence of Hashs[] dynamic
  // array will increase code size if using TDynArrayHashed instead of TDynArray
  // - in order to have the better performance, you should use an external Count
  // variable, AND set the Capacity property to the expected maximum count (this
  // will avoid most ReHash calls for FindHashedForAdding+FindHashedAndUpdate)
  {$ifdef UNDIRECTDYNARRAY}
  TDynArrayHashed = record
  // pseudo inheritance for most used methods
  private
    function GetCount: Integer;                 inline;
    procedure SetCount(aCount: integer);        inline;
    procedure SetCapacity(aCapacity: Integer);  inline;
    function GetCapacity: Integer;              inline;
  public
    InternalDynArray: TDynArray;
    function Value: PPointer;           inline;
    function ElemSize: PtrUInt;         inline;
    function ElemType: Pointer;         inline;
    function KnownType: TDynArrayKind;  inline;
    procedure Clear;                    inline;
    procedure ElemCopy(const A; var B); inline;
    function ElemPtr(index: PtrInt): pointer; inline;
    procedure ElemCopyAt(index: PtrInt; var Dest); inline;
    // warning: you shall call ReHash() after manual Add/Delete
    function Add(const Elem): integer;  inline;
    procedure Delete(aIndex: PtrInt);  inline;
    function SaveTo: RawByteString; overload; inline;
    function SaveTo(Dest: PAnsiChar): PAnsiChar; overload; inline;
    function SaveToJSON(EnumSetsAsText: boolean=false;
      reformat: TTextWriterJSONFormat=jsonCompact): RawUTF8; inline;
    procedure Sort(aCompare: TDynArraySortCompare=nil); inline;
    function LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil): PUTF8Char; inline;
    function SaveToLength: integer; inline;
    function LoadFrom(Source: PAnsiChar): PAnsiChar;  inline;
    property Count: integer read GetCount write SetCount;
    property Capacity: integer read GetCapacity write SetCapacity;
  private
  {$else UNDIRECTDYNARRAY}
  TDynArrayHashed = object(TDynArray)
  protected
  {$endif UNDIRECTDYNARRAY}
    fHashElement: TDynArrayHashOne;
    fHasher: THasher;
    fHashs: TSynHashDynArray;
    fHashsCount: integer;
    fEventCompare: TEventDynArraySortCompare;
    fEventHash: TEventDynArrayHashOne;
    fHashCountTrigger: integer;
    fHashFindCount: integer;
    {$ifdef DYNARRAYHASHCOLLISIONCOUNT}
    fHashFindCollisions: cardinal;
    {$endif}
    procedure HashAdd(const Elem; aHashCode: Cardinal; var result: integer);
    /// low-level search of an element from its pre-computed hash
    // - if not found and aForAdd=true, returns -(indexofvoidfHashs[]+1)
    // - this overloaded method will return the first matching item: use the
    // HashFindAndCompare(...; const Elem) method to avoid any collision issue
    // - you should NOT use this method, but rather high-level FindHashed*()
    function HashFind(aHashCode: cardinal; aForAdd: boolean): integer;
    /// low-level search of an element from its pre-computed hash
    // - search for the hash, then use fEventCompare/fCompare/ElemEquals
    // - if not found, returns -(indexofvoidfHashs[]+1)
    // - you should NOT use this method, but rather high-level FindHashed*()
    function HashFindAndCompare(aHashCode: cardinal; const Elem): integer;
    function GetHashFromIndex(aIndex: PtrInt): Cardinal;
    procedure HashInvalidate;
    procedure RaiseFatalCollision(const caller: RawUTF8; aHashCode: cardinal);
  public
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts some hash-dedicated parameters: aHashElement to
    // set how to hash each element, aCompare to handle hash collision
    // - if no aHashElement is supplied, it will hash according to the RTTI, i.e.
    // strings or binary types, and the first field for records (strings included)
    // - if no aCompare is supplied, it will use default Equals() method
    // - if no THasher function is supplied, it will use the one supplied in
    // DefaultHasher global variable, set to crc32c() by default - using
    // SSE4.2 instruction if available
    // - if CaseInsensitive is set to TRUE, it will ignore difference in 7 bit
    // alphabetic characters (e.g. compare 'a' and 'A' as equal)
    procedure Init(aTypeInfo: pointer; var aValue;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// initialize the wrapper with a one-dimension dynamic array
    // - this version accepts to specify how both hashing and comparison should
    // occur, setting the TDynArrayKind kind of first/hashed field
    // - djNone and djCustom are too vague, and will raise an exception
    // - no RTTI check is made over the corresponding array layout: you shall
    // ensure that aKind matches the dynamic array element definition
    // - aCaseInsensitive will be used for djRawUTF8..djHash512 text comparison
    procedure InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
      aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
    /// will compute all hash from the current elements of the dynamic array
    // - is called within the TDynArrayHashed.Init method to initialize the
    // internal hash array
    // - can be called on purpose, when modifications have been performed on
    // the dynamic array content (e.g. in case of element deletion or update,
    // or after calling LoadFrom/Clear method) - this is not necessary after
    // FindHashedForAdding / FindHashedAndUpdate / FindHashedAndDelete methods
    function ReHash(forAdd: boolean=false): boolean;
    /// low-level function which would inspect the internal fHashs[] array for
    // any collision
    // - is a brute force search within fHashs[].Hash values, which may be handy
    // to validate the current HashElement() function
    // - returns -1 if no collision was found, or the index of the first collision
    function IsHashElementWithoutCollision: integer;
    /// search for an element value inside the dynamic array using hashing
    // - ELem should be of the same exact type than the dynamic array, or at
    // least matchs the fields used by both the hash function and Equals method:
    // e.g. if the searched/hashed field in a record is a string as first field,
    // you may use a string variable as Elem: other fields will be ignored
    // - returns -1 if not found, or the index in the dynamic array if found
    // - optional aHashCode parameter can be supplied with an already hashed
    // value of the item, to be used e.g. after a call to HashFind() - default
    // 0 will use fHashElement(Elem,fHasher)
    function FindHashed(const Elem; aHashCode: cardinal=0): integer;
    /// search for an element value inside the dynamic array using hashing, and
    // fill Elem with the found content
    // - return the index found (0..Count-1), or -1 if Elem was not found
    // - warning: Elem must be of the same exact type than the dynamic array,
    // and must be a reference to a variable (you can't write Find(i+10) e.g.)
    function FindHashedAndFill(var ElemToFill): integer;
    /// search for an element value inside the dynamic array using hashing, and
    // add a void entry to the array if was not found
    // - this method will use hashing for fast retrieval
    // - Elem should be of the same exact type than the dynamic array, or at
    // least matchs the fields used by both the hash function and Equals method:
    // e.g. if the searched/hashed field in a record is a string as first field,
    // you may use a string variable as Elem: other fields will be ignored
    // - returns either the index in the dynamic array if found (and set wasAdded
    // to false), either the newly created index in the dynamic array (and set
    // wasAdded to true)
    // - for faster process (avoid ReHash), please set the Capacity property
    // - warning: in contrast to the Add() method, if an entry is added to the
    // array (wasAdded=true), the entry is left VOID: you must set the field
    // content to expecting value - in short, Elem is used only for searching,
    // not copied to the newly created entry in the array
    // - optional aHashCode parameter can be supplied with an already hashed
    // value of the item, to be used e.g. after a call to HashFind() - default
    // 0 will use fHashElement(Elem,fHasher)
    function FindHashedForAdding(const Elem; out wasAdded: boolean;
      aHashCode: cardinal=0): integer;
    /// ensure a given element name is unique, then add it to the array
    // - expected element layout is to have a RawUTF8 field at first position
    // - the aName is searched (using hashing) to be unique, and if not the case,
    // an ESynException.CreateUTF8() is raised with the supplied arguments
    // - use internaly FindHashedForAdding method
    // - this version will set the field content with the unique value
    // - returns a pointer to the newly added element (to set other fields)
    function AddUniqueName(const aName: RawUTF8;
      const ExceptionMsg: RawUTF8; const ExceptionArgs: array of const): pointer;
    /// search for a given element name, make it unique, and add it to the array
    // - expected element layout is to have a RawUTF8 field at first position
    // - the aName is searched (using hashing) to be unique, and if not the case,
    // some suffix is added to make it unique
    // - use internaly FindHashedForAdding method
    // - this version will set the field content with the unique value
    // - returns a pointer to the newly added element (to set other fields)
    function AddAndMakeUniqueName(aName: RawUTF8): pointer;
    /// search for an element value inside the dynamic array using hashing, then
    // update any matching item, or add the item if none matched
    // - if AddIfNotExisting is FALSE, returns the index found (0..Count-1),
    // or -1 if Elem was not found - update will force slow rehash all content
    // - if AddIfNotExisting is TRUE, returns the index found (0..Count-1),
    // or the index newly created/added is the Elem value was not matching -
    // add won't rehash all content - for even faster process (avoid ReHash),
    // please set the Capacity property
    // - warning: Elem must be of the same exact type than the dynamic array, and
    // must refer to a variable (you can't write FindHashedAndUpdate(i+10) e.g.)
    function FindHashedAndUpdate(const Elem; AddIfNotExisting: boolean): integer;
    /// search for an element value inside the dynamic array using hashing, and
    // delete it if matchs
    // - return the index deleted (0..Count-1), or -1 if Elem was not found
    // - this will rehash all content: this method could be slow in the current
    // implementation
    // - warning: Elem must be of the same exact type than the dynamic array, and
    // must refer to a variable (you can't write FindHashedAndDelete(i+10) e.g.)
    function FindHashedAndDelete(const Elem): integer;
    /// will search for an element value inside the dynamic array without hashing
    // - is used internally when Count < HashCountTrigger
    // - is preferred to Find(), since EventCompare would be used if defined
    // - Elem should be of the same exact type than the dynamic array, or at
    // least matchs the fields used by both the hash function and Equals method:
    // e.g. if the searched/hashed field in a record is a string as first field,
    // you may use a string variable as Elem: other fields will be ignored
    // - returns -1 if not found, or the index in the dynamic array if found
    function Scan(const Elem): integer;
    /// retrieve the hash value of a given item, from its index
    property Hash[aIndex: PtrInt]: Cardinal read GetHashFromIndex;
    /// alternative event-oriented Compare function to be used for Sort and Find
    // - will be used instead of Compare, to allow object-oriented callbacks
    property EventCompare: TEventDynArraySortCompare read fEventCompare write fEventCompare;
    /// custom hash function to be used for hashing of a dynamic array element
    property HashElement: TDynArrayHashOne read fHashElement;
    /// alternative event-oriented Hash function for ReHash
    // - this object-oriented callback will be used instead of HashElement
    // on each dynamic array entries - HashElement will still be used on
    // const Elem values, since they may be just a sub part of the stored entry
    property EventHash: TEventDynArrayHashOne read fEventHash write fEventHash;
    /// after how many items the hashing take place
    // - for smallest arrays, O(n) seach if faster than O(1) hashing, since
    // maintaining the fHashs[] lookup has some CPU and memory costs
    // - equals 32 by default
    property HashCountTrigger: integer read fHashCountTrigger write fHashCountTrigger;
    {$ifdef DYNARRAYHASHCOLLISIONCOUNT}
    /// access to the internal collision of HashFind()
    // - it won't depend only on the HashElement(), but also on the internal
    // hash bucket size (which is much lower than 2^32 items)
    property HashFindCollisions: cardinal read fHashFindCollisions write fHashFindCollisions;
    {$endif}
  end;


  /// defines a wrapper interface around a dynamic array of TObject
  // - implemented by TObjectDynArrayWrapper for instance
  // - i.e. most common methods are available to work with a dynamic array
  // - warning: the IObjectDynArray MUST be defined in the stack, class or
  // record BEFORE the dynamic array it is wrapping, otherwise you may leak
  // memory - see for instance TSQLRestServer class:
  // ! fSessionAuthentications: IObjectDynArray; // defined before the array
  // ! fSessionAuthentication: TSQLRestServerAuthenticationDynArray;
  // note that allocation time as variable on the local stack may depend on the
  // compiler, and its optimization
  IObjectDynArray = interface
    ['{A0D50BD0-0D20-4552-B365-1D63393511FC}']
    /// search one element within the TObject instances
    function Find(Instance: TObject): integer;
    /// add one element to the dynamic array of TObject instances
    // - once added, the Instance will be owned by this TObjectDynArray instance
    function Add(Instance: TObject): integer;
    /// delete one element from the TObject dynamic array
    // - deleted TObject instance will be freed as expected
    procedure Delete(Index: integer);
    /// sort the dynamic array content according to a specified comparer
    procedure Sort(Compare: TDynArraySortCompare);
    /// delete all TObject instances, and release the memory
    // - is not to be called for most use, thanks to reference-counting memory
    // handling, but can be handy for quick release
    procedure Clear;
    /// ensure the internal list capacity is set to the current Count
    // - may be used to publish the associated dynamic array with the expected
    // final size, once IObjectDynArray is out of scope
    procedure Slice;
    /// returns the number of TObject instances available
    // - note that the length of the associated dynamic array is used to store
    // the capacity of the list, so won't probably never match with this value
    function Count: integer;
    /// returns the internal array capacity of TObject instances available
    // - which is in fact the length() of the associated dynamic array
    function Capacity: integer;
  end;

  /// a wrapper to own a dynamic array of TObject
  // - this version behave list a TObjectList (i.e. owning the class instances)
  // - but the dynamic array is NOT owned by the instance
  // - will define an internal Count property, using the dynamic array length
  // as capacity: adding and deleting will be much faster
  // - implements IObjectDynArray, so that most common methods are available
  // to work with the dynamic array
  // - does not need any sub-classing of generic overhead to work, and will be
  // reference counted
  // - warning: the IObjectDynArray MUST be defined in the stack, class or
  // record BEFORE the dynamic array it is wrapping, otherwise you may leak
  // memory, and TObjectDynArrayWrapper.Destroy will raise an ESynException
  // - a sample usage may be:
  // !var DA: IObjectDynArray; // defined BEFORE the dynamic array itself
  // !    A: array of TMyObject;
  // !    i: integer;
  // !begin
  // !  DA := TObjectDynArrayWrapper.Create(A);
  // !  DA.Add(TMyObject.Create('one'));
  // !  DA.Add(TMyObject.Create('two'));
  // !  DA.Delete(0);
  // !  assert(DA.Count=1);
  // !  assert(A[0].Name='two');
  // !  DA.Clear;
  // !  assert(DA.Count=0);
  // !  DA.Add(TMyObject.Create('new'));
  // !  assert(DA.Count=1);
  // !end; // will auto-release DA (no need of try..finally DA.Free)
  TObjectDynArrayWrapper = class(TInterfacedObject, IObjectDynArray)
  protected
    fValue: PPointer;
    fCount: integer;
    fOwnObjects: boolean;
  public
    /// initialize the wrapper with a one-dimension dynamic array of TObject
    // - by default, objects will be owned by this class, but you may set
    // aOwnObjects=false if you expect the dynamic array to remain available
    constructor Create(var aValue; aOwnObjects: boolean=true);
    /// will release all associated TObject instances
    destructor Destroy; override;
    /// search one element within the TObject instances
    function Find(Instance: TObject): integer;
    /// add one element to the dynamic array of TObject instances
    // - once added, the Instance will be owned by this TObjectDynArray instance
    // (unless aOwnObjects was false in Create)
    function Add(Instance: TObject): integer;
    /// delete one element from the TObject dynamic array
    // - deleted TObject instance will be freed as expected (unless aOwnObjects
    // was defined as false in Create)
    procedure Delete(Index: integer);
    /// sort the dynamic array content according to a specified comparer
    procedure Sort(Compare: TDynArraySortCompare);
    /// delete all TObject instances, and release the memory
    // - is not to be called for most use, thanks to reference-counting memory
    // handling, but can be handy for quick release
    // - warning: won't release the instances if aOwnObjects was false in Create
    procedure Clear;
    /// ensure the internal list capacity is set to the current Count
    // - may be used to publish the associated dynamic array with the expected
    // final size, once IObjectDynArray is out of scope
    procedure Slice;
    /// returns the number of TObject instances available
    // - note that the length() of the associated dynamic array is used to store
    // the capacity of the list, so won't probably never match with this value
    function Count: integer;
    /// returns the internal array capacity of TObject instances available
    // - which is in fact the length() of the associated dynamic array
    function Capacity: integer;
  end;

  /// abstract class able to use hashing to find an object in O(1) speed
  // - all protected abstract methods shall be overridden and implemented
  // - use this class instead of a plain TDynArrayHashed, since it would
  // feature its own dedicated hashing, and any abstract mean of value storage
  TObjectHash = class
  protected
    fHashs: TSynHashDynArray;
    procedure HashInit(aCountToHash: integer);
    function HashFind(aHashCode: cardinal; Item: TObject): integer;
    /// abstract method to hash an item
    // - note that the overridden method shall not return 0 (mark void fHashs[])
    function Hash(Item: TObject): cardinal; virtual; abstract;
    /// abstract method to compare two items
    function Compare(Item1,Item2: TObject): boolean; virtual; abstract;
    /// abstract method to get an item
    // - shall return nil if Index is out of range (e.g. >= Count)
    // - will be called e.g. by Find() with Compare() to avoid collision
    function Get(Index: integer): TObject; virtual; abstract;
    /// used to retrieve the number of items
    function Count: integer; virtual; abstract;
  public
    /// search one item in the internal hash array
    function Find(Item: TObject): integer;
    /// search one item using slow list browsing
    // - this version expects the internal list count to be supplied, if some
    // last items are to be ignored (used e.g. in EnsureJustAddedNotDuplicated)
    function Scan(Item: TObject; ListCount: integer): integer; virtual;
    /// to be called when an item is modified
    // - for Delete/Update will force a full rehash on next Find() call
    procedure Invalidate;
    /// to be called when an item has just been added
    // - the index of the latest added item should be Count-1
    // - this method will update the internal hash table, and check if
    // the newly added value is not duplicated
    // - return FALSE if this item is already existing (i.e. insert error)
    // - return TRUE if has been added to the internal hash table
    function EnsureJustAddedNotDuplicated: boolean;
  end;

  /// abstract parent class with a virtual constructor, ready to be overridden
  // to initialize the instance
  // - you can specify such a class if you need an object including published
  // properties (like TPersistent) with a virtual constructor (e.g. to
  // initialize some nested class properties)
  TPersistentWithCustomCreate = class(TPersistent)
  public
    /// this virtual constructor will be called at instance creation
    // - this constructor does nothing, but is declared as virtual so that
    // inherited classes may safely override this default void implementation
    constructor Create; virtual;
  end;

  {$M+}
  /// abstract parent class with threadsafe implementation of IInterface and
  // a virtual constructor
  // - you can specify e.g. such a class to TSQLRestServer.ServiceRegister() if
  // you need an interfaced object with a virtual constructor, ready to be
  // overridden to initialize the instance
  TInterfacedObjectWithCustomCreate = class(TInterfacedObject)
  public
    /// this virtual constructor will be called at instance creation
    // - this constructor does nothing, but is declared as virtual so that
    // inherited classes may safely override this default void implementation
    constructor Create; virtual;
    /// used to mimic TInterfacedObject reference counting
    // - Release=true will call TInterfacedObject._Release
    // - Release=false will call TInterfacedObject._AddRef
    // - could be used to emulate proper reference counting of the instance
    // via interfaces variables, but still storing plain class instances
    // (e.g. in a global list of instances)
    procedure RefCountUpdate(Release: boolean); virtual;
  end;

  /// our own empowered TPersistent-like parent class
  // - TPersistent has an unexpected speed overhead due a giant lock introduced
  // to manage property name fixup resolution (which we won't use outside the VCL)
  // - this class has a virtual constructor, so is a preferred alternative
  // to both TPersistent and TPersistentWithCustomCreate classes
  // - for best performance, any type inheriting from this class will bypass
  // some regular steps: do not implement interfaces or use TMonitor with them!
  TSynPersistent = class(TObject)
  protected
    // this default implementation will call AssignError()
    procedure AssignTo(Dest: TSynPersistent); virtual;
    procedure AssignError(Source: TSynPersistent);
  public
    /// this virtual constructor will be called at instance creation
    // - this constructor does nothing, but is declared as virtual so that
    // inherited classes may safely override this default void implementation
    constructor Create; virtual;
    /// allows to implement a TPersistent-like assignement mechanism
    // - inherited class should override AssignTo() protected method
    // to implement the proper assignment
    procedure Assign(Source: TSynPersistent); virtual;
    /// optimized x86 asm initialization code
    // - warning: this optimized version won't initialize the vmtIntfTable
    // for this class hierarchy: as a result, you would NOT be able to
    // implement an interface with a TSynPersistent descendent (but you should
    // not need to, but inherit from TInterfacedObject)
    // - warning: under FPC, it won't initialize fields management operators
    class function NewInstance: TObject; override;
    {$ifndef FPC_OR_PUREPASCAL}
    /// optimized x86 asm finalization code
    // - warning: this version won't release either any allocated TMonitor
    // (as available since Delphi 2009) - do not use TMonitor with
    // TSynPersistent, but rather the faster TSynPersistentLock class
    procedure FreeInstance; override;
    {$endif}
  end;
  {$M-}

  /// allow to add cross-platform locking methods to any class instance
  // - typical use is to define a Safe: TSynLocker property, call Safe.Init
  // and Safe.Done in constructor/destructor methods, and use Safe.Lock/UnLock
  // methods in a try ... finally section
  // - in respect to the TCriticalSection class, fix a potential CPU cache line
  // conflict which may degrade the multi-threading performance, as reported by
  // @http://www.delphitools.info/2011/11/30/fixing-tcriticalsection
  // - internal padding is used to safely store up to 7 values protected
  // from concurrent access with a mutex
  // - for object-level locking, see TSynPersistentLock which owns one such
  // instance, or call low-level NewSynLocker function then DoneAndFreemem
  {$ifdef FPC_OR_UNICODE}TSynLocker = record private
  {$else}TSynLocker = object protected{$endif}
    fSection: TRTLCriticalSection;
    fSectionPadding: PtrInt; // paranoid to avoid FUTEX_WAKE_PRIVATE=EAGAIN
    fLocked, fInitialized: boolean;
    {$ifndef NOVARIANTS}
    function GetVariant(Index: integer): Variant;
    procedure SetVariant(Index: integer; const Value: Variant);
    function GetInt64(Index: integer): Int64;
    procedure SetInt64(Index: integer; const Value: Int64);
    function GetBool(Index: integer): boolean;
    procedure SetBool(Index: integer; const Value: boolean);
    function GetUnlockedInt64(Index: integer): Int64;
    procedure SetUnlockedInt64(Index: integer; const Value: Int64);
    function GetPointer(Index: integer): Pointer;
    procedure SetPointer(Index: integer; const Value: Pointer);
    function GetUTF8(Index: integer): RawUTF8;
    procedure SetUTF8(Index: integer; const Value: RawUTF8);
    {$endif}
  public
    /// internal padding data, also used to store up to 7 variant values
    // - this memory buffer will ensure no CPU cache line mixup occurs
    // - you should not use this field directly, but rather the Locked[],
    // LockedInt64[], LockedUTF8[] or LockedPointer[] methods
    // - if you want to access those array values, ensure you protect them
    // using a Safe.Lock; try ... Padding[n] ... finally Safe.Unlock structure,
    // and maintain the PaddingMaxUsedIndex field accurately
    Padding: array[0..6] of TVarData;
    /// maximum index of the last value stored in the internal Padding[] array
    // - equals -1 if no value is actually stored, or a 0..6 number otherwise
    // - you should not have to use this field, but for optimized low-level
    // direct access to Padding[] values, within a Lock/UnLock safe block
    PaddingMaxUsedIndex: integer;
    /// initialize the mutex
    // - calling this method is mandatory (e.g. in the class constructor owning
    // the TSynLocker instance), otherwise you may encounter unexpected
    // behavior, like access violations or memory leaks
    procedure Init;
    /// finalize the mutex
    // - calling this method is mandatory (e.g. in the class destructor owning
    // the TSynLocker instance), otherwise you may encounter unexpected
    // behavior, like access violations or memory leaks
    procedure Done;
    /// finalize the mutex, and call FreeMem() on the pointer of this instance
    // - should have been initiazed with a NewSynLocker call
    procedure DoneAndFreeMem;
    /// lock the instance for exclusive access
    // - use as such to avoid race condition (from a Safe: TSynLocker property):
    // ! Safe.Lock;
    // ! try
    // !   ...
    // ! finally
    // !   Safe.Unlock;
    // ! end;
    procedure Lock; {$ifdef HASINLINE}inline;{$endif}
    /// will try to acquire the mutex
    // - use as such to avoid race condition (from a Safe: TSynLocker property):
    // ! if Safe.TryLock then
    // !   try
    // !     ...
    // !   finally
    // !     Safe.Unlock;
    // !   end;
    function TryLock: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// will try to acquire the mutex for a given time
    // - use as such to avoid race condition (from a Safe: TSynLocker property):
    // ! if Safe.TryLockMS(100) then
    // !   try
    // !     ...
    // !   finally
    // !     Safe.Unlock;
    // !   end;
    function TryLockMS(retryms: integer): boolean;
    /// release the instance for exclusive access
    procedure UnLock; {$ifdef HASINLINE}inline;{$endif}
    /// will enter the mutex until the IUnknown reference is released
    // - could be used as such under Delphi:
    // !begin
    // !  ... // unsafe code
    // !  Safe.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // local hidden IUnknown will release the lock for the method
    // - warning: under FPC, you should assign its result to a local variable -
    // see bug http://bugs.freepascal.org/view.php?id=26602
    // !var LockFPC: IUnknown;
    // !begin
    // !  ... // unsafe code
    // !  LockFPC := Safe.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // LockFPC will release the lock for the method
    // or
    // !begin
    // !  ... // unsafe code
    // !  with Safe.ProtectMethod do begin
    // !    ... // thread-safe code
    // !  end; // local hidden IUnknown will release the lock for the method
    // !end;
    function ProtectMethod: IUnknown;
    /// returns true if the mutex is currently locked by another thread
    property IsLocked: boolean read fLocked;
    /// returns true if the Init method has been called for this mutex
    // - is only relevant if the whole object has been previously filled with 0,
    // i.e. as part of a class, but may not be accurate when allocated on stack
    property IsInitialized: boolean read fInitialized;
    {$ifndef NOVARIANTS}
    /// safe locked access to a Variant value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // LockedBool, LockedInt64, LockedPointer and LockedUTF8 array properties
    // - returns null if the Index is out of range
    property Locked[Index: integer]: Variant read GetVariant write SetVariant;
    /// safe locked access to a Int64 value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - Int64s will be stored internally as a varInt64 variant
    // - returns nil if the Index is out of range, or does not store a Int64
    property LockedInt64[Index: integer]: Int64 read GetInt64 write SetInt64;
    /// safe locked access to a boolean value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked, LockedInt64, LockedPointer and LockedUTF8 array properties
    // - value will be stored internally as a varBoolean variant
    // - returns nil if the Index is out of range, or does not store a boolean
    property LockedBool[Index: integer]: boolean read GetBool write SetBool;
    /// safe locked access to a pointer/TObject value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked, LockedBool, LockedInt64 and LockedUTF8 array properties
    // - pointers will be stored internally as a varUnknown variant
    // - returns nil if the Index is out of range, or does not store a pointer
    property LockedPointer[Index: integer]: Pointer read GetPointer write SetPointer;
    /// safe locked access to an UTF-8 string value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedPointer array properties
    // - UTF-8 string will be stored internally as a varString variant
    // - returns '' if the Index is out of range, or does not store a string
    property LockedUTF8[Index: integer]: RawUTF8 read GetUTF8 write SetUTF8;
    /// safe locked in-place increment to an Int64 value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - Int64s will be stored internally as a varInt64 variant
    // - returns the newly stored value
    // - if the internal value is not defined yet, would use 0 as default value
    function LockedInt64Increment(Index: integer; const Increment: Int64): Int64;
    /// safe locked in-place exchange of a Variant value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - returns the previous stored value, or null if the Index is out of range
    function LockedExchange(Index: integer; const Value: variant): variant;
    /// safe locked in-place exchange of a pointer/TObject value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - pointers will be stored internally as a varUnknown variant
    // - returns the previous stored value, nil if the Index is out of range,
    // or does not store a pointer
    function LockedPointerExchange(Index: integer; Value: pointer): pointer;
    /// unsafe access to a Int64 value
    // - you may store up to 7 variables, using an 0..6 index, shared with
    // Locked and LockedUTF8 array properties
    // - Int64s will be stored internally as a varInt64 variant
    // - returns nil if the Index is out of range, or does not store a Int64
    // - you should rather call LockedInt64[] property, or use this property
    // with a Lock; try ... finally UnLock block
    property UnlockedInt64[Index: integer]: Int64 read GetUnlockedInt64 write SetUnlockedInt64;
    {$endif NOVARIANTS}
  end;
  PSynLocker = ^TSynLocker;

  /// adding locking methods to a TSynPersistent with virtual constructor
  // - you may use this class instead of the RTL TCriticalSection, since it
  // would use a TSynLocker which does not suffer from CPU cache line conflit
  TSynPersistentLock = class(TSynPersistent)
  protected
    fSafe: PSynLocker; // TSynLocker would increase inherited fields offset
  public
    /// initialize the instance, and its associated lock
    constructor Create; override;
    /// finalize the instance, and its associated lock
    destructor Destroy; override;
    /// access to the associated instance critical section
    // - call Safe.Lock/UnLock to protect multi-thread access on this storage
    property Safe: PSynLocker read fSafe;
  end;

  /// used for backward compatibility only with existing code
  TSynPersistentLocked = class(TSynPersistentLock);

  /// adding locking methods to a TInterfacedObject with virtual constructor
  TInterfacedObjectLocked = class(TInterfacedObjectWithCustomCreate)
  protected
    fSafe: PSynLocker; // TSynLocker would increase inherited fields offset
  public
    /// initialize the object instance, and its associated lock
    constructor Create; override;
    /// release the instance (including the locking resource)
    destructor Destroy; override;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: PSynLocker read fSafe;
  end;

  /// used to determine the exact class type of a TInterfacedObjectWithCustomCreate
  // - could be used to create instances using its virtual constructor
  TInterfacedObjectWithCustomCreateClass = class of TInterfacedObjectWithCustomCreate;

  /// used to determine the exact class type of a TPersistentWithCustomCreateClass
  // - could be used to create instances using its virtual constructor
  TPersistentWithCustomCreateClass = class of TPersistentWithCustomCreate;

  /// used to determine the exact class type of a TSynPersistent
  // - could be used to create instances using its virtual constructor
  TSynPersistentClass = class of TSynPersistent;


  /// used to store one list of hashed RawUTF8 in TRawUTF8Interning pool
  {$ifdef FPC_OR_UNICODE}TRawUTF8InterningSlot = record{$else}TRawUTF8InterningSlot = object{$endif}
  public
    /// actual RawUTF8 storage
    Value: TRawUTF8DynArray;
    /// hashed access to the Value[] list
    Values: TDynArrayHashed;
    /// associated mutex for thread-safe process
    Safe: TSynLocker;
    /// initialize the RawUTF8 slot (and its Safe mutex)
    procedure Init;
    /// finalize the RawUTF8 slot
    procedure Done;
    /// returns the interned RawUTF8 value
    procedure Unique(var aResult: RawUTF8; const aText: RawUTF8; aTextHash: cardinal);
    /// ensure the supplied RawUTF8 value is interned
    procedure UniqueText(var aText: RawUTF8; aTextHash: cardinal);
    /// delete all stored RawUTF8 values
    procedure Clear;
    /// reclaim any unique RawUTF8 values
    function Clean(aMaxRefCount: integer): integer;
    /// how many items are currently stored in Value[]
    function Count: integer;
  end;

  /// allow to store only one copy of distinct RawUTF8 values
  // - thanks to the Copy-On-Write feature of string variables, this may
  // reduce a lot the memory overhead of duplicated text content
  // - this class is thread-safe and optimized for performance
  TRawUTF8Interning = class(TSynPersistent)
  protected
    fPool: array of TRawUTF8InterningSlot;
    fPoolLast: integer;
  public
    /// initialize the storage and its internal hash pools
    // - aHashTables is the pool size, and should be a power of two <= 512
    constructor Create(aHashTables: integer=4); reintroduce;
    /// finalize the storage
    destructor Destroy; override;
    /// return a RawUTF8 variable stored within this class
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    function Unique(const aText: RawUTF8): RawUTF8; overload;
    /// return a RawUTF8 variable stored within this class from a text buffer
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    function Unique(aText: PUTF8Char; aTextLen: integer): RawUTF8; overload;
    /// return a RawUTF8 variable stored within this class
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    procedure Unique(var aResult: RawUTF8; const aText: RawUTF8); overload;
    /// return a RawUTF8 variable stored within this class from a text buffer
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, return the shared
    // instance (with its reference counter increased), to reduce memory usage
    procedure Unique(var aResult: RawUTF8; aText: PUTF8Char; aTextLen: integer); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// ensure a RawUTF8 variable is stored within this class
    // - if aText occurs for the first time, add it to the internal string pool
    // - if aText does exist in the internal string pool, set the shared
    // instance (with its reference counter increased), to reduce memory usage
    procedure UniqueText(var aText: RawUTF8);
    {$ifndef NOVARIANTS}
    /// return a variant containing a RawUTF8 stored within this class
    // - similar to RawUTF8ToVariant(), but with string interning
    procedure UniqueVariant(var aResult: variant; const aText: RawUTF8); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// return a variant containing a RawUTF8 stored within this class
    // - similar to RawUTF8ToVariant(StringToUTF8()), but with string interning
    // - this method expects the text to be supplied as a VCL string, which will
    // be converted into a variant containing a RawUTF8 varString instance
    procedure UniqueVariantString(var aResult: variant; const aText: string);
    /// return a variant, may be containing a RawUTF8 stored within this class
    // - similar to TextToVariant(), but with string interning
    // - first try with GetNumericVariantFromJSON(), then fallback to
    // RawUTF8ToVariant() with string variable interning
    procedure UniqueVariant(var aResult: variant; aText: PUTF8Char; aTextLen: integer;
      aAllowVarDouble: boolean=false); overload;
    /// ensure a variant contains only RawUTF8 stored within this class
    // - supplied variant should be a varString containing a RawUTF8 value
    procedure UniqueVariant(var aResult: variant); overload; {$ifdef HASINLINE}inline;{$endif}
    {$endif NOVARIANTS}
    /// delete any previous storage pool
    procedure Clear;
    /// reclaim any unique RawUTF8 values
    // - i.e. run a garbage collection process of all values with RefCount=1
    // by default, i.e. all string which are not used any more; you may set
    // aMaxRefCount to a higher value, depending on your expecations, i.e. 2 to
    // delete all string which are referenced only once outside of the pool
    // - returns the number of unique RawUTF8 cleaned from the internal pool
    // - to be executed on a regular basis - but not too often, since the
    // process can be time consumming, and void the benefit of interning
    function Clean(aMaxRefCount: integer=1): integer;
    /// how many items are currently stored in this instance
    function Count: integer;
  end;

  /// store one Name/Value pair, as used by TSynNameValue class
  TSynNameValueItem = record
    /// the name of the Name/Value pair
    // - this property is hashed by TSynNameValue for fast retrieval
    Name: RawUTF8;
    /// the value of the Name/Value pair
    Value: RawUTF8;
    /// any associated Pointer or numerical value
    Tag: PtrInt;
  end;

  /// Name/Value pairs storage, as used by TSynNameValue class
  TSynNameValueItemDynArray = array of TSynNameValueItem;

  /// event handler used to convert on the fly some UTF-8 text content
  TConvertRawUTF8 = function(const text: RawUTF8): RawUTF8 of object;

  /// callback event used by TSynNameValue
  TSynNameValueNotify = procedure(const Item: TSynNameValueItem; Index: PtrInt) of object;

  /// pseudo-class used to store Name/Value RawUTF8 pairs
  // - use internaly a TDynArrayHashed instance for fast retrieval
  // - is therefore faster than TRawUTF8List
  // - is defined as an object, not as a class: you can use this in any
  // class, without the need to destroy the content
  // - is defined either as an object either as a record, due to a bug
  // in Delphi 2009/2010 compiler (at least): this structure is not initialized
  // if defined as an object on the stack, but will be as a record :(
  {$ifdef FPC_OR_UNICODE}TSynNameValue = record private
  {$else}TSynNameValue = object protected{$endif}
    fDynArray: TDynArrayHashed;
    fOnAdd: TSynNameValueNotify;
    function GetBlobData: RawByteString;
    procedure SetBlobData(const aValue: RawByteString);
    function GetStr(const aName: RawUTF8): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetInt(const aName: RawUTF8): Int64; {$ifdef HASINLINE}inline;{$endif}
    function GetBool(const aName: RawUTF8): Boolean; {$ifdef HASINLINE}inline;{$endif}
  public
    /// the internal Name/Value storage
    List: TSynNameValueItemDynArray;
    /// the number of Name/Value pairs
    Count: integer;
    /// initialize the storage
    // - will also reset the internal List[] and the internal hash array
    procedure Init(aCaseSensitive: boolean);
    /// add an element to the array
    // - if aName already exists, its associated Value will be updated
    procedure Add(const aName, aValue: RawUTF8; aTag: PtrInt=0);
    /// reset content, then add all name=value pairs from a supplied .ini file
    // section content
    // - will first call Init(false) to initialize the internal array
    // - Section can be retrieved e.g. via FindSectionFirstLine()
    procedure InitFromIniSection(Section: PUTF8Char; OnTheFlyConvert: TConvertRawUTF8=nil;
      OnAdd: TSynNameValueNotify=nil);
    /// reset content, then add all name=value; CSV pairs
    // - will first call Init(false) to initialize the internal array
    // - if ItemSep=#10, then any kind of line feed (CRLF or LF) will be handled
    procedure InitFromCSV(CSV: PUTF8Char; NameValueSep: AnsiChar='=';
      ItemSep: AnsiChar=#10);
    /// reset content, then add all fields from an JSON object
    // - will first call Init() to initialize the internal array
    // - then parse the incoming JSON object, storing all its field values
    // as RawUTF8, and returning TRUE if the supplied content is correct
    // - warning: the supplied JSON buffer will be decoded and modified in-place
    function InitFromJSON(JSON: PUTF8Char; aCaseSensitive: boolean=false): boolean;
    /// reset content, then add all name, value pairs
    // - will first call Init(false) to initialize the internal array
    procedure InitFromNamesValues(const Names, Values: array of RawUTF8);
    /// search for a Name, return the index in List
    // - using fast O(1) hash algoritm
    function Find(const aName: RawUTF8): integer;
    /// search for the first chars of a Name, return the index in List
    // - using O(n) calls of IdemPChar() function
    // - here aUpperName should be already uppercase, as expected by IdemPChar()
    function FindStart(const aUpperName: RawUTF8): integer;
    /// search for a Value, return the index in List
    // - using O(n) brute force algoritm with case-sensitive aValue search
    function FindByValue(const aValue: RawUTF8): integer;
    /// search for a Name, and delete its entry in the List if it exists
    function Delete(const aName: RawUTF8): boolean;
    /// search for a Value, and delete its entry in the List if it exists
    // - returns the number of deleted entries
    // - you may search for more than one match, by setting a >1 Limit value
    function DeleteByValue(const aValue: RawUTF8; Limit: integer=1): integer;
    /// search for a Name, return the associated Value as a UTF-8 string
    function Value(const aName: RawUTF8; const aDefaultValue: RawUTF8=''): RawUTF8;
    /// search for a Name, return the associated Value as integer
    function ValueInt(const aName: RawUTF8; const aDefaultValue: Int64=0): Int64;
    /// search for a Name, return the associated Value as boolean
    // - returns true only if the value is exactly '1'
    function ValueBool(const aName: RawUTF8): Boolean;
    /// search for a Name, return the associated Value as an enumerate
    // - returns true and set aEnum if aName was found, and associated value
    // matched an aEnumTypeInfo item
    // - returns false if no match was found
    function ValueEnum(const aName: RawUTF8; aEnumTypeInfo: pointer; out aEnum;
      aEnumDefault: byte=0): boolean; overload;
    /// returns all values, as CSV or INI content
    function AsCSV(const KeySeparator: RawUTF8='=';
      const ValueSeparator: RawUTF8=#13#10; const IgnoreKey: RawUTF8=''): RawUTF8;
    /// returns all values as a JSON object of string fields
    function AsJSON: RawUTF8;
    /// fill the supplied two arrays of RawUTF8 with the stored values
    procedure AsNameValues(out Names,Values: TRawUTF8DynArray);
    {$ifndef NOVARIANTS}
    /// search for a Name, return the associated Value as variant
    // - returns null if the name was not found
    function ValueVariantOrNull(const aName: RawUTF8): variant;
    /// compute a TDocVariant document from the stored values
    // - output variant will be reset and filled as a TDocVariant instance,
    // ready to be serialized as a JSON object
    // - if there is no value stored (i.e. Count=0), set null
    procedure AsDocVariant(out DocVariant: variant;
      ExtendedJson: boolean=false; ValueAsString: boolean=true;
      AllowVarDouble: boolean=false); overload;
    /// compute a TDocVariant document from the stored values
    function AsDocVariant(ExtendedJson: boolean=false; ValueAsString: boolean=true): variant; overload; {$ifdef HASINLINE}inline;{$endif}
    /// merge the stored values into a TDocVariant document
    // - existing properties would be updated, then new values will be added to
    // the supplied TDocVariant instance, ready to be serialized as a JSON object
    // - if ValueAsString is TRUE, values would be stored as string
    // - if ValueAsString is FALSE, numerical values would be identified by
    // IsString() and stored as such in the resulting TDocVariant
    // - if you let ChangedProps point to a TDocVariantData, it would contain
    // an object with the stored values, just like AsDocVariant
    // - returns the number of updated values in the TDocVariant, 0 if
    // no value was changed
    function MergeDocVariant(var DocVariant: variant;
      ValueAsString: boolean; ChangedProps: PVariant=nil;
      ExtendedJson: boolean=false; AllowVarDouble: boolean=false): integer;
    {$endif}
    /// returns true if the Init() method has been called
    function Initialized: boolean;
    /// can be used to set all data from one BLOB memory buffer
    procedure SetBlobDataPtr(aValue: pointer);
    /// can be used to set or retrieve all stored data as one BLOB content
    property BlobData: RawByteString read GetBlobData write SetBlobData;
    /// event triggerred after an item has just been added to the list
    property OnAfterAdd: TSynNameValueNotify read fOnAdd write fOnAdd;
    /// search for a Name, return the associated Value as a UTF-8 string
    // - returns '' if aName is not found in the stored keys
    property Str[const aName: RawUTF8]: RawUTF8 read GetStr; default;
    /// search for a Name, return the associated Value as integer
    // - returns 0 if aName is not found, or not a valid Int64 in the stored keys
    property Int[const aName: RawUTF8]: Int64 read GetInt;
    /// search for a Name, return the associated Value as boolean
    // - returns true if aName stores '1' as associated value
    property Bool[const aName: RawUTF8]: Boolean read GetBool;
  end;

  /// a reference pointer to a Name/Value RawUTF8 pairs storage
  PSynNameValue = ^TSynNameValue;

/// allocate and initialize a TSynLocker instance
// - caller should call result^.DoneAndFreemem when not used any more
function NewSynLocker: PSynLocker;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add an item to a array of pointer dynamic array storage
function PtrArrayAdd(var aPtrArray; aItem: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add once an item to a array of pointer dynamic array storage
function PtrArrayAddOnce(var aPtrArray; aItem: pointer): integer;

/// wrapper to delete an item from a array of pointer dynamic array storage
function PtrArrayDelete(var aPtrArray; aItem: pointer): integer; overload;

/// wrapper to find an item to a array of pointer dynamic array storage
function PtrArrayFind(var aPtrArray; aItem: pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add an item to a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - could be used as such (note the T*ObjArray type naming convention):
// ! TUserObjArray = array of TUser;
// ! ...
// ! var arr: TUserObjArray;
// !     user: TUser;
// ! ..
// ! try
// !   user := TUser.Create;
// !   user.Name := 'Name';
// !   index := ObjArrayAdd(arr,user);
// ! ...
// ! finally
// !   ObjArrayClear(arr); // release all items
// ! end;
// - return the index of the item in the dynamic array
function ObjArrayAdd(var aObjArray; aItem: TObject): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to add items to a T*ObjArray dynamic array storage
// - aSourceObjArray[] items will be owned by aDestObjArray[], therefore
// aSourceObjArray is set to nil
// - return the new number of the items in aDestObjArray
function ObjArrayAppend(var aDestObjArray, aSourceObjArray): PtrInt;

/// wrapper to add an item to a T*ObjArray dynamic array storage
// - this overloaded function will use a separated variable to store the items
// count, so will be slightly faster: but you should call SetLength() when done,
// to have an array as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - return the index of the item in the dynamic array
function ObjArrayAddCount(var aObjArray; aItem: TObject; var aObjArrayCount: integer): PtrInt;

/// wrapper to add once an item to a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - if the object is already in the array (searching by address/reference,
// not by content), return its current index in the dynamic array
// - if the object does not appear in the array, add it at the end
procedure ObjArrayAddOnce(var aObjArray; aItem: TObject);

/// wrapper to set the length of a T*ObjArray dynamic array storage
// - could be used as an alternative to SetLength() when you do not
// know the exact T*ObjArray type
procedure ObjArraySetLength(var aObjArray; aLength: integer);
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to search an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - search is performed by address/reference, not by content
// - returns -1 if the item is not found in the dynamic array
function ObjArrayFind(const aObjArray; aItem: TObject): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to count all not nil items in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
function ObjArrayCount(const aObjArray): integer;

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - do nothing if the index is out of range in the dynamic array
procedure ObjArrayDelete(var aObjArray; aItemIndex: PtrInt;
  aContinueOnException: boolean=false); overload;

/// wrapper to delete an item in a T*ObjArray dynamic array storage
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - search is performed by address/reference, not by content
// - do nothing if the item is not found in the dynamic array
function ObjArrayDelete(var aObjArray; aItem: TObject): PtrInt; overload;

/// wrapper to sort the items stored in a T*ObjArray dynamic array
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
procedure ObjArraySort(var aObjArray; Compare: TDynArraySortCompare);

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - will also set the dynamic array length to 0, so could be used to re-use
// an existing T*ObjArray
procedure ObjArrayClear(var aObjArray); overload;

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - this overloaded function will use the supplied array length as parameter
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - will also set the dynamic array length to 0, so could be used to re-use
// an existing T*ObjArray
procedure ObjArrayClear(var aObjArray; aCount: integer); overload;

/// wrapper to release all items stored in a T*ObjArray dynamic array
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
// - you should always use ObjArrayClear() before the array storage is released,
// e.g. in the owner class destructor
// - will also set the dynamic array length to 0, so could be used to re-use
// an existing T*ObjArray
procedure ObjArrayClear(var aObjArray; aContinueOnException: boolean); overload;

/// wrapper to release all items stored in an array of T*ObjArray dynamic array
// - e.g. aObjArray may be defined as "array of array of TSynFilter"
procedure ObjArrayObjArrayClear(var aObjArray);

/// wrapper to release all items stored in several T*ObjArray dynamic arrays
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
procedure ObjArraysClear(const aObjArray: array of pointer);

{$ifndef DELPHI5OROLDER}

/// wrapper to add an item to a T*InterfaceArray dynamic array storage
function InterfaceArrayAdd(var aInterfaceArray; const aItem: IUnknown): PtrInt;

/// wrapper to add once an item to a T*InterfaceArray dynamic array storage
procedure InterfaceArrayAddOnce(var aInterfaceArray; const aItem: IUnknown);

/// wrapper to search an item in a T*InterfaceArray dynamic array storage
// - search is performed by address/reference, not by content
// - return -1 if the item is not found in the dynamic array, or the index of
// the matching entry otherwise
function InterfaceArrayFind(const aInterfaceArray; const aItem: IUnknown): PtrInt;
  {$ifdef HASINLINE}inline;{$endif}

/// wrapper to delete an item in a T*InterfaceArray dynamic array storage
// - search is performed by address/reference, not by content
// - do nothing if the item is not found in the dynamic array
function InterfaceArrayDelete(var aInterfaceArray; const aItem: IUnknown): PtrInt; overload;

/// wrapper to delete an item in a T*InterfaceArray dynamic array storage
// - do nothing if the item is not found in the dynamic array
procedure InterfaceArrayDelete(var aInterfaceArray; aItemIndex: PtrInt); overload;

{$endif DELPHI5OROLDER}


/// helper to retrieve the text of an enumerate item
// - see also RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetEnumName(aTypeInfo: pointer; aIndex: integer): PShortString;

/// helper to retrieve all texts of an enumerate
// - may be used as cache for overloaded ToText() content
procedure GetEnumNames(aTypeInfo: pointer; aDest: PPShortString);

/// helper to retrieve all trimmed texts of an enumerate
// - may be used as cache to retrieve UTF-8 text without lowercase 'a'..'z' chars
procedure GetEnumTrimmedNames(aTypeInfo: pointer; aDest: PRawUTF8); overload;

/// helper to retrieve all trimmed texts of an enumerate as UTF-8 strings
function GetEnumTrimmedNames(aTypeInfo: pointer): TRawUTF8DynArray; overload;

/// helper to retrieve all (translated) caption texts of an enumerate
// - may be used as cache for overloaded ToCaption() content
procedure GetEnumCaptions(aTypeInfo: pointer; aDest: PString);

/// UnCamelCase and translate the enumeration item
function GetCaptionFromEnum(aTypeInfo: pointer; aIndex: integer): string;

/// low-level helper to retrieve a (translated) caption from a PShortString
// - as used e.g. by GetEnumCaptions or GetCaptionFromEnum
procedure GetCaptionFromTrimmed(PS: PShortString; var result: string);

/// helper to retrieve the index of an enumerate item from its text
// - returns -1 if aValue was not found
// - will search for the exact text and also trim the lowercase 'a'..'z' chars on
// left side of the text if no exact match is found and AlsoTrimLowerCase is TRUE
// - see also RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetEnumNameValue(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: integer;
  AlsoTrimLowerCase: boolean=false): Integer; overload;

/// retrieve the index of an enumerate item from its left-trimmed text
// - will trim the lowercase 'a'..'z' chars on left side of the supplied aValue text
// - returns -1 if aValue was not found
function GetEnumNameValueTrimmed(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: integer): integer;

/// helper to retrieve the index of an enumerate item from its text
function GetEnumNameValue(aTypeInfo: pointer; const aValue: RawUTF8;
  AlsoTrimLowerCase: boolean=false): Integer; overload;

/// helper to retrieve the bit mapped integer value of a set from its JSON text
// - if supplied P^ is a JSON integer number, will read it directly
// - if P^ maps some ["item1","item2"] content, would fill all matching bits
// - if P^ contains ['*'], would fill all bits
// - returns P=nil if reached prematurly the end of content, or returns
// the value separator (e.g. , or }) in EndOfObject (like GetJsonField)
function GetSetNameValue(aTypeInfo: pointer; var P: PUTF8Char;
  out EndOfObject: AnsiChar): cardinal;

/// helper to retrieve the CSV text of all enumerate items defined in a set
// - you'd better use RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetSetName(aTypeInfo: pointer; const value): RawUTF8;

/// helper to retrieve the CSV text of all enumerate items defined in a set
// - you'd better use RTTI related classes of mORMot.pas unit, e.g. TEnumType
procedure GetSetNameShort(aTypeInfo: pointer; const value; out result: ShortString;
  trimlowercase: boolean=false);

/// fast append some UTF-8 text into a shortstring
procedure AppendShortComma(text: PAnsiChar; len: integer; var result: shortstring;
  trimlowercase: boolean);

/// fast search of an exact case-insensitive match of a RTTI's PShortString array
function FindShortStringListExact(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// fast search of an left-trimmed lowercase match of a RTTI's PShortString array
function FindShortStringListTrimLowerCase(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;

/// retrieve the type name from its low-level RTTI
function TypeInfoToName(aTypeInfo: pointer): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the type name from its low-level RTTI
procedure TypeInfoToName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8=''); overload;

/// retrieve the unit name and type name from its low-level RTTI
procedure TypeInfoToQualifiedName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8='');

/// compute a crc32c-based hash of the RTTI for a managed given type
// - can be used to ensure that the RecordSave/TDynArray.SaveTo binary layout
// is compatible accross executables, even between FPC and Delphi
// - will ignore the type names, but will check the RTTI type kind and any
// nested fields (for records or arrays) - for a record/object type, will use
// TTextWriter.RegisterCustomJSONSerializerFromText definition, if available
function TypeInfoToHash(aTypeInfo: pointer): cardinal;

/// retrieve the record size from its low-level RTTI
function RecordTypeInfoSize(aRecordTypeInfo: pointer): integer;

/// retrieve the item type information of a dynamic array low-level RTTI
function DynArrayTypeInfoToRecordInfo(aDynArrayTypeInfo: pointer;
  aDataSize: PInteger=nil): pointer;

/// sort any dynamic array, via an external array of indexes
// - this function will use the supplied TSynTempBuffer for index storage,
// so use PIntegerArray(Indexes.buf) to access the values
// - caller should always make Indexes.Done once done
procedure DynArraySortIndexed(Values: pointer; ElemSize, Count: Integer;
  out Indexes: TSynTempBuffer; Compare: TDynArraySortCompare);

/// compare two TGUID values
// - this version is faster than the one supplied by SysUtils
function IsEqualGUID({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid1, guid2: TGUID): Boolean; {$ifdef HASINLINE}inline;{$endif}

/// returns the index of a matching TGUID in an array
// - returns -1 if no item matched
function IsEqualGUIDArray({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid: TGUID; const guids: array of TGUID): integer;

/// check if a TGUID value contains only 0 bytes
// - this version is faster than the one supplied by SysUtils
function IsNullGUID({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// append one TGUID item to a TGUID dynamic array
// - returning the newly inserted index in guids[], or an existing index in
// guids[] if NoDuplicates is TRUE and TGUID already exists
function AddGUID(var guids: TGUIDDynArray; const guid: TGUID;
  NoDuplicates: boolean=false): integer;

/// append a TGUID binary content as text
// - will store e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301' (without any {})
// - this will be the format used for JSON encoding, e.g.
// $ { "UID": "C9A646D3-9C61-4CB7-BFCD-EE2522C8F633" }
function GUIDToText(P: PUTF8Char; guid: PByteArray): PUTF8Char;

/// convert a TGUID into UTF-8 encoded text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - if you do not need the embracing { }, use ToUTF8() overloaded function
function GUIDToRawUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8;

/// convert a TGUID into text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - this version is faster than the one supplied by SysUtils
function GUIDToString({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): string;

type
  /// low-level object implementing a 32-bit Pierre L'Ecuyer software generator
  // - as used by RandomGsl function, and Random32 if no RDRAND hardware is available
  // - is not thread-safe, but cross-compiler and cross-platform, still very
  // fast with a much better distribution than Delphi system's Random() function
  {$ifdef FPC_OR_UNICODE}TLecuyer = record{$else}TLecuyer = object{$endif}
  public
    rs1, rs2, rs3, seedcount: cardinal;
    /// force an immediate seed of the generator from current system state
    // - should be called before any call to the Next method
    procedure Seed(entropy: PByteArray; entropylen: PtrInt);
    /// compute the next 32-bit generated value
    // - will automatically reseed after around 65,000 generated values
    function Next: cardinal; overload;
    /// compute the next 32-bit generated value, in range [0..max-1]
    // - will automatically reseed after around 65,000 generated values
    function Next(max: cardinal): cardinal; overload;
  end;

/// fast compute of some 32-bit random value
// - will use (slow but) hardware-derivated RDRAND Intel x86/x64 opcode if
// available, or fast gsl_rng_taus2 generator by Pierre L'Ecuyer (which period
// is 2^88, i.e. about 10^26) if the CPU doesn't support it
// - use rather TAESPRNG.Main.FillRandom() for cryptographic-level randomness
// - thread-safe function: each thread will maintain its own gsl_rng_taus2 table
function Random32: cardinal; overload;

/// fast compute of some 32-bit random value, with a maximum (excluded) upper value
// - i.e. returns a value in range [0..max-1]
// - will use (slow but) hardware-derivated RDRAND Intel x86/x64 opcode if
// available, or fast gsl_rng_taus2 generator by Pierre L'Ecuyer (which period
// is 2^88, i.e. about 10^26) if the CPU doesn't support it
// - use rather TAESPRNG.Main.FillRandom() for cryptographic-level randomness
// - thread-safe function: each thread will maintain its own gsl_rng_taus2 table
function Random32(max: cardinal): cardinal; overload;

/// fast compute of some 32-bit random value, using the gsl_rng_taus2 generator
// - plain Random32 may call RDRAND opcode on Intel CPUs, wherease this function
// will use well documented (and proven) Pierre L'Ecuyer software generator
// - may be used if you don't want/trust RDRAND, if you expect a well defined
// cross-platform generator, or have higher performance expectations
// - use rather TAESPRNG.Main.FillRandom() for cryptographic-level randomness
// - thread-safe function: each thread will maintain its own gsl_rng_taus2 table
function Random32gsl: cardinal; overload;

/// fast compute of bounded 32-bit random value, using the gsl_rng_taus2 generator
function Random32gsl(max: cardinal): cardinal; overload;

/// seed the gsl_rng_taus2 Random32/Random32gsl generator
// - this seeding won't affect RDRAND Intel x86/x64 opcode generation
// - by default, gsl_rng_taus2 generator is re-seeded every 256KB, much more
// often than the Pierre L'Ecuyer's algorithm period of 2^88
// - you can specify some additional entropy buffer; note that calling this
// function with the same entropy again WON'T seed the generator with the same
// sequence (as with RTL's RandomSeed function), but initiate a new one
// - thread-specific function: each thread will maintain its own seed table
procedure Random32Seed(entropy: pointer=nil; entropylen: integer=0);

/// fill some memory buffer with random values
// - the destination buffer is expected to be allocated as 32-bit items
// - use internally crc32c() with some rough entropy source, and Random32
// gsl_rng_taus2 generator or hardware RDRAND Intel x86/x64 opcode if available
// (and ForceGsl is kept to its default false value)
// - consider using instead the cryptographic secure TAESPRNG.Main.FillRandom()
// method from the SynCrypto unit - in particular, RDRAND could be slow
// as reported by https://en.wikipedia.org/wiki/RdRand#Performance
procedure FillRandom(Dest: PCardinalArray; CardinalCount: integer; ForceGsl: boolean=false);

/// compute a random GUID value
procedure RandomGUID(out result: TGUID); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compute a random GUID value
function RandomGUID: TGUID; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill a GUID with 0
procedure FillZero(var result: TGUID); overload; {$ifdef HASINLINE}inline;{$endif}

type
  /// stack-allocated ASCII string, used by GUIDToShort() function
  TGUIDShortString = string[38];

const
  /// a TGUID containing '{00000000-0000-0000-0000-00000000000}'
  GUID_NULL: TGUID = ();

/// convert a TGUID into text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - using a shortstring will allow fast allocation on the stack, so is
// preferred e.g. when providing a GUID to a ESynException.CreateUTF8()
function GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid: TGUID): TGUIDShortString; overload; {$ifdef HASINLINE}inline;{$endif}

/// convert a TGUID into text
// - will return e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - using a shortstring will allow fast allocation on the stack, so is
// preferred e.g. when providing a GUID to a ESynException.CreateUTF8()
procedure GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid: TGUID; out dest: TGUIDShortString); overload;

/// convert some text into its TGUID binary value
// - expect e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301' (without any {})
// - return  if the supplied text buffer is not a valid TGUID
// - this will be the format used for JSON encoding, e.g.
// $ { "UID": "C9A646D3-9C61-4CB7-BFCD-EE2522C8F633" }
function TextToGUID(P: PUTF8Char; guid: PByteArray): PUTF8Char;

/// convert some text into a TGUID
// - expect e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - return {00000000-0000-0000-0000-000000000000} if the supplied text buffer
// is not a valid TGUID
function StringToGUID(const text: string): TGUID;

/// convert some UTF-8 encoded text into a TGUID
// - expect e.g. '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}' (with the {})
// - return {00000000-0000-0000-0000-000000000000} if the supplied text buffer
// is not a valid TGUID
function RawUTF8ToGUID(const text: RawByteString): TGUID;


/// check equality of two records by content
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties
// - will use binary-level comparison: it could fail to match two floating-point
// values because of rounding issues (Currency won't have this problem)
function RecordEquals(const RecA, RecB; TypeInfo: pointer;
  PRecSize: PInteger=nil): boolean;

/// save a record content into a RawByteString
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties (but not with internal raw pointers, of course)
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - warning: will encode generic string fields as AnsiString (one byte per char)
// prior to Delphi 2009, and as UnicodeString (two bytes per char) since Delphi
// 2009: if you want to use this function between UNICODE and NOT UNICODE
// versions of Delphi, you should use some explicit types like RawUTF8,
// WinAnsiString, SynUnicode or even RawUnicode/WideString
function RecordSave(const Rec; TypeInfo: pointer): RawByteString; overload;

/// save a record content into a TBytes dynamic array
// - could be used as an alternative to RawByteString's RecordSave()
function RecordSaveBytes(const Rec; TypeInfo: pointer): TBytes;

/// save a record content into a destination memory buffer
// - Dest must be at least RecordSaveLength() bytes long
// - will return the Rec size, in bytes, into Len reference variable
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties (but not with internal raw pointers, of course)
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - warning: will encode generic string fields as AnsiString (one byte per char)
// prior to Delphi 2009, and as UnicodeString (two bytes per char) since Delphi
// 2009: if you want to use this function between UNICODE and NOT UNICODE
// versions of Delphi, you should use some explicit types like RawUTF8,
// WinAnsiString, SynUnicode or even RawUnicode/WideString
function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer;
  out Len: integer): PAnsiChar; overload;

/// save a record content into a destination memory buffer
// - Dest must be at least RecordSaveLength() bytes long
// - will handle packed records, with binaries (byte, word, integer...) and
// string types properties (but not with internal raw pointers, of course)
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
// - warning: will encode generic string fields as AnsiString (one byte per char)
// prior to Delphi 2009, and as UnicodeString (two bytes per char) since Delphi
// 2009: if you want to use this function between UNICODE and NOT UNICODE
// versions of Delphi, you should use some explicit types like RawUTF8,
// WinAnsiString, SynUnicode or even RawUnicode/WideString
function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer): PAnsiChar; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// save a record content into a destination memory buffer
// - caller should make Dest.Done once finished with Dest.buf/Dest.len buffer
procedure RecordSave(const Rec; var Dest: TSynTempBuffer; TypeInfo: pointer); overload;

/// save a record content into a Base-64 encoded UTF-8 text content
// - will use RecordSave() format, with a left-sided binary CRC
function RecordSaveBase64(const Rec; TypeInfo: pointer; UriCompatible: boolean=false): RawUTF8;

/// compute the number of bytes needed to save a record content
// using the RecordSave() function
// - will return 0 in case of an invalid (not handled) record type (e.g. if
// it contains an unknown variant)
// - optional Len parameter will contain the Rec memory buffer length, in bytes
function RecordSaveLength(const Rec; TypeInfo: pointer; Len: PInteger=nil): integer;

/// save record into its JSON serialization as saved by TTextWriter.AddRecordJSON
// - will use default Base64 encoding over RecordSave() binary - or custom true
// JSON format (as set by TTextWriter.RegisterCustomJSONSerializer or via
// enhanced RTTI), if available (following EnumSetsAsText optional parameter
// for nested enumerates and sets)
function RecordSaveJSON(const Rec; TypeInfo: pointer;
  EnumSetsAsText: boolean=false): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// fill a record content from a memory buffer as saved by RecordSave()
// - return nil if the Source buffer is incorrect
// - in case of success, return the memory buffer pointer just after the
// read content, and set the Rec size, in bytes, into Len reference variable
// - will use a proprietary binary format, with some variable-length encoding
// of the string length - note that if you change the type definition, any
// previously-serialized content will fail, maybe triggering unexpected GPF: you
// may use TypeInfoToHash() if you share this binary data accross executables
function RecordLoad(var Rec; Source: PAnsiChar; TypeInfo: pointer;
  Len: PInteger=nil): PAnsiChar; overload;

/// fill a record content from a memory buffer as saved by RecordSave()
// - returns false if the Source buffer was incorrect, true on success
function RecordLoad(var Res; const Source: RawByteString; TypeInfo: pointer): boolean; overload;

/// read a record content from a Base-64 encoded content
// - expects RecordSaveBase64() format, with a left-sided binary CRC
function RecordLoadBase64(Source: PAnsiChar; Len: integer; var Rec; TypeInfo: pointer;
  UriCompatible: boolean=false): boolean;

/// fill a record content from a JSON serialization as saved by
// TTextWriter.AddRecordJSON / RecordSaveJSON
// - will use default Base64 encoding over RecordSave() binary - or custom true
// JSON format (as set by TTextWriter.RegisterCustomJSONSerializer or via
// enhanced RTTI), if available
// - returns nil on error, or the end of buffer on success
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy if you need to access it later, or the overloaded RecordLoadJSON()
function RecordLoadJSON(var Rec; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char; overload;

/// fill a record content from a JSON serialization as saved by
// TTextWriter.AddRecordJSON / RecordSaveJSON
// - will use default Base64 encoding over RecordSave() binary - or custom true
// JSON format (as set by TTextWriter.RegisterCustomJSONSerializer or via
// enhanced RTTI), if available
function RecordLoadJSON(var Rec; const JSON: RawUTF8; TypeInfo: pointer): boolean; overload;

/// copy a record content from source to Dest
// - this unit includes a fast optimized asm version for x86 on Delphi
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer); {$ifdef FPC}inline;{$endif}

/// clear a record content
// - this unit includes a fast optimized asm version for x86 on Delphi
procedure RecordClear(var Dest; TypeInfo: pointer); {$ifdef FPC}inline;{$endif}

{$ifndef DELPHI5OROLDER}
/// copy a dynamic array content from source to Dest
// - uses internally the TDynArray.CopyFrom() method and two temporary
// TDynArray wrappers
procedure DynArrayCopy(var Dest; const Source; SourceMaxElem: integer;
  TypeInfo: pointer);
{$endif DELPHI5OROLDER}

/// fill a dynamic array content from a binary serialization as saved by
// DynArraySave() / TDynArray.Save()
// - Value shall be set to the target dynamic array field
// - just a function helper around TDynArray.Init + TDynArray.LoadFrom
function DynArrayLoad(var Value; Source: PAnsiChar; TypeInfo: pointer): PAnsiChar;

/// serialize a dynamic array content as binary, ready to be loaded by
// DynArrayLoad() / TDynArray.Load()
// - Value shall be set to the source dynamic arry field
// - just a function helper around TDynArray.Init + TDynArray.SaveTo
function DynArraySave(var Value; TypeInfo: pointer): RawByteString;

/// fill a dynamic array content from a JSON serialization as saved by
// TTextWriter.AddDynArrayJSON
// - Value shall be set to the target dynamic array field
// - is just a wrapper around TDynArray.LoadFromJSON(), creating a temporary
// TDynArray wrapper on the stack
// - return a pointer at the end of the data read from JSON, nil in case
// of an invalid input buffer
// - to be used e.g. for custom record JSON unserialization, within a
// TDynArrayJSONCustomReader callback
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy if you need to access it later
function DynArrayLoadJSON(var Value; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char;

/// serialize a dynamic array content as JSON
// - Value shall be set to the source dynamic array field
// - is just a wrapper around TTextWriter.AddDynArrayJSON(), creating
// a temporary TDynArray wrapper on the stack
// - to be used e.g. for custom record JSON serialization, within a
// TDynArrayJSONCustomWriter callback or RegisterCustomJSONSerializerFromText()
// (following EnumSetsAsText optional parameter for nested enumerates and sets)
function DynArraySaveJSON(const Value; TypeInfo: pointer;
  EnumSetsAsText: boolean=false): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef DELPHI5OROLDER}
/// compare two dynamic arrays by calling TDynArray.Equals
function DynArrayEquals(TypeInfo: pointer; var Array1, Array2;
  Array1Count: PInteger=nil; Array2Count: PInteger=nil): boolean;
{$endif DELPHI5OROLDER}

/// serialize a dynamic array content, supplied as raw binary buffer, as JSON
// - Value shall be set to the source dynamic array field
// - is just a wrapper around TTextWriter.AddDynArrayJSON(), creating
// a temporary TDynArray wrapper on the stack
// - to be used e.g. for custom record JSON serialization, within a
// TDynArrayJSONCustomWriter callback or RegisterCustomJSONSerializerFromText()
function DynArrayBlobSaveJSON(TypeInfo, BlobValue: pointer): RawUTF8;

/// compute a dynamic array element information
// - will raise an exception if the supplied RTTI is not a dynamic array
// - will return the element type name and set ElemTypeInfo otherwise
// - if there is no element type information, an approximative element type name
// will be returned (e.g. 'byte' for an array of 1 byte items), and ElemTypeInfo
// will be set to nil
// - this low-level function is used e.g. by mORMotWrappers unit
function DynArrayElementTypeName(TypeInfo: pointer; ElemTypeInfo: PPointer=nil;
  ExactType: boolean=false): RawUTF8;

/// trim ending 'DynArray' or 's' chars from a dynamic array type name
// - used internally to guess the associated item type name
function DynArrayItemTypeLen(const aDynArrayTypeName: RawUTF8): integer;


/// compare two "array of boolean" elements
function SortDynArrayBoolean(const A,B): integer;

/// compare two "array of shortint" elements
function SortDynArrayShortint(const A,B): integer;

/// compare two "array of byte" elements
function SortDynArrayByte(const A,B): integer;

/// compare two "array of smallint" elements
function SortDynArraySmallint(const A,B): integer;

/// compare two "array of word" elements
function SortDynArrayWord(const A,B): integer;

/// compare two "array of integer" elements
function SortDynArrayInteger(const A,B): integer;

/// compare two "array of cardinal" elements
function SortDynArrayCardinal(const A,B): integer;

/// compare two "array of Int64" or "array of Currency" elements
function SortDynArrayInt64(const A,B): integer;

/// compare two "array of QWord" elements
// - note that QWord(A)>QWord(B) is wrong on older versions of Delphi, so you
// should better use this function or CompareQWord() to properly compare two
// QWord values over CPUX86
function SortDynArrayQWord(const A,B): integer;

/// compare two "array of THash128" elements
function SortDynArray128(const A,B): integer;

/// compare two "array of THash256" elements
function SortDynArray256(const A,B): integer;

/// compare two "array of THash512" elements
function SortDynArray512(const A,B): integer;

/// compare two "array of TObject/pointer" elements
function SortDynArrayPointer(const A,B): integer;

/// compare two "array of single" elements
function SortDynArraySingle(const A,B): integer;

/// compare two "array of double" elements
function SortDynArrayDouble(const A,B): integer;

/// compare two "array of AnsiString" elements, with case sensitivity
function SortDynArrayAnsiString(const A,B): integer;

/// compare two "array of RawByteString" elements, with case sensitivity
// - can't use StrComp() or similar functions since RawByteString may contain #0
function SortDynArrayRawByteString(const A,B): integer;

/// compare two "array of AnsiString" elements, with no case sensitivity
function SortDynArrayAnsiStringI(const A,B): integer;

/// compare two "array of PUTF8Char/PAnsiChar" elements, with case sensitivity
function SortDynArrayPUTF8Char(const A,B): integer;

/// compare two "array of PUTF8Char/PAnsiChar" elements, with no case sensitivity
function SortDynArrayPUTF8CharI(const A,B): integer;

/// compare two "array of WideString/UnicodeString" elements, with case sensitivity
function SortDynArrayUnicodeString(const A,B): integer;

/// compare two "array of WideString/UnicodeString" elements, with no case sensitivity
function SortDynArrayUnicodeStringI(const A,B): integer;

/// compare two "array of generic string" elements, with case sensitivity
// - the expected string type is the generic VCL string
function SortDynArrayString(const A,B): integer;

/// compare two "array of generic string" elements, with no case sensitivity
// - the expected string type is the generic VCL string
function SortDynArrayStringI(const A,B): integer;

/// compare two "array of TFileName" elements, as file names
// - i.e. with no case sensitivity, and grouped by file extension
// - the expected string type is the generic RTL string, i.e. TFileName
// - calls internally GetFileNameWithoutExt() and AnsiCompareFileName()
function SortDynArrayFileName(const A,B): integer;

{$ifndef NOVARIANTS}
/// compare two "array of variant" elements, with case sensitivity
function SortDynArrayVariant(const A,B): integer;

/// compare two "array of variant" elements, with no case sensitivity
function SortDynArrayVariantI(const A,B): integer;

/// compare two "array of variant" elements, with or without case sensitivity
function SortDynArrayVariantComp(const A,B: TVarData; caseInsensitive: boolean): integer;
{$endif NOVARIANTS}


/// hash one AnsiString content with the suppplied Hasher() function
function HashAnsiString(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one AnsiString content with the suppplied Hasher() function
function HashAnsiStringI(const Elem; Hasher: THasher): cardinal;

/// hash one SynUnicode content with the suppplied Hasher() function
// - work with WideString for all Delphi versions, or UnicodeString in Delphi 2009+
function HashSynUnicode(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one SynUnicode content with the suppplied Hasher() function
// - work with WideString for all Delphi versions, or UnicodeString in Delphi 2009+
function HashSynUnicodeI(const Elem; Hasher: THasher): cardinal;

/// hash one WideString content with the suppplied Hasher() function
// - work with WideString for all Delphi versions
function HashWideString(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one WideString content with the suppplied Hasher() function
// - work with WideString for all Delphi versions
function HashWideStringI(const Elem; Hasher: THasher): cardinal;

{$ifdef UNICODE}
/// hash one UnicodeString content with the suppplied Hasher() function
// - work with UnicodeString in Delphi 2009+
function HashUnicodeString(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one UnicodeString content with the suppplied Hasher() function
// - work with UnicodeString in Delphi 2009+
function HashUnicodeStringI(const Elem; Hasher: THasher): cardinal;
{$endif UNICODE}

{$ifndef NOVARIANTS}
/// case-sensitive hash one variant content with the suppplied Hasher() function
function HashVariant(const Elem; Hasher: THasher): cardinal;

/// case-insensitive hash one variant content with the suppplied Hasher() function
function HashVariantI(const Elem; Hasher: THasher): cardinal;
{$endif NOVARIANTS}

/// hash one PtrUInt (=NativeUInt) value with the suppplied Hasher() function
function HashPtrUInt(const Elem; Hasher: THasher): cardinal;

/// hash one Byte value - simply return the value ignore Hasher() parameter
function HashByte(const Elem; Hasher: THasher): cardinal;

/// hash one Word value - simply return the value ignore Hasher() parameter
function HashWord(const Elem; Hasher: THasher): cardinal;

/// hash one Integer/cardinal value - simply return the value ignore Hasher() parameter
function HashInteger(const Elem; Hasher: THasher): cardinal;

/// hash one Int64/Qword value with the suppplied Hasher() function
function HashInt64(const Elem; Hasher: THasher): cardinal;

/// hash one THash128 value with the suppplied Hasher() function
function Hash128(const Elem; Hasher: THasher): cardinal;

/// hash one THash256 value with the suppplied Hasher() function
function Hash256(const Elem; Hasher: THasher): cardinal;

/// hash one THash512 value with the suppplied Hasher() function
function Hash512(const Elem; Hasher: THasher): cardinal;

/// hash one pointer value with the suppplied Hasher() function
// - this version is not the same as HashPtrUInt, since it will always
// use the hasher function
function HashPointer(const Elem; Hasher: THasher): cardinal;

var
  /// helper array to get the comparison function corresponding to a given
  // standard array type
  // - not to be used as such, but e.g. when inlining TDynArray methods
  DYNARRAY_SORTFIRSTFIELD: array[boolean,TDynArrayKind] of TDynArraySortCompare = (
    (nil, SortDynArrayBoolean, SortDynArrayByte, SortDynArrayWord,
    SortDynArrayInteger, SortDynArrayCardinal, SortDynArraySingle,
    SortDynArrayInt64, SortDynArrayQWord, SortDynArrayDouble,
    SortDynArrayInt64, SortDynArrayInt64, SortDynArrayDouble, SortDynArrayDouble,
    SortDynArrayAnsiString, SortDynArrayAnsiString, SortDynArrayString,
    SortDynArrayRawByteString, SortDynArrayUnicodeString,
    SortDynArrayUnicodeString, SortDynArray128, SortDynArray256,
    SortDynArray512, SortDynArrayPointer,
    {$ifndef NOVARIANTS}SortDynArrayVariant,{$endif} nil),
    (nil, SortDynArrayBoolean, SortDynArrayByte, SortDynArrayWord,
    SortDynArrayInteger, SortDynArrayCardinal, SortDynArraySingle,
    SortDynArrayInt64, SortDynArrayQWord, SortDynArrayDouble,
    SortDynArrayInt64, SortDynArrayInt64, SortDynArrayDouble, SortDynArrayDouble,
    SortDynArrayAnsiStringI, SortDynArrayAnsiStringI, SortDynArrayStringI,
    SortDynArrayRawByteString, SortDynArrayUnicodeStringI,
    SortDynArrayUnicodeStringI, SortDynArray128, SortDynArray256,
    SortDynArray512, SortDynArrayPointer,
    {$ifndef NOVARIANTS}SortDynArrayVariantI,{$endif} nil));

  /// helper array to get the hashing function corresponding to a given
  // standard array type
  // - not to be used as such, but e.g. when inlining TDynArray methods
  DYNARRAY_HASHFIRSTFIELD: array[boolean,TDynArrayKind] of TDynArrayHashOne = (
    (nil, HashByte, HashByte, HashWord, HashInteger,
    HashInteger, HashInteger, HashInt64, HashInt64, HashInt64,
    HashInt64, HashInt64, HashInt64, HashInt64,
    HashAnsiString, HashAnsiString,
    {$ifdef UNICODE}HashUnicodeString{$else}HashAnsiString{$endif},
    HashAnsiString, HashWideString, HashSynUnicode, Hash128,
    Hash256, Hash512, HashPointer,
    {$ifndef NOVARIANTS}HashVariant,{$endif} nil),
    (nil, HashByte, HashByte, HashWord, HashInteger,
    HashInteger, HashInteger, HashInt64, HashInt64, HashInt64,
    HashInt64, HashInt64, HashInt64, HashInt64,
    HashAnsiStringI, HashAnsiStringI,
    {$ifdef UNICODE}HashUnicodeStringI{$else}HashAnsiStringI{$endif},
    HashAnsiStringI, HashWideStringI, HashSynUnicodeI, Hash128,
    Hash256, Hash512, HashPointer,
    {$ifndef NOVARIANTS}HashVariantI,{$endif} nil));


/// initialize the structure with a one-dimension dynamic array
// - the dynamic array must have been defined with its own type
// (e.g. TIntegerDynArray = array of Integer)
// - if aCountPointer is set, it will be used instead of length() to store
// the dynamic array items count - it will be much faster when adding
// elements to the array, because the dynamic array won't need to be
// resized each time - but in this case, you should use the Count property
// instead of length(array) or high(array) when accessing the data: in fact
// length(array) will store the memory size reserved, not the items count
// - if aCountPointer is set, its content will be set to 0, whatever the
// array length is, or the current aCountPointer^ value is
// - a typical usage could be:
// !var IntArray: TIntegerDynArray;
// !begin
// !  with DynArray(TypeInfo(TIntegerDynArray),IntArray) do
// !  begin
// !    (...)
// !  end;
// ! (...)
// ! DynArray(TypeInfo(TIntegerDynArray),IntArrayA).SaveTo
function DynArray(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil): TDynArray;
  {$ifdef HASINLINE}inline;{$endif}

/// wrap a simple dynamic array BLOB content as stored by TDynArray.SaveTo
// - a "simple" dynamic array contains data with no reference count, e.g. byte,
// word, integer, cardinal, Int64, double or Currency
// - same as TDynArray.LoadFrom() with no memory allocation nor memory copy: so
// is much faster than creating a temporary dynamic array to load the data
// - will return nil if no or invalid data, or a pointer to the data
// array otherwise, with the items number stored in Count and the individual
// element size in ElemSize (e.g. 2 for a TWordDynArray)
function SimpleDynArrayLoadFrom(Source: PAnsiChar; aTypeInfo: pointer;
  var Count, ElemSize: integer; NoHash32Check: boolean=false): pointer;

/// wrap an Integer dynamic array BLOB content as stored by TDynArray.SaveTo
// - same as TDynArray.LoadFrom() with no memory allocation nor memory copy: so
// is much faster than creating a temporary dynamic array to load the data
// - will return nil if no or invalid data, or a pointer to the integer
// array otherwise, with the items number stored in Count
// - sligtly faster than SimpleDynArrayLoadFrom(Source,TypeInfo(TIntegerDynArray),Count)
function IntegerDynArrayLoadFrom(Source: PAnsiChar; var Count: integer;
  NoHash32Check: boolean=false): PIntegerArray;

/// search in a RawUTF8 dynamic array BLOB content as stored by TDynArray.SaveTo
// - same as search within TDynArray.LoadFrom() with no memory allocation nor
// memory copy: so is much faster
// - will return -1 if no match or invalid data, or the matched entry index
function RawUTF8DynArrayLoadFromContains(Source: PAnsiChar;
  Value: PUTF8Char; ValueLen: integer; CaseSensitive: boolean): integer;


{ ****************** text buffer and JSON functions and classes ************ }

const
  /// maximum number of fields in a database Table
  // - is included in SynCommons so that all DB-related work will be able to
  // share the same low-level types and functions (e.g. TSQLFieldBits,
  // TJSONWriter, TSynTableStatement, TSynTable, TSQLRecordProperties)
  // - default is 64, but can be set to any value (64, 128, 192 and 256 optimized)
  // changing the source below or using MAX_SQLFIELDS_128, MAX_SQLFIELDS_192 or
  // MAX_SQLFIELDS_256 conditional directives for your project
  // - this constant is used internaly to optimize memory usage in the
  // generated asm code, and statically allocate some arrays for better speed
  // - note that due to compiler restriction, 256 is the maximum value
  // (this is the maximum number of items in a Delphi/FPC set)
  {$ifdef MAX_SQLFIELDS_128}
  MAX_SQLFIELDS = 128;
  {$else}
  {$ifdef MAX_SQLFIELDS_192}
  MAX_SQLFIELDS = 192;
  {$else}
  {$ifdef MAX_SQLFIELDS_256}
  MAX_SQLFIELDS = 256;
  {$else}
  MAX_SQLFIELDS = 64;
  {$endif}
  {$endif}
  {$endif}

  /// sometimes, the ID field is included in a bits set
  MAX_SQLFIELDS_INCLUDINGID = MAX_SQLFIELDS+1;

  /// UTF-8 encoded \uFFF0 special code to mark Base64 binary content in JSON
  // - Unicode special char U+FFF0 is UTF-8 encoded as EF BF B0 bytes
  // - as generated by BinToBase64WithMagic() functions, and expected by
  // SQLParamContent() and ExtractInlineParameters() functions
  // - used e.g. when transmitting TDynArray.SaveTo() content
  JSON_BASE64_MAGIC = $b0bfef;

  /// '"' + UTF-8 encoded \uFFF0 special code to mark Base64 binary in JSON
  JSON_BASE64_MAGIC_QUOTE = ord('"')+cardinal(JSON_BASE64_MAGIC) shl 8;

  /// '"' + UTF-8 encoded \uFFF0 special code to mark Base64 binary in JSON
  // - defined as a cardinal variable to be used as:
  // ! AddNoJSONEscape(@JSON_BASE64_MAGIC_QUOTE_VAR,4);
  JSON_BASE64_MAGIC_QUOTE_VAR: cardinal = JSON_BASE64_MAGIC_QUOTE;

  /// UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
  // - e.g. '"\uFFF12012-05-04"' pattern
  // - Unicode special char U+FFF1 is UTF-8 encoded as EF BF B1 bytes
  // - as generated by DateToSQL/DateTimeToSQL/TimeLogToSQL functions, and
  // expected by SQLParamContent() and ExtractInlineParameters() functions
  JSON_SQLDATE_MAGIC = $b1bfef;

  /// '"' + UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
  JSON_SQLDATE_MAGIC_QUOTE = ord('"')+cardinal(JSON_SQLDATE_MAGIC) shl 8;

  ///'"' +  UTF-8 encoded \uFFF1 special code to mark ISO-8601 SQLDATE in JSON
  // - defined as a cardinal variable to be used as:
  // ! AddNoJSONEscape(@JSON_SQLDATE_MAGIC_QUOTE_VAR,4);
  JSON_SQLDATE_MAGIC_QUOTE_VAR: cardinal = JSON_SQLDATE_MAGIC_QUOTE;


type
  TTextWriter = class;

  /// method prototype for custom serialization of a dynamic array item
  // - each element of the dynamic array will be called as aValue parameter
  // of this callback
  // - can be used also at record level, if the record has a type information
  // (i.e. shall contain a managed type within its fields)
  // - to be used with TTextWriter.RegisterCustomJSONSerializer() method
  // - note that the generated JSON content will be appended after a '[' and
  // before a ']' as a normal JSON arrray, but each item can be any JSON
  // structure (i.e. a number, a string, but also an object or an array)
  // - implementation code could call aWriter.Add/AddJSONEscapeString...
  // - implementation code shall follow the same exact format for the
  // associated TDynArrayJSONCustomReader callback
  TDynArrayJSONCustomWriter = procedure(const aWriter: TTextWriter; const aValue) of object;

  /// method prototype for custom unserialization of a dynamic array item
  // - each element of the dynamic array will be called as aValue parameter
  // of this callback
  // - can be used also at record level, if the record has a type information
  // (i.e. shall contain a managed type within its fields)
  // - to be used with TTextWriter.RegisterCustomJSONSerializer() method
  // - implementation code could call e.g. GetJSONField() low-level function, and
  // returns a pointer to the last handled element of the JSON input buffer,
  // as such (aka EndOfBuffer variable as expected by GetJSONField):
  // ! var V: TFV absolute aValue;
  // ! begin
  // !   (...)
  // !   V.Detailed := UTF8ToString(GetJSONField(P,P));
  // !   if P=nil then
  // !     exit;
  // !   aValid := true;
  // !   result := P; // ',' or ']' for last item of array
  // ! end;
  // - implementation code shall follow the same exact format for the
  // associated TDynArrayJSONCustomWriter callback
  TDynArrayJSONCustomReader = function(P: PUTF8Char; var aValue;
    out aValid: Boolean): PUTF8Char of object;

  /// the kind of variables handled by TJSONCustomParser
  // - the last item should be ptCustom, for non simple types
  TJSONCustomParserRTTIType = (
    ptArray, ptBoolean, ptByte, ptCardinal, ptCurrency, ptDouble, ptExtended,
    ptInt64, ptInteger, ptQWord, ptRawByteString, ptRawJSON, ptRawUTF8, ptRecord,
    ptSingle, ptString, ptSynUnicode, ptDateTime, ptDateTimeMS, ptGUID,
    ptID, ptTimeLog, {$ifndef NOVARIANTS} ptVariant, {$endif}
    ptWideString, ptWord, ptCustom);

  /// how TJSONCustomParser would serialize/unserialize JSON content
  TJSONCustomParserSerializationOption = (
    soReadIgnoreUnknownFields, soWriteHumanReadable,
    soCustomVariantCopiedByReference, soWriteIgnoreDefault);

  /// how TJSONCustomParser would serialize/unserialize JSON content
  // - by default, during reading any unexpected field will stop and fail the
  // process - if soReadIgnoreUnknownFields is defined, such properties will
  // be ignored (can be very handy when parsing JSON from a remote service)
  // - by default, JSON content will be written in its compact standard form,
  // ready to be parsed by any client - you can specify soWriteHumanReadable
  // so that some line feeds and indentation will make the content more readable
  // - by default, internal TDocVariant variants will be copied by-value from
  // one instance to another, to ensure proper safety - but it may be too slow:
  // if you set soCustomVariantCopiedByReference, any internal
  // TDocVariantData.VValue/VName instances will be copied by-reference,
  // to avoid memory allocations, BUT it may break internal process if you change
  // some values in place (since VValue/VName and VCount won't match) - as such,
  // if you set this option, ensure that you use the content as read-only
  // - by default, all fields are persistented, unless soWriteIgnoreDefault is
  // defined and void values (e.g. "" or 0) won't be written
  // - you may use TTextWriter.RegisterCustomJSONSerializerSetOptions() class
  // method to customize the serialization for a given type
  TJSONCustomParserSerializationOptions = set of TJSONCustomParserSerializationOption;

  TJSONCustomParserRTTI = class;

  /// an array of RTTI properties information
  // - we use dynamic arrays, since all the information is static and we
  // do not need to remove any RTTI information
  TJSONCustomParserRTTIs = array of TJSONCustomParserRTTI;

  /// used to store additional RTTI in TJSONCustomParser internal structures
  TJSONCustomParserRTTI = class
  protected
    fPropertyName: RawUTF8;
    fFullPropertyName: RawUTF8;
    fPropertyType: TJSONCustomParserRTTIType;
    fCustomTypeName: RawUTF8;
    fNestedProperty: TJSONCustomParserRTTIs;
    fDataSize: integer;
    fNestedDataSize: integer;
    procedure ComputeDataSizeAfterAdd; virtual;
    procedure ComputeNestedDataSize;
    procedure ComputeFullPropertyName;
    procedure FinalizeNestedRecord(var Data: PByte);
    procedure FinalizeNestedArray(var Data: PtrUInt);
    procedure AllocateNestedArray(var Data: PtrUInt; NewLength: integer);
    procedure ReAllocateNestedArray(var Data: PtrUInt; NewLength: integer);
    function IfDefaultSkipped(var Value: PByte): boolean;
    procedure WriteOneSimpleValue(aWriter: TTextWriter; var Value: PByte;
      Options: TJSONCustomParserSerializationOptions);
  public
    /// initialize the instance
    constructor Create(const aPropertyName: RawUTF8;
      aPropertyType: TJSONCustomParserRTTIType);
    /// initialize an instance from the RTTI type information
    // - will return an instance of this class of any inherited class
    class function CreateFromRTTI(const PropertyName: RawUTF8;
      Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
    /// create an instance from a specified type name
    // - will return an instance of this class of any inherited class
    class function CreateFromTypeName(const aPropertyName,
      aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
    /// recognize a simple type from a supplied type name
    // - will return ptCustom for any unknown type
    class function TypeNameToSimpleRTTIType(
      const TypeName: RawUTF8): TJSONCustomParserRTTIType; overload;
    /// recognize a simple type from a supplied type name
    // - will return ptCustom for any unknown type
    class function TypeNameToSimpleRTTIType(
      TypeName: PShortString): TJSONCustomParserRTTIType; overload;
    /// recognize a simple type from a supplied type name
    // - will return ptCustom for any unknown type
    class function TypeNameToSimpleRTTIType(TypeName: PUTF8Char; TypeNameLen: Integer;
      var ItemTypeName: RawUTF8): TJSONCustomParserRTTIType; overload;
    /// recognize a simple type from a supplied type information
    // - to be called if TypeNameToSimpleRTTIType() did fail, i.e. return ptCustom
    // - will return ptCustom for any unknown type
    class function TypeInfoToSimpleRTTIType(Info: pointer; ItemSize: integer): TJSONCustomParserRTTIType;
    /// recognize a ktBinary simple type from a supplied type name
    // - as registered by TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType
    class function TypeNameToSimpleBinary(const aTypeName: RawUTF8;
      out aDataSize, aFieldSize: integer): boolean;
    /// unserialize some JSON content into its binary internal representation
    // - on error, returns false and P should point to the faulty text input
    function ReadOneLevel(var P: PUTF8Char; var Data: PByte;
      Options: TJSONCustomParserSerializationOptions): boolean; virtual;
    /// serialize a binary internal representation into JSON content
    // - this method won't append a trailing ',' character
    procedure WriteOneLevel(aWriter: TTextWriter; var P: PByte;
      Options: TJSONCustomParserSerializationOptions); virtual;
    /// the associated type name, e.g. for a record
    property CustomTypeName: RawUTF8 read fCustomTypeName;
    /// the property name
    // - may be void for the Root element
    // - e.g. 'SubProp'
    property PropertyName: RawUTF8 read fPropertyName;
    /// the property name, including all parent elements
    // - may be void for the Root element
    // - e.g. 'MainProp.SubProp'
    property FullPropertyName: RawUTF8 read fFullPropertyName;
    /// the property type
    // - support only a limited set of simple types, or ptRecord for a nested
    // record, or ptArray for a nested array
    property PropertyType: TJSONCustomParserRTTIType read fPropertyType;
    /// the nested array of properties (if any)
    // - assigned only if PropertyType is [ptRecord,ptArray]
    // - is either the record type of each ptArray item:
    // ! SubProp: array of record ...
    // - or one NestedProperty[0] entry with PropertyName='' and PropertyType
    // not in [ptRecord,ptArray]:
    // ! SubPropNumber: array of integer;
    // ! SubPropText: array of RawUTF8;
    property NestedProperty: TJSONCustomParserRTTIs read fNestedProperty;
  end;

  /// used to store additional RTTI as a ptCustom kind of property
  TJSONCustomParserCustom = class(TJSONCustomParserRTTI)
  protected
    fCustomTypeInfo: pointer;
  public
    /// initialize the instance
    constructor Create(const aPropertyName, aCustomTypeName: RawUTF8); virtual;
    /// abstract method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); virtual; abstract;
    /// abstract method to read the instance from JSON
    // - should return nil on parsing error
    function CustomReader(P: PUTF8Char; var aValue; out EndOfObject: AnsiChar): PUTF8Char; virtual; abstract;
    /// release any memory used by the instance
    procedure FinalizeItem(Data: Pointer); virtual;
    /// the associated RTTI structure
    property CustomTypeInfo: pointer read fCustomTypeInfo;
  end;

  /// which kind of property does TJSONCustomParserCustomSimple refer to
  TJSONCustomParserCustomSimpleKnownType = (
    ktNone, ktEnumeration, ktSet, ktGUID,
    ktFixedArray, ktStaticArray, ktDynamicArray, ktBinary);

  /// used to store additional RTTI for simple type as a ptCustom kind
  // - this class handle currently enumerate, TGUID or static/dynamic arrays
  TJSONCustomParserCustomSimple = class(TJSONCustomParserCustom)
  protected
    fKnownType: TJSONCustomParserCustomSimpleKnownType;
    fTypeData: pointer;
    fFixedSize: integer;
    fNestedArray: TJSONCustomParserRTTI;
  public
    /// initialize the instance from the given RTTI structure
    constructor Create(const aPropertyName, aCustomTypeName: RawUTF8;
      aCustomType: pointer); reintroduce;
    /// initialize the instance for a static array
    constructor CreateFixedArray(const aPropertyName: RawUTF8;
      aFixedSize: cardinal);
    /// initialize the instance for a binary blob
    constructor CreateBinary(const aPropertyName: RawUTF8;
      aDataSize, aFixedSize: cardinal);
    /// released used memory
    destructor Destroy; override;
    /// method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); override;
    /// method to read the instance from JSON
    function CustomReader(P: PUTF8Char; var aValue; out EndOfObject: AnsiChar): PUTF8Char; override;
    /// which kind of simple property this instance does refer to
    property KnownType: TJSONCustomParserCustomSimpleKnownType read fKnownType;
    /// the element type for ktStaticArray and ktDynamicArray
    property NestedArray: TJSONCustomParserRTTI read fNestedArray;
  end;

  /// implement a reference to a registered record type
  // - i.e. ptCustom kind of property, handled by the
  // TTextWriter.RegisterCustomJSONSerializer*() internal list
  TJSONCustomParserCustomRecord = class(TJSONCustomParserCustom)
  protected
    fCustomTypeIndex: integer;
    function GetJSONCustomParserRegistration: pointer;
  public
    /// initialize the instance from the given record custom serialization index
    constructor Create(const aPropertyName: RawUTF8;
      aCustomTypeIndex: integer); reintroduce; overload;
    /// method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); override;
    /// method to read the instance from JSON
    function CustomReader(P: PUTF8Char; var aValue; out EndOfObject: AnsiChar): PUTF8Char; override;
    /// release any memory used by the instance
    procedure FinalizeItem(Data: Pointer); override;
  end;

  /// how an RTTI expression is expected to finish
  TJSONCustomParserRTTIExpectedEnd = (eeNothing, eeSquare, eeCurly, eeEndKeyWord);

  TJSONRecordAbstract = class;

  /// used to handle additional RTTI for JSON record serialization
  // - this class is used to define how a record is defined, and will work
  // with any version of Delphi
  // - this Abstract class is not to be used as-this, but contains all
  // needed information to provide CustomWriter/CustomReader methods
  // - you can use e.g. TJSONRecordTextDefinition for text-based RTTI
  // manual definition, or (not yet provided) a version based on Delphi 2010+
  // new RTTI information
  TJSONRecordAbstract = class
  protected
    /// internal storage of TJSONCustomParserRTTI instances
    fItems: TObjectList;
    fRoot: TJSONCustomParserRTTI;
    fOptions: TJSONCustomParserSerializationOptions;
    function AddItem(const aPropertyName: RawUTF8; aPropertyType: TJSONCustomParserRTTIType;
      const aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
  public
    /// initialize the class instance
    constructor Create;
    /// callback for custom JSON serialization
    // - will follow the RTTI textual information as supplied to the constructor
    procedure CustomWriter(const aWriter: TTextWriter; const aValue);
    /// callback for custom JSON unserialization
    // - will follow the RTTI textual information as supplied to the constructor
    function CustomReader(P: PUTF8Char; var aValue; out aValid: Boolean): PUTF8Char;
    /// release used memory
    // - when created via Compute() call, instances of this class are managed
    // via a GarbageCollector() global list, so you do not need to free them
    destructor Destroy; override;
    /// store the RTTI information of properties at root level
    // - is one instance with PropertyType=ptRecord and PropertyName=''
    property Root: TJSONCustomParserRTTI read fRoot;
    /// how this class would serialize/unserialize JSON content
    // - by default, no option is defined
    // - you can customize the expected options with the instance returned by
    // TTextWriter.RegisterCustomJSONSerializerFromText() method, or via the
    // TTextWriter.RegisterCustomJSONSerializerSetOptions() overloaded methods
    property Options: TJSONCustomParserSerializationOptions read fOptions write fOptions;
  end;

  /// used to handle JSON record serialization using RTTI
  // - is able to handle any kind of record since Delphi 2010, thanks to
  // enhanced RTTI
  TJSONRecordRTTI = class(TJSONRecordAbstract)
  protected
    fRecordTypeInfo: pointer;
    function AddItemFromRTTI(const PropertyName: RawUTF8;
      Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
    {$ifdef ISDELPHI2010}
    procedure FromEnhancedRTTI(Props: TJSONCustomParserRTTI; Info: pointer);
    {$endif}
  public
    /// initialize the instance
    // - you should NOT use this constructor directly, but let e.g.
    // TJSONCustomParsers.TryToGetFromRTTI() create it for you
    constructor Create(aRecordTypeInfo: pointer; aRoot: TJSONCustomParserRTTI); reintroduce;
    /// the low-level address of the enhanced RTTI
    property RecordTypeInfo: pointer read fRecordTypeInfo;
  end;

  /// used to handle text-defined additional RTTI for JSON record serialization
  // - is used by TTextWriter.RegisterCustomJSONSerializerFromText() method
  TJSONRecordTextDefinition = class(TJSONRecordAbstract)
  protected
     fDefinition: RawUTF8;
    procedure Parse(Props: TJSONCustomParserRTTI; var P: PUTF8Char;
      PEnd: TJSONCustomParserRTTIExpectedEnd);
  public
    /// initialize a custom JSON serializer/unserializer from pseudo RTTI
    // - you should NOT use this constructor directly, but call the FromCache()
    // class function, which will use an internal definition cache
    constructor Create(aRecordTypeInfo: pointer; const aDefinition: RawUTF8); reintroduce;
    /// retrieve a custom cached JSON serializer/unserializer from pseudo RTTI
    // - returned class instance will be cached for any further use
    // - the record where the data will be stored should be defined as PACKED:
    // ! type TMyRecord = packed record
    // !   A,B,C: integer;
    // !   D: RawUTF8;
    // !   E: record; // or array of record/integer/string/...
    // !     E1,E2: double;
    // !   end;
    // ! end;
    // - only known sub types are integer, cardinal, Int64, single, double,
    // currency, TDateTime, TTimeLog, RawUTF8, String, WideString, SynUnicode,
    // or a nested record or dynamic array
    // - RTTI textual information shall be supplied as text, with the
    // same format as with a pascal record, or with some shorter variations:
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: record E1,E2: double; end;');
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: array of record E1,E2: double; end;');
    // ! 'A,B,C: integer; D: RawUTF8; E: array of SynUnicode; F: array of integer'
    // or a shorter alternative syntax for records and arrays:
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: {E1,E2: double}');
    // ! FromCache('A,B,C: integer; D: RawUTF8; E: [E1,E2: double]');
    // in fact ; could be ignored:
    // ! FromCache('A,B,C:integer D:RawUTF8 E:{E1,E2:double}');
    // ! FromCache('A,B,C:integer D:RawUTF8 E:[E1,E2:double]');
    // or even : could be ignored:
    // ! FromCache('A,B,C integer D RawUTF8 E{E1,E2 double}');
    // ! FromCache('A,B,C integer D RawUTF8 E[E1,E2 double]');
    class function FromCache(aTypeInfo: pointer;
      const aDefinition: RawUTF8): TJSONRecordTextDefinition;
    /// the textual definition of this RTTI information
    property Definition: RawUTF8 read fDefinition;
  end;

  /// the available logging events, as handled by TSynLog
  // - defined in SynCommons so that it may be used with TTextWriter.AddEndOfLine
  // - sllInfo will log general information events
  // - sllDebug will log detailed debugging information
  // - sllTrace will log low-level step by step debugging information
  // - sllWarning will log unexpected values (not an error)
  // - sllError will log errors
  // - sllEnter will log every method start
  // - sllLeave will log every method exit
  // - sllLastError will log the GetLastError OS message
  // - sllException will log all exception raised - available since Windows XP
  // - sllExceptionOS will log all OS low-level exceptions (EDivByZero,
  // ERangeError, EAccessViolation...)
  // - sllMemory will log memory statistics
  // - sllStackTrace will log caller's stack trace (it's by default part of
  // TSynLogFamily.LevelStackTrace like sllError, sllException, sllExceptionOS,
  // sllLastError and sllFail)
  // - sllFail was defined for TSynTestsLogged.Failed method, and can be used
  // to log some customer-side assertions (may be notifications, not errors)
  // - sllSQL is dedicated to trace the SQL statements
  // - sllCache should be used to trace the internal caching mechanism
  // - sllResult could trace the SQL results, JSON encoded
  // - sllDB is dedicated to trace low-level database engine features
  // - sllHTTP could be used to trace HTTP process
  // - sllClient/sllServer could be used to trace some Client or Server process
  // - sllServiceCall/sllServiceReturn to trace some remote service or library
  // - sllUserAuth to trace user authentication (e.g. for individual requests)
  // - sllCustom* items can be used for any purpose
  // - sllNewRun will be written when a process opens a rotated log
  // - sllDDDError will log any DDD-related low-level error information
  // - sllDDDInfo will log any DDD-related low-level debugging information
  // - sllMonitoring will log the statistics information (if available),
  // or may be used for real-time chat among connected people to ToolsAdmin
  TSynLogInfo = (
    sllNone, sllInfo, sllDebug, sllTrace, sllWarning, sllError,
    sllEnter, sllLeave,
    sllLastError, sllException, sllExceptionOS, sllMemory, sllStackTrace,
    sllFail, sllSQL, sllCache, sllResult, sllDB, sllHTTP, sllClient, sllServer,
    sllServiceCall, sllServiceReturn, sllUserAuth,
    sllCustom1, sllCustom2, sllCustom3, sllCustom4, sllNewRun,
    sllDDDError, sllDDDInfo, sllMonitoring);

  /// used to define a set of logging level abilities
  // - i.e. a combination of none or several logging event
  // - e.g. use LOG_VERBOSE constant to log all events, or LOG_STACKTRACE
  // to log all errors and exceptions
  TSynLogInfos = set of TSynLogInfo;

  /// a dynamic array of logging event levels
  TSynLogInfoDynArray = array of TSynLogInfo;


  /// available options for TTextWriter.WriteObject() method
  // - woHumanReadable will add some line feeds and indentation to the content,
  // to make it more friendly to the human eye
  // - woDontStoreDefault (which is set by default for WriteObject method) will
  // avoid serializing properties including a default value (JSONToObject function
  // will set the default values, so it may help saving some bandwidth or storage)
  // - woFullExpand will generate a debugger-friendly layout, including instance
  // class name, sets/enumerates as text, and reference pointer - as used by
  // TSynLog and ObjectToJSONFull()
  // - woStoreClassName will add a "ClassName":"TMyClass" field
  // - woStorePointer will add a "Address":"0431298A" field, and .map/.mab
  // source code line number corresponding to ESynException.RaisedAt
  // - woStoreStoredFalse will write the 'stored false' properties, even
  // if they are marked as such (used e.g. to persist all settings on file,
  // but disallow the sensitive - password - fields be logged)
  // - woHumanReadableFullSetsAsStar will store an human-readable set with
  // all its enumerates items set to be stored as ["*"]
  // - woHumanReadableEnumSetAsComment will add a comment at the end of the
  // line, containing all available values of the enumaration or set, e.g:
  // $ "Enum": "Destroying", // Idle,Started,Finished,Destroying
  // - woEnumSetsAsText will store sets and enumerables as text (is also
  // included in woFullExpand or woHumanReadable)
  // - woDateTimeWithMagic will append the JSON_SQLDATE_MAGIC (i.e. U+FFF1)
  // before the ISO-8601 encoded TDateTime value
  // - woDateTimeWithZSuffix will append the Z suffix to the ISO-8601 encoded
  // TDateTime value, to identify the content as strict UTC value
  // - TTimeLog would be serialized as Int64, unless woTimeLogAsText is defined
  // - since TSQLRecord.ID could be huge Int64 numbers, they may be truncated
  // on client side, e.g. to 53-bit range in JavaScript: you could define
  // woIDAsIDstr to append an additional "ID_str":"##########" field
  // - by default, TSQLRawBlob properties are serialized as null, unless
  // woSQLRawBlobAsBase64 is defined
  // - if woHideSynPersistentPassword is set, TSynPersistentWithPassword.Password
  // field will be serialized as "***" to prevent security issues (e.g. in log)
  // - by default, TObjectList will set the woStoreClassName for its nested
  // objects, unless woObjectListWontStoreClassName is defined
  // - void strings would be serialized as "", unless woDontStoreEmptyString
  // is defined so that such properties would not be written
  // - all inherited properties would be serialized, unless woDontStoreInherited
  // is defined, and only the topmost class level properties would be serialized
  // - woInt64AsHex will force Int64/QWord to be written as hexadecimal string -
  // see j2oAllowInt64Hex reverse option fot Json2Object
  // - woDontStore0 will avoid serializating number properties equal to 0
  TTextWriterWriteObjectOption = (
    woHumanReadable, woDontStoreDefault, woFullExpand,
    woStoreClassName, woStorePointer, woStoreStoredFalse,
    woHumanReadableFullSetsAsStar, woHumanReadableEnumSetAsComment,
    woEnumSetsAsText, woDateTimeWithMagic, woDateTimeWithZSuffix, woTimeLogAsText,
    woIDAsIDstr, woSQLRawBlobAsBase64, woHideSynPersistentPassword,
    woObjectListWontStoreClassName, woDontStoreEmptyString,
    woDontStoreInherited, woInt64AsHex, woDontStore0);
  /// options set for TTextWriter.WriteObject() method
  TTextWriterWriteObjectOptions = set of TTextWriterWriteObjectOption;

  /// callback used to echo each line of TTextWriter class
  // - should return TRUE on sucess, FALSE if the log was not echoed: but
  // TSynLog will continue logging, even if this event returned FALSE
  TOnTextWriterEcho = function(Sender: TTextWriter; Level: TSynLogInfo;
    const Text: RawUTF8): boolean of object;
  /// callback used by TTextWriter.WriteObject to customize class instance
  // serialization
  // - should return TRUE if the supplied property has been written (including
  // the property name and the ending ',' character), and doesn't need to be
  // processed with the default RTTI-based serializer
  TOnTextWriterObjectProp = function(Sender: TTextWriter; Value: TObject;
    PropInfo: pointer; Options: TTextWriterWriteObjectOptions): boolean of object;

  /// class of our simple writer to a Stream, specialized for the TEXT format
  TTextWriterClass = class of TTextWriter;

  /// the potential places were TTextWriter.HtmlEscape should process
  // proper HTML string escaping
  // $  < > & "  ->   &lt; &gt; &amp; &quote;
  // by default (hfAnyWhere)
  // $  < > &  ->   &lt; &gt; &amp;
  // outside HTML attributes (hfOutsideAttributes)
  // $  & "  ->   &amp; &quote;
  // within HTML attributes (hfWithinAttributes)
  TTextWriterHTMLFormat = (
    hfAnyWhere, hfOutsideAttributes, hfWithinAttributes);

  /// available global options for a TTextWriter instance
  // - TTextWriter.WriteObject() method behavior would be set via their own
  // TTextWriterWriteObjectOptions, and work in conjunction with those settings
  // - twoStreamIsOwned would be set if the associated TStream is owned by
  // the TTextWriter instance
  // - twoFlushToStreamNoAutoResize would forbid FlushToStream to resize the
  // internal memory buffer when it appears undersized - FlushFinal will set it
  // before calling a last FlushToStream
  // - by default, custom serializers defined via RegisterCustomJSONSerializer()
  // would let AddRecordJSON() and AddDynArrayJSON() write enumerates and sets
  // as integer numbers, unless twoEnumSetsAsTextInRecord or
  // twoEnumSetsAsBooleanInRecord (exclusively) are set - for Mustache data
  // context, twoEnumSetsAsBooleanInRecord will return a JSON object with
  // "setname":true/false fields
  // - variants and nested objects would be serialized with their default
  // JSON serialization options, unless twoForceJSONExtended or
  // twoForceJSONStandard is defined
  // - when enumerates and sets are serialized as text into JSON, you may force
  // the identifiers to be left-trimed for all their lowercase characters
  // (e.g. sllError -> 'Error') by setting twoTrimLeftEnumSets: this option
  // would default to the global TTextWriter.SetDefaultEnumTrim setting
  // - twoEndOfLineCRLF would reflect the TTextWriter.EndOfLineCRLF property
  // - twoBufferIsExternal would be set if the temporary buffer is not handled
  // by the instance, but specified at constructor, maybe from the stack
  // - twoIgnoreDefaultInRecord will force custom record serialization to avoid
  // writing the fields with default values, i.e. enable soWriteIgnoreDefault
  // when TJSONCustomParserRTTI.WriteOneLevel is called
  TTextWriterOption = (
    twoStreamIsOwned,
    twoFlushToStreamNoAutoResize,
    twoEnumSetsAsTextInRecord,
    twoEnumSetsAsBooleanInRecord,
    twoFullSetsAsStar,
    twoTrimLeftEnumSets,
    twoForceJSONExtended,
    twoForceJSONStandard,
    twoEndOfLineCRLF,
    twoBufferIsExternal,
    twoIgnoreDefaultInRecord);
  /// options set for a TTextWriter instance
  // - allows to override e.g. AddRecordJSON() and AddDynArrayJSON() behavior;
  // or set global process customization for a TTextWriter
  TTextWriterOptions = set of TTextWriterOption;

  /// may be used to allocate on stack a 8KB work buffer for a TTextWriter
  // - via the TTextWriter.CreateOwnedStream overloaded constructor
  TTextWriterStackBuffer = array[0..8191] of AnsiChar;

  /// simple writer to a Stream, specialized for the TEXT format
  // - use an internal buffer, faster than string+string
  // - some dedicated methods is able to encode any data with JSON escape
  TTextWriter = class
  protected
    B, BEnd: PUTF8Char;
    fStream: TStream;
    fInitialStreamPosition: PtrUInt;
    fTotalFileSize: PtrUInt;
    fCustomOptions: TTextWriterOptions;
    // internal temporary buffer
    fTempBufSize: Integer;
    fTempBuf: PUTF8Char;
    fOnWriteObject: TOnTextWriterObjectProp;
    /// used by WriteObjectAsString/AddDynArrayJSONAsString methods
    fInternalJSONWriter: TTextWriter;
    fHumanReadableLevel: integer;
    fEchoStart: PtrInt;
    fEchoBuf: RawUTF8;
    fEchos: array of TOnTextWriterEcho;
    function GetTextLength: PtrUInt;
    procedure SetStream(aStream: TStream);
    procedure SetBuffer(aBuf: pointer; aBufSize: integer);
    function EchoFlush: PtrInt;
    procedure InternalAddFixedAnsi(Source: PAnsiChar; SourceChars: Cardinal;
      const AnsiToWide: TWordDynArray; Escape: TTextWriterKind);
    function GetEndOfLineCRLF: boolean;
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetEndOfLineCRLF(aEndOfLineCRLF: boolean);
  public
    /// the data will be written to the specified Stream
    // - aStream may be nil: in this case, it MUST be set before using any
    // Add*() method
    // - default internal buffer size if 8192
    constructor Create(aStream: TStream; aBufSize: integer=8192); overload;
    /// the data will be written to the specified Stream
    // - aStream may be nil: in this case, it MUST be set before using any
    // Add*() method
    // - will use an external buffer (which may be allocated on stack)
    constructor Create(aStream: TStream; aBuf: pointer; aBufSize: integer); overload;
    /// the data will be written to an internal TRawByteStringStream
    // - TRawByteStringStream.DataString method will be used by TTextWriter.Text
    // to retrieve directly the content without any data move nor allocation
    // - default internal buffer size if 4096 (enough for most JSON objects)
    // - consider using a stack-allocated buffer and the overloaded method
    constructor CreateOwnedStream(aBufSize: integer=4096); overload;
    /// the data will be written to an internal TRawByteStringStream
    // - will use an external buffer (which may be allocated on stack)
    // - TRawByteStringStream.DataString method will be used by TTextWriter.Text
    // to retrieve directly the content without any data move nor allocation
    constructor CreateOwnedStream(aBuf: pointer; aBufSize: integer); overload;
    /// the data will be written to an internal TRawByteStringStream
    // - will use the stack-allocated TTextWriterStackBuffer if possible
    // - TRawByteStringStream.DataString method will be used by TTextWriter.Text
    // to retrieve directly the content without any data move nor allocation
    constructor CreateOwnedStream(var aStackBuf: TTextWriterStackBuffer;
      aBufSize: integer=SizeOf(TTextWriterStackBuffer)); overload;
    /// the data will be written to an external file
    // - you should call explicitly FlushFinal or FlushToStream to write
    // any pending data to the file
    constructor CreateOwnedFileStream(const aFileName: TFileName; aBufSize: integer=8192);
    /// release all internal structures
    // - e.g. free fStream if the instance was owned by this class
    destructor Destroy; override;
    /// you can use this method to override the default JSON serialization class
    // - if only SynCommons.pas is used, it will be TTextWriter
    // - but mORMot.pas initialization will call it to use the TJSONSerializer
    // instead, which is able to serialize any class as JSON
    class procedure SetDefaultJSONClass(aClass: TTextWriterClass);
    /// you can use this method to retireve the default JSON serialization class
    // - if only SynCommons.pas is used, it will be TTextWriter
    // - but mORMot.pas initialization will call SetDefaultJSONClass to define
    // TJSONSerializer instead, which is able to serialize any class as JSON
    class function GetDefaultJSONClass: TTextWriterClass;
    /// allow to override the default JSON serialization of enumerations and
    // sets as text, which would write the whole identifier (e.g. 'sllError')
    // - calling SetDefaultEnumTrim(true) would force the enumerations to
    // be trimmed for any lower case char, e.g. sllError -> 'Error'
    // - this is global to the current process, and should be use mainly for
    // compatibility purposes for the whole process
    // - you may change the default behavior by setting twoTrimLeftEnumSets
    // in the TTextWriter.CustomOptions property of a given serializer
    // - note that unserialization process would recognize both formats
    class procedure SetDefaultEnumTrim(aShouldTrimEnumsAsText: boolean);

    /// retrieve the data as a string
    function Text: RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// retrieve the data as a string
    // - will avoid creation of a temporary RawUTF8 variable as for Text function
    procedure SetText(var result: RawUTF8; reformat: TTextWriterJSONFormat=jsonCompact);
    /// set the internal stream content with the supplied UTF-8 text
    procedure ForceContent(const text: RawUTF8);
    /// write pending data to the Stream, with automatic buffer resizal
    // - you should not have to call FlushToStream in most cases, but FlushFinal
    // at the end of the process, just before using the resulting Stream
    // - FlushToStream may be used to force immediate writing of the internal
    // memory buffer to the destination Stream
    // - you can set FlushToStreamNoAutoResize=true or call FlushFinal if you
    // do not want the automatic memory buffer resizal to take place
    procedure FlushToStream; virtual;
    /// write pending data to the Stream, without automatic buffer resizal
    // - will append the internal memory buffer to the Stream
    // - in short, FlushToStream may be called during the adding process, and
    // FlushFinal at the end of the process, just before using the resulting Stream
    // - if you don't call FlushToStream or FlushFinal, some pending characters
    // may not be copied to the Stream: you should call it before using the Stream
    procedure FlushFinal;
    /// gives access to an internal temporary TTextWriter
    // - may be used to escape some JSON espaced value (i.e. escape it twice),
    // in conjunction with AddJSONEscape(Source: TTextWriter)
    function InternalJSONWriter: TTextWriter;
    /// add a callback to echo each line written by this class
    // - this class expects AddEndOfLine to mark the end of each line
    procedure EchoAdd(const aEcho: TOnTextWriterEcho);
    /// remove a callback to echo each line written by this class
    // - event should have been previously registered by a EchoAdd() call
    procedure EchoRemove(const aEcho: TOnTextWriterEcho);
    /// reset the internal buffer used for echoing content
    procedure EchoReset;

    /// append one ASCII char to the buffer
    procedure Add(c: AnsiChar); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append two chars to the buffer
    procedure Add(c1,c2: AnsiChar); overload;
      {$ifdef HASINLINE}inline;{$endif}
    {$ifndef CPU64} // already implemented by Add(Value: PtrInt) method
    /// append a 64-bit signed Integer Value as text
    procedure Add(Value: Int64); overload;
    {$endif}
    /// append a 32-bit signed Integer Value as text
    procedure Add(Value: PtrInt); overload;
    /// append a boolean Value as text
    // - write either 'true' or 'false'
    procedure Add(Value: boolean); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append a Currency from its Int64 in-memory representation
    procedure AddCurr64(const Value: Int64); overload;
    /// append a Currency from its Int64 in-memory representation
    procedure AddCurr64(const Value: currency); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append a TTimeLog value, expanded as Iso-8601 encoded text
    procedure AddTimeLog(Value: PInt64);
    /// append a TUnixTime value, expanded as Iso-8601 encoded text
    procedure AddUnixTime(Value: PInt64);
    /// append a TUnixMSTime value, expanded as Iso-8601 encoded text
    procedure AddUnixMSTime(Value: PInt64; WithMS: boolean=false);
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    // - use 'YYYY-MM-DDThh:mm:ss' format (with FirstChar='T')
    // - if WithMS is TRUE, will append '.sss' for milliseconds resolution
    // - if QuoteChar is not #0, it will be written before and after the date
    procedure AddDateTime(Value: PDateTime; FirstChar: AnsiChar='T'; QuoteChar: AnsiChar=#0;
      WithMS: boolean=false); overload;
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    // - use 'YYYY-MM-DDThh:mm:ss' format
    // - if WithMS is TRUE, will append '.sss' for milliseconds resolution
    procedure AddDateTime(const Value: TDateTime;
      WithMS: boolean=false); overload;
    /// append a TDateTime value, expanded as Iso-8601 text with milliseconds
    // and Time Zone designator
    // - i.e. 'YYYY-MM-DDThh:mm:ss.sssZ' format
    // - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
    procedure AddDateTimeMS(const Value: TDateTime; Expanded: boolean=true;
      FirstTimeChar: AnsiChar = 'T'; const TZD: RawUTF8='Z');
    /// append an Unsigned 32-bit Integer Value as a String
    procedure AddU(Value: cardinal);
    /// append an Unsigned 64-bit Integer Value as a String
    procedure AddQ(Value: QWord);
    /// append an Unsigned 64-bit Integer Value as a quoted hexadecimal String
    procedure AddQHex(Value: Qword);
      {$ifdef HASINLINE}inline;{$endif}
    /// append a GUID value, encoded as text without any {}
    // - will store e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
    procedure Add({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID); overload;
    /// append a floating-point Value as a String
    // - write "Infinity", "-Infinity", and "NaN" for corresponding IEEE values
    // - noexp=true will call ExtendedToStringNoExp() to avoid any scientific
    // notation in the resulting text
    procedure AddDouble(Value: double; noexp: boolean=false);
      {$ifdef HASINLINE}inline;{$endif}
    /// append a floating-point Value as a String
    // - write "Infinity", "-Infinity", and "NaN" for corresponding IEEE values
    // - noexp=true will call ExtendedToStringNoExp() to avoid any scientific
    // notation in the resulting text
    procedure AddSingle(Value: single; noexp: boolean=false);
      {$ifdef HASINLINE}inline;{$endif}
    /// append a floating-point Value as a String
    // - write "Infinity", "-Infinity", and "NaN" for corresponding IEEE values
    // - noexp=true will call ExtendedToStringNoExp() to avoid any scientific
    // notation in the resulting text
    procedure Add(Value: Extended; precision: integer; noexp: boolean=false); overload;
    /// append a floating-point text buffer
    // - will correct on the fly '.5' -> '0.5' and '-.5' -> '-0.5'
    // - is used when the input comes from a third-party source with no regular
    // output, e.g. a database driver
    procedure AddFloatStr(P: PUTF8Char);
    /// append strings or integers with a specified format
    // - % = #37 marks a string, integer, floating-point, or class parameter
    // to be appended as text (e.g. class name)
    // - if StringEscape is false (by default), the text won't be escaped before
    // adding; but if set to true text will be JSON escaped at writing
    // - note that due to a limitation of the "array of const" format, cardinal
    // values should be type-casted to Int64() - otherwise the integer mapped
    // value will be transmitted, therefore wrongly
    {$ifdef OLDTEXTWRITERFORMAT}
    // - $ dollar = #36 indicates an integer to be written with 2 digits and a comma
    // - | vertical = #124 will write the next char e.g. Add('%|$',[10]) will write '10$'
    // - pound = #163 indicates an integer to be written with 4 digits and a comma
    // - micro = #181 indicates an integer to be written with 3 digits without any comma
    // - currency = #164 indicates CR+LF chars
    // - section = #167 indicates to trim last comma
    // - since some of this characters above are > #127, they are not UTF-8
    // ready, so we expect the input format to be WinAnsi, i.e. mostly English
    // text (with chars < #128) with some values to be inserted inside
    {$endif}
    procedure Add(const Format: RawUTF8; const Values: array of const;
      Escape: TTextWriterKind=twNone; WriteObjectOptions: TTextWriterWriteObjectOptions=[woFullExpand]); overload;
    /// append some values at once
    // - text values (e.g. RawUTF8) will be escaped as JSON
    procedure Add(const Values: array of const); overload;
    /// append CR+LF (#13#10) chars
    // - this method won't call EchoAdd() registered events - use AddEndOfLine()
    // method instead
    // - AddEndOfLine() will append either CR+LF (#13#10) or LF (#10) depending
    // on a flag
    procedure AddCR;
    /// mark an end of line, ready to be "echoed" to registered listeners
    // - append a LF (#10) char or CR+LF (#13#10) chars to the buffer, depending
    // on the EndOfLineCRLF property value (default is LF, to minimize storage)
    // - any callback registered via EchoAdd() will monitor this line
    // - used e.g. by TSynLog for console output, as stated by Level parameter
    procedure AddEndOfLine(aLevel: TSynLogInfo=sllNone);
    /// append CR+LF (#13#10) chars and #9 indentation
    // - indentation depth is defined by fHumanReadableLevel protected field
    procedure AddCRAndIndent;
    /// write the same character multiple times
    procedure AddChars(aChar: AnsiChar; aCount: integer);
    /// append an Integer Value as a 2 digits String with comma
    procedure Add2(Value: integer);
    /// append the current UTC date and time, in a log-friendly format
    // - e.g. append '20110325 19241502'
    // - you may set LocalTime=TRUE to write the local date and time instead
    // - this method is very fast, and avoid most calculation or API calls
    procedure AddCurrentLogTime(LocalTime: boolean);
    /// append a time period, specified in micro seconds
    procedure AddMicroSec(MS: cardinal);
    /// append an Integer Value as a 4 digits String with comma
    procedure Add4(Value: integer);
    /// append an Integer Value as a 3 digits String without any added comma
    procedure Add3(Value: integer);
    /// append a line of text with CR+LF at the end
    procedure AddLine(const Text: shortstring);
    /// append an UTF-8 String, with no JSON escaping
    procedure AddString(const Text: RawUTF8);
    /// append several UTF-8 strings
    procedure AddStrings(const Text: array of RawUTF8); overload;
    /// append an UTF-8 string several times
    procedure AddStrings(const Text: RawUTF8; count: integer); overload;
    /// append a ShortString
    procedure AddShort(const Text: ShortString);
    /// append a sub-part of an UTF-8  String
    // - emulates AddString(copy(Text,start,len))
    procedure AddStringCopy(const Text: RawUTF8; start,len: integer);
    /// append after trim first lowercase chars ('otDone' will add 'Done' e.g.)
    procedure AddTrimLeftLowerCase(Text: PShortString);
    /// append a ShortString property name, as '"PropName":'
    // - PropName content should not need to be JSON escaped (e.g. no " within,
    // and only ASCII 7-bit characters)
    // - if twoForceJSONExtended is defined in CustomOptions, it would append
    // 'PropName:' without the double quotes
    procedure AddPropName(const PropName: ShortString);
    /// append a JSON field name, followed by an escaped UTF-8 JSON String and
    // a comma (',')
    procedure AddPropJSONString(const PropName: shortstring; const Text: RawUTF8);
    /// append a JSON field name, followed by a number value and a comma (',')
    procedure AddPropJSONInt64(const PropName: shortstring; Value: Int64);
    /// append a RawUTF8 property name, as '"FieldName":'
    // - FieldName content should not need to be JSON escaped (e.g. no " within)
    procedure AddFieldName(const FieldName: RawUTF8); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append a UTF8-encoded property name, as '"FieldName":'
    // - FieldName content should not need to be JSON escaped (e.g. no " within)
    procedure AddFieldName(FieldName: PUTF8Char; FieldNameLen: integer); overload;
    /// append the class name of an Object instance as text
    // - aClass must be not nil
    procedure AddClassName(aClass: TClass);
    /// append an Instance name and pointer, as '"TObjectList(00425E68)"'+SepChar
    // - Instance must be not nil
    procedure AddInstanceName(Instance: TObject; SepChar: AnsiChar);
    /// append an Instance name and pointer, as 'TObjectList(00425E68)'+SepChar
    // - Instance must be not nil
    // - overriden version in TJSONSerializer would implement IncludeUnitName
    procedure AddInstancePointer(Instance: TObject; SepChar: AnsiChar;
      IncludeUnitName, IncludePointer: boolean); virtual;
    /// append a quoted string as JSON, with in-place decoding
    // - if QuotedString does not start with ' or ", it will written directly
    // (i.e. expects to be a number, or null/true/false constants)
    // - as used e.g. by TJSONObjectDecoder.EncodeAsJSON method and
    // JSONEncodeNameSQLValue() function
    procedure AddQuotedStringAsJSON(const QuotedString: RawUTF8);
    /// append an array of integers as CSV
    procedure AddCSVInteger(const Integers: array of Integer); overload;
    /// append an array of doubles as CSV
    procedure AddCSVDouble(const Doubles: array of double); overload;
    /// append an array of RawUTF8 as CSV
    procedure AddCSVUTF8(const Values: array of RawUTF8); overload;
    /// append an array of const as CSV
    procedure AddCSVConst(const Values: array of const);
    /// write some data Base64 encoded
    // - if withMagic is TRUE, will write as '"\uFFF0base64encodedbinary"'
    procedure WrBase64(P: PAnsiChar; Len: cardinal; withMagic: boolean);
    /// write some record content as binary, Base64 encoded with our magic prefix
    procedure WrRecord(const Rec; TypeInfo: pointer);
    /// write some #0 ended UTF-8 text, according to the specified format
    // - if Escape is a constant, consider calling directly AddNoJSONEscape,
    // AddJSONEscape or AddOnSameLine methods
    procedure Add(P: PUTF8Char; Escape: TTextWriterKind); overload;
    /// write some #0 ended UTF-8 text, according to the specified format
    // - if Escape is a constant, consider calling directly AddNoJSONEscape,
    // AddJSONEscape or AddOnSameLine methods
    procedure Add(P: PUTF8Char; Len: PtrInt; Escape: TTextWriterKind); overload;
    /// write some #0 ended Unicode text as UTF-8, according to the specified format
    // - if Escape is a constant, consider calling directly AddNoJSONEscapeW,
    // AddJSONEscapeW or AddOnSameLineW methods
    procedure AddW(P: PWord; Len: PtrInt; Escape: TTextWriterKind);
    /// append some UTF-8 encoded chars to the buffer, from the main AnsiString type
    // - use the current system code page for AnsiString parameter
    procedure AddAnsiString(const s: AnsiString; Escape: TTextWriterKind); overload;
    /// append some UTF-8 encoded chars to the buffer, from any AnsiString value
    // - if CodePage is left to its default value of -1, it will assume
    // CurrentAnsiConvert.CodePage prior to Delphi 2009, but newer UNICODE
    // versions of Delphi will retrieve the code page from string
    // - if CodePage is defined to a >= 0 value, the encoding will take place
    procedure AddAnyAnsiString(const s: RawByteString; Escape: TTextWriterKind;
      CodePage: Integer=-1);
    /// append some UTF-8 encoded chars to the buffer, from any Ansi buffer
    // - the codepage should be specified, e.g. CP_UTF8, CP_RAWBYTESTRING,
    // CODEPAGE_US, or any version supported by the Operating System
    // - if codepage is 0, the current CurrentAnsiConvert.CodePage would be used
    // - will use TSynAnsiConvert to perform the conversion to UTF-8
    procedure AddAnyAnsiBuffer(P: PAnsiChar; Len: integer;
      Escape: TTextWriterKind; CodePage: Integer);
    /// append some UTF-8 chars to the buffer
    // - input length is calculated from zero-ended char
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscape(P: Pointer); overload;
    /// append some UTF-8 chars to the buffer
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscape(P: Pointer; Len: PtrInt); overload;
    /// append some UTF-8 chars to the buffer
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscapeUTF8(const text: RawByteString);
      {$ifdef HASINLINE}inline;{$endif}
    /// flush a supplied TTextWriter, and write pending data as JSON escaped text
    // - may be used with InternalJSONWriter, as a faster alternative to
    // ! AddNoJSONEscapeUTF8(Source.Text);
    procedure AddNoJSONEscape(Source: TTextWriter); overload;
    /// append some UTF-8 chars to the buffer
    // - if supplied json is '', will write 'null'
    procedure AddRawJSON(const json: RawJSON);
    /// append some chars, quoting all " chars
    // - same algorithm than AddString(QuotedStr()) - without memory allocation,
    // and with an optional maximum text length (truncated with ending '...')
    // - this function implements what is specified in the official SQLite3
    // documentation: "A string constant is formed by enclosing the string in single
    // quotes ('). A single quote within the string can be encoded by putting two
    // single quotes in a row - as in Pascal."
    procedure AddQuotedStr(Text: PUTF8Char; Quote: AnsiChar; TextMaxLen: integer=0);
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscape(Text: PUTF8Char; Fmt: TTextWriterHTMLFormat=hfAnyWhere); overload;
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscape(Text: PUTF8Char; TextLen: integer;
      Fmt: TTextWriterHTMLFormat=hfAnyWhere); overload;
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscapeString(const Text: string;
      Fmt: TTextWriterHTMLFormat=hfAnyWhere);
    /// append some chars, escaping all HTML special chars as expected
    procedure AddHtmlEscapeUTF8(const Text: RawUTF8;
      Fmt: TTextWriterHTMLFormat=hfAnyWhere);
    /// convert some wiki-like text into proper HTML
    // - convert all #13#10 into <p>...</p>, *..* into <i>..</i> and +..+ into
    // <b>..</b>, then escape http:// as <a href=...> and any HTML special chars
    procedure AddHtmlEscapeWiki(P: PUTF8Char);
    /// append some chars, escaping all XML special chars as expected
    // - i.e.   < > & " '  as   &lt; &gt; &amp; &quote; &apos;
    // - and all control chars (i.e. #1..#31) as &#..;
    // - see @http://www.w3.org/TR/xml/#syntax
    procedure AddXmlEscape(Text: PUTF8Char);
    /// append some chars, replacing a given character with another
    procedure AddReplace(Text: PUTF8Char; Orig,Replaced: AnsiChar);
    /// append some binary data as hexadecimal text conversion
    procedure AddBinToHex(Bin: Pointer; BinBytes: integer);
    /// fast conversion from binary data into hexa chars, ready to be displayed
    // - using this function with Bin^ as an integer value will serialize it
    // in big-endian order (most-significant byte first), as used by humans
    // - up to the internal buffer bytes may be converted
    procedure AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
    /// fast conversion from binary data into MSB hexa chars
    // - up to the internal buffer bytes may be converted
    procedure AddBinToHexDisplayLower(Bin: pointer; BinBytes: integer);
    /// fast conversion from binary data into quoted MSB lowercase hexa chars
    // - up to the internal buffer bytes may be converted
    procedure AddBinToHexDisplayQuoted(Bin: pointer; BinBytes: integer);
    /// append a Value as significant hexadecimal text
    // - append its minimal size, i.e. excluding highest bytes containing 0
    // - use GetNextItemHexa() to decode such a text value
    procedure AddBinToHexDisplayMinChars(Bin: pointer; BinBytes: PtrInt);
    /// add the pointer into significant hexa chars, ready to be displayed
    procedure AddPointer(P: PtrUInt);    {$ifdef HASINLINE}inline;{$endif}
    /// write a byte as hexa chars
    procedure AddByteToHex(Value: byte);
    /// write a Int18 value (0..262143) as 3 chars
    // - this encoding is faster than Base64, and has spaces on the left side
    // - use function Chars3ToInt18() to decode the textual content
    procedure AddInt18ToChars3(Value: cardinal);
    /// append some unicode chars to the buffer
    // - WideCharCount is the unicode chars count, not the byte size
    // - don't escapes chars according to the JSON RFC
    // - will convert the Unicode chars into UTF-8
    procedure AddNoJSONEscapeW(WideChar: PWord; WideCharCount: integer);
    /// append some UTF-8 encoded chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended char
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscape(P: Pointer; Len: PtrInt=0); overload;
    /// append some UTF-8 encoded chars to the buffer, from a generic string type
    // - faster than AddJSONEscape(pointer(StringToUTF8(string))
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeString(const s: string);  {$ifdef HASINLINE}inline;{$endif}
    /// append some UTF-8 encoded chars to the buffer, from the main AnsiString type
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeAnsiString(const s: AnsiString);
    /// append some UTF-8 encoded chars to the buffer, from a generic string type
    // - faster than AddNoJSONEscape(pointer(StringToUTF8(string))
    // - don't escapes chars according to the JSON RFC
    // - will convert the Unicode chars into UTF-8
    procedure AddNoJSONEscapeString(const s: string);  {$ifdef UNICODE}inline;{$endif}
    /// append some Unicode encoded chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended widechar
    // - escapes chars according to the JSON RFC
    procedure AddJSONEscapeW(P: PWord; Len: PtrInt=0);
    /// append an open array constant value to the buffer
    // - "" will be added if necessary
    // - escapes chars according to the JSON RFC
    // - very fast (avoid most temporary storage)
    procedure AddJSONEscape(const V: TVarRec); overload;
    /// flush a supplied TTextWriter, and write pending data as JSON escaped text
    // - may be used with InternalJSONWriter, as a faster alternative to
    // ! AddJSONEscape(Pointer(fInternalJSONWriter.Text),0);
    procedure AddJSONEscape(Source: TTextWriter); overload;
    /// append a UTF-8 JSON String, between double quotes and with JSON escaping
    procedure AddJSONString(const Text: RawUTF8);
    /// append an open array constant value to the buffer
    // - "" won't be added for string values
    // - string values may be escaped, depending on the supplied parameter
    // - very fast (avoid most temporary storage)
    procedure Add(const V: TVarRec; Escape: TTextWriterKind=twNone;
      WriteObjectOptions: TTextWriterWriteObjectOptions=[woFullExpand]); overload;
    /// encode the supplied data as an UTF-8 valid JSON object content
    // - data must be supplied two by two, as Name,Value pairs, e.g.
    // ! aWriter.AddJSONEscape(['name','John','year',1972]);
    // will append to the buffer:
    // ! '{"name":"John","year":1972}'
    // - or you can specify nested arrays or objects with '['..']' or '{'..'}':
    // ! aWriter.AddJSONEscape(['doc','{','name','John','ab','[','a','b']','}','id',123]);
    // will append to the buffer:
    // ! '{"doc":{"name":"John","abc":["a","b"]},"id":123}'
    // - note that, due to a Delphi compiler limitation, cardinal values should be
    // type-casted to Int64() (otherwise the integer mapped value will be converted)
    // - you can pass nil as parameter for a null JSON value
    procedure AddJSONEscape(const NameValuePairs: array of const); overload;
    {$ifndef NOVARIANTS}
    /// encode the supplied (extended) JSON content, with parameters,
    // as an UTF-8 valid JSON object content
    // - in addition to the JSON RFC specification strict mode, this method will
    // handle some BSON-like extensions, e.g. unquoted field names:
    // ! aWriter.AddJSON('{id:?,%:{name:?,birthyear:?}}',['doc'],[10,'John',1982]);
    // - you can use nested _Obj() / _Arr() instances
    // ! aWriter.AddJSON('{%:{$in:[?,?]}}',['type'],['food','snack']);
    // ! aWriter.AddJSON('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
    // ! // which are the same as:
    // ! aWriter.AddShort('{"type":{"$in":["food","snack"]}}');
    // - if the SynMongoDB unit is used in the application, the MongoDB Shell
    // syntax will also be recognized to create TBSONVariant, like
    // ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
    // see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
    // !  aWriter.AddJSON('{name:?,field:/%/i}',['acme.*corp'],['John']))
    // ! // will write
    // ! '{"name":"John","field":{"$regex":"acme.*corp","$options":"i"}}'
    // - will call internally _JSONFastFmt() to create a temporary TDocVariant
    // with all its features - so is slightly slower than other AddJSON* methods
    procedure AddJSON(const Format: RawUTF8; const Args,Params: array of const);
    {$endif}
    /// append two JSON arrays of keys and values as one JSON object
    // - i.e. makes the following transformation:
    // $ [key1,key2...] + [value1,value2...] -> {key1:value1,key2,value2...}
    // - this method won't allocate any memory during its process, nor
    // modify the keys and values input buffers
    // - is the reverse of the JSONObjectAsJSONArrays() function
    procedure AddJSONArraysAsJSONObject(keys,values: PUTF8Char);
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - expect a dynamic array TDynArray wrapper as incoming parameter
    // - TIntegerDynArray, TInt64DynArray, TCardinalDynArray, TDoubleDynArray,
    // TCurrencyDynArray, TWordDynArray and TByteDynArray will be written as
    // numerical JSON values
    // - TRawUTF8DynArray, TWinAnsiDynArray, TRawByteStringDynArray,
    // TStringDynArray, TWideStringDynArray, TSynUnicodeDynArray, TTimeLogDynArray,
    // and TDateTimeDynArray will be written as escaped UTF-8 JSON strings
    // (and Iso-8601 textual encoding if necessary)
    // - you can add some custom serializers via RegisterCustomJSONSerializer()
    // class method, to serialize any dynamic array as valid JSON
    // - any other non-standard or non-registered kind of dynamic array (including
    // array of records) will be written as Base64 encoded binary stream, with a
    // JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code) - this will
    // include TBytes (i.e. array of bytes) content, which is a good candidate
    // for BLOB stream
    // - typical content could be
    // ! '[1,2,3,4]' or '["\uFFF0base64encodedbinary"]'
    // - by default, custom serializers defined via RegisterCustomJSONSerializer()
    // would write enumerates and sets as integer numbers, unless
    // twoEnumSetsAsTextInRecord is set in the instance Options
    procedure AddDynArrayJSON(var aDynArray: TDynArray); overload;
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - expect a dynamic array TDynArrayHashed wrapper as incoming parameter
    procedure AddDynArrayJSON(var aDynArray: TDynArrayHashed); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// append a dynamic array content as UTF-8 encoded JSON array
    // - just a wrapper around the other overloaded method, creating a
    // temporary TDynArray wrapper on the stack
    // - to be used e.g. for custom record JSON serialization, within a
    // TDynArrayJSONCustomWriter callback
    procedure AddDynArrayJSON(aTypeInfo: pointer; const aValue); overload;
    /// same as AddDynArrayJSON(), but will double all internal " and bound with "
    // - this implementation will avoid most memory allocations
    procedure AddDynArrayJSONAsString(aTypeInfo: pointer; var aValue);
    /// append a T*ObjArray dynamic array as a JSON array
    // - as expected by TJSONSerializer.RegisterObjArrayForJSON()
    procedure AddObjArrayJSON(const aObjArray;
      aOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// append a record content as UTF-8 encoded JSON or custom serialization
    // - default serialization will use Base64 encoded binary stream, or
    // a custom serialization, in case of a previous registration via
    // RegisterCustomJSONSerializer() class method - from a dynamic array
    // handling this kind of records, or directly from TypeInfo() of the record
    // - by default, custom serializers defined via RegisterCustomJSONSerializer()
    // would write enumerates and sets as integer numbers, unless
    // twoEnumSetsAsTextInRecord or twoEnumSetsAsBooleanInRecord is set in
    // the instance CustomOptions
    procedure AddRecordJSON(const Rec; TypeInfo: pointer);
    {$ifndef NOVARIANTS}
    /// append a variant content as number or string
    // - default Escape=twJSONEscape will create valid JSON content, which
    // can be converted back to a variant value using VariantLoadJSON()
    // - default JSON serialization options would apply, unless
    // twoForceJSONExtended or twoForceJSONStandard is defined
    // - note that before Delphi 2009, any varString value is expected to be
    // a RawUTF8 instance - which does make sense in the mORMot context
    procedure AddVariant(const Value: variant; Escape: TTextWriterKind=twJSONEscape);
    {$endif}
    /// append a void record content as UTF-8 encoded JSON or custom serialization
    // - this method will first create a void record (i.e. filled with #0 bytes)
    // then save its content with default or custom serialization
    procedure AddVoidRecordJSON(TypeInfo: pointer);
    /// append a JSON value from its RTTI type
    // - handle tkClass,tkEnumeration,tkSet,tkRecord,tkDynArray,tkVariant types
    // - write null for other types
    procedure AddTypedJSON(aTypeInfo: pointer; const aValue);
    /// serialize as JSON the given object
    // - this default implementation will write null, or only write the
    // class name and pointer if FullExpand is true - use TJSONSerializer.
    // WriteObject method for full RTTI handling
    // - default implementation will write TList/TCollection/TStrings/TRawUTF8List
    // as appropriate array of class name/pointer (if woFullExpand is set)
    procedure WriteObject(Value: TObject;
      Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]); virtual;
    /// same as WriteObject(), but will double all internal " and bound with "
    // - this implementation will avoid most memory allocations
    procedure WriteObjectAsString(Value: TObject;
      Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// append a JSON value, array or document as simple XML content
    // - you can use JSONBufferToXML() and JSONToXML() functions as wrappers
    // - this method is called recursively to handle all kind of JSON values
    // - WARNING: the JSON buffer is decoded in-place, so will be changed
    // - returns the end of the current JSON converted level, or nil if the
    // supplied content was not correct JSON
    function AddJSONToXML(JSON: PUTF8Char; ArrayName: PUTF8Char=nil;
      EndOfObject: PUTF8Char=nil): PUTF8Char;
    /// append a JSON value, array or document, in a specified format
    // - will parse the JSON buffer and write its content with proper line
    // feeds and indentation, according to the supplied TTextWriterJSONFormat
    // - see also JSONReformat() and JSONBufferReformat() wrappers
    // - this method is called recursively to handle all kind of JSON values
    // - WARNING: the JSON buffer is decoded in-place, so will be changed
    // - returns the end of the current JSON converted level, or nil if the
    // supplied content was not valid JSON
    function AddJSONReformat(JSON: PUTF8Char; Format: TTextWriterJSONFormat;
       EndOfObject: PUTF8Char): PUTF8Char;

    /// define a custom serialization for a given dynamic array or record
    // - expects TypeInfo() from a dynamic array or a record (will raise an
    // exception otherwise)
    // - for a dynamic array, the associated item record RTTI will be registered
    // - for a record, any matching dynamic array will also be registered
    // - by default, TIntegerDynArray and such known classes are processed as
    // true JSON arrays: but you can specify here some callbacks to perform
    // the serialization process for any kind of dynamic array
    // - any previous registration is overridden
    // - setting both aReader=aWriter=nil will return back to the default
    // binary + Base64 encoding serialization (i.e. undefine custom serializer)
    class procedure RegisterCustomJSONSerializer(aTypeInfo: pointer;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    {$ifndef NOVARIANTS}
    /// define a custom serialization for a given variant custom type
    // - used e.g. to serialize TBCD values
    class procedure RegisterCustomJSONSerializerForVariant(aClass: TCustomVariantType;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    /// define a custom serialization for a given variant custom type
    // - used e.g. to serialize TBCD values
    class procedure RegisterCustomJSONSerializerForVariantByType(aVarType: TVarType;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    {$endif NOVARIANTS}
    /// define a custom serialization for a given dynamic array or record
    // - the RTTI information will here be defined as plain text
    // - since Delphi 2010, you can call directly
    // RegisterCustomJSONSerializerFromTextSimpleType()
    // - aTypeInfo may be valid TypeInfo(), or any fixed pointer value if the
    // record does not have any RTTI (e.g. a record without any nested reference-
    // counted types)
    // - the record where the data will be stored should be defined as PACKED:
    // ! type TMyRecord = packed record
    // !   A,B,C: integer;
    // !   D: RawUTF8;
    // !   E: record; // or array of record/integer/string/...
    // !     E1,E2: double;
    // !   end;
    // ! end;
    // - call this method with aRTTIDefinition='' to return back to the default
    // binary + Base64 encoding serialization (i.e. undefine custom serializer)
    // - only known sub types are byte, word, integer, cardinal, Int64, single,
    // double, currency, TDateTime, TTimeLog, RawUTF8, String, WideString,
    // SynUnicode, TGUID (encoded via GUIDToText) or a nested record or dynamic
    // array of the same simple types or record
    // - RTTI textual information shall be supplied as text, with the
    // same format as with a pascal record:
    // ! 'A,B,C: integer; D: RawUTF8; E: record E1,E2: double;'
    // ! 'A,B,C: integer; D: RawUTF8; E: array of record E1,E2: double;'
    // ! 'A,B,C: integer; D: RawUTF8; E: array of SynUnicode; F: array of TGUID'
    // or a shorter alternative syntax for records and arrays:
    // ! 'A,B,C: integer; D: RawUTF8; E: {E1,E2: double}'
    // ! 'A,B,C: integer; D: RawUTF8; E: [E1,E2: double]'
    // in fact ; could be ignored:
    // ! 'A,B,C:integer D:RawUTF8 E:{E1,E2:double}'
    // ! 'A,B,C:integer D:RawUTF8 E:[E1,E2:double]'
    // or even : could be ignored:
    // ! 'A,B,C integer D RawUTF8 E{E1,E2 double}'
    // ! 'A,B,C integer D RawUTF8 E[E1,E2 double]'
    // - it will return the cached TJSONRecordTextDefinition
    // instance corresponding to the supplied RTTI text definition
    class function RegisterCustomJSONSerializerFromText(aTypeInfo: pointer;
      const aRTTIDefinition: RawUTF8): TJSONRecordAbstract; overload;
    /// define a custom serialization for several dynamic arrays or records
    // - the TypeInfo() and textual RTTI information will here be defined as
    // ([TypeInfo(TType1),_TType1,TypeInfo(TType2),_TType2]) pairs
    // - a wrapper around the overloaded RegisterCustomJSONSerializerFromText()
    class procedure RegisterCustomJSONSerializerFromText(
      const aTypeInfoTextDefinitionPairs: array of const); overload;
    /// change options for custom serialization of dynamic array or record
    // - will return TRUE if the options have been changed, FALSE if the
    // supplied type info was not previously registered
    // - if AddIfNotExisting is TRUE, and enhanced RTTI is available (since
    // Delphi 2010), you would be able to customize the options of this type
    class function RegisterCustomJSONSerializerSetOptions(aTypeInfo: pointer;
      aOptions: TJSONCustomParserSerializationOptions;
      aAddIfNotExisting: boolean=false): boolean; overload;
    /// change options for custom serialization of dynamic arrays or records
    // - will return TRUE if the options have been changed, FALSE if the
    // supplied type info was not previously registered for at least one type
    // - if AddIfNotExisting is TRUE, and enhanced RTTI is available (since
    // Delphi 2010), you would be able to customize the options of this type
    class function RegisterCustomJSONSerializerSetOptions(
      const aTypeInfo: array of pointer; aOptions: TJSONCustomParserSerializationOptions;
      aAddIfNotExisting: boolean=false): boolean; overload;
    /// retrieve a previously registered custom parser instance from its type
    // - will return nil if the type info was not available, or defined just
    // with some callbacks
    // - if AddIfNotExisting is TRUE, and enhanced RTTI is available (since
    // Delphi 2010), you would be able to retrieve this type's parser even
    // if the record type has not been previously used
    class function RegisterCustomJSONSerializerFindParser(
      aTypeInfo: pointer; aAddIfNotExisting: boolean=false): TJSONRecordAbstract;
    /// define a custom serialization for a given simple type
    // - you should be able to use this type in the RTTI text definition
    // of any further RegisterCustomJSONSerializerFromText() call
    // - the RTTI information should be enough to serialize the type from
    // its name (e.g. an enumeration for older Delphi revision, but all records
    // since Delphi 2010)
    // - you can supply a custom type name, which will be registered in addition
    // to the "official" name defined at RTTI level
    // - on older Delphi versions (up to Delphi 2009), it will handle only
    // enumerations, which will be transmitted as JSON string instead of numbers
    // - since Delphi 2010, any record type can be supplied - which is more
    // convenient than calling RegisterCustomJSONSerializerFromText()
    class procedure RegisterCustomJSONSerializerFromTextSimpleType(aTypeInfo: pointer;
      const aTypeName: RawUTF8=''); overload;
    /// define a custom binary serialization for a given simple type
    // - you should be able to use this type in the RTTI text definition
    // of any further RegisterCustomJSONSerializerFromText() call
    // - data will be serialized as BinToHexDisplayLower() JSON hexadecimal string
    // - you can truncate the original data size (e.g. if all bits of an integer
    // are not used) by specifying the aFieldSize optional parameter
    class procedure RegisterCustomJSONSerializerFromTextBinaryType(aTypeInfo: pointer;
      aDataSize: integer; aFieldSize: integer=0); overload;
    /// define custom binary serialization for several simple types
    // - data will be serialized as BinToHexDisplayLower() JSON hexadecimal string
    // - the TypeInfo() and associated size information will here be defined as triplets:
    // ([TypeInfo(TType1),SizeOf(TType1),TYPE1_BYTES,TypeInfo(TType2),SizeOf(TType2),TYPE2_BYTES])
    // - a wrapper around the overloaded RegisterCustomJSONSerializerFromTextBinaryType()
    class procedure RegisterCustomJSONSerializerFromTextBinaryType(
      const aTypeInfoDataFieldSize: array of const); overload;
    /// define a custom serialization for several simple types
    // - will call the overloaded RegisterCustomJSONSerializerFromTextSimpleType
    // method for each supplied type information
    class procedure RegisterCustomJSONSerializerFromTextSimpleType(
       const aTypeInfos: array of pointer); overload;
    /// undefine a custom serialization for a given dynamic array or record
    // - it will un-register any callback or text-based custom serialization
    // i.e. any previous RegisterCustomJSONSerializer() or
    // RegisterCustomJSONSerializerFromText() call
    // - expects TypeInfo() from a dynamic array or a record (will raise an
    // exception otherwise)
    // - it will set back to the default binary + Base64 encoding serialization
    class procedure UnRegisterCustomJSONSerializer(aTypeInfo: pointer);

    /// append some chars to the buffer in one line
    // - P should be ended with a #0
    // - will write #1..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLine(P: PUTF8Char); overload;
    /// append some chars to the buffer in one line
    // - will write #0..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLine(P: PUTF8Char; Len: PtrInt); overload;
    /// append some wide chars to the buffer in one line
    // - will write #0..#31 chars as spaces (so content will stay on the same line)
    procedure AddOnSameLineW(P: PWord; Len: PtrInt);

    /// return the last char appended
    function LastChar: AnsiChar;
    /// how many bytes are currently in the internal buffer and not on disk
    // - see TextLength for the total number of bytes, on both disk and memory
    function PendingBytes: PtrUInt;
      {$ifdef HASINLINE}inline;{$endif}
    /// how many bytes were currently written on disk
    // - excluding the bytes in the internal buffer
    // - see TextLength for the total number of bytes, on both disk and memory
    property WrittenBytes: PtrUInt read fTotalFileSize;
    /// the last char appended is canceled
    procedure CancelLastChar; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// the last char appended is canceled, if match the supplied one
    procedure CancelLastChar(aCharToCancel: AnsiChar); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// the last char appended is canceled if it was a ','
    procedure CancelLastComma;
      {$ifdef HASINLINE}inline;{$endif}
    /// rewind the Stream to the position when Create() was called
    // - note that this does not clear the Stream content itself, just
    // move back its writing position to its initial place
    procedure CancelAll;

    /// count of added bytes to the stream
    // - see PendingBytes for the number of bytes currently in the memory buffer
    // or WrittenBytes for the number of bytes already written to disk
    property TextLength: PtrUInt read GetTextLength;
    /// define how AddEndOfLine method stores its line feed characters
    // - by default (FALSE), it will append a LF (#10) char to the buffer
    // - you can set this property to TRUE, so that CR+LF (#13#10) chars will
    // be appended instead
    // - is just a wrapper around twoEndOfLineCRLF item in CustomOptions
    property EndOfLineCRLF: boolean read GetEndOfLineCRLF write SetEndOfLineCRLF;
    /// allows to override default WriteObject property JSON serialization
    property OnWriteObject: TOnTextWriterObjectProp read fOnWriteObject write fOnWriteObject;
    /// the internal TStream used for storage
    // - you should call the FlushFinal (or FlushToStream) methods before using
    // this TStream content, to flush all pending characters
    // - if the TStream instance has not been specified when calling the
    // TTextWriter constructor, it can be forced via this property, before
    // any writting
    property Stream: TStream read fStream write SetStream;
    /// global options to customize this TTextWriter instance process
    // - allows to override e.g. AddRecordJSON() and AddDynArrayJSON() behavior
    property CustomOptions: TTextWriterOptions read fCustomOptions write fCustomOptions;
  end;

/// serialize most kind of content as JSON, using its RTTI
// - is just a wrapper around TTextWriter.AddTypedJSON()
// - so would handle tkClass, tkEnumeration, tkSet, tkRecord, tkDynArray,
// tkVariant kind of content - other kinds would return 'null'
// - you can override serialization options if needed
procedure SaveJSON(const Value; TypeInfo: pointer;
  Options: TTextWriterOptions; var result: RawUTF8); overload;

/// serialize most kind of content as JSON, using its RTTI
// - is just a wrapper around TTextWriter.AddTypedJSON()
// - so would handle tkClass, tkEnumeration, tkSet, tkRecord, tkDynArray,
// tkVariant kind of content - other kinds would return 'null'
function SaveJSON(const Value; TypeInfo: pointer;
  EnumSetsAsText: boolean=false): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// will serialize any TObject into its UTF-8 JSON representation
/// - serialize as JSON the published integer, Int64, floating point values,
// TDateTime (stored as ISO 8601 text), string, variant and enumerate
// (e.g. boolean) properties of the object (and its parents)
// - would set twoForceJSONStandard to force standard (non-extended) JSON
// - the enumerates properties are stored with their integer index value
// - will write also the properties published in the parent classes
// - nested properties are serialized as nested JSON objects
// - any TCollection property will also be serialized as JSON arrays
// - you can add some custom serializers for ANY Delphi class, via mORMot.pas'
// TJSONSerializer.RegisterCustomSerializer() class method
// - call internaly TJSONSerializer.WriteObject() method (or fallback to
// TJSONWriter if mORMot.pas is not linked to the executable)
function ObjectToJSON(Value: TObject;
  Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;

/// will serialize set of TObject into its UTF-8 JSON representation
// - follows ObjectToJSON()/TTextWriter.WriterObject() functions output
// - if Names is not supplied, the corresponding class names would be used
function ObjectsToJSON(const Names: array of RawUTF8; const Values: array of TObject;
  Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;


type
  /// implement a cache of some key/value pairs, e.g. to improve reading speed
  // - used e.g. by TSQLDataBase for caching the SELECT statements results in an
  // internal JSON format (which is faster than a query to the SQLite3 engine)
  // - internally make use of an efficient hashing algorithm for fast response
  // (i.e. TSynNameValue will use the TDynArrayHashed wrapper mechanism)
  // - this class is thread-safe if you use properly the associated Safe lock
  TSynCache = class(TSynPersistentLock)
  protected
    /// last index in fNameValue.List[] if was added by Find()
    // - contains -1 if no previous immediate call to Find()
    fFindLastAddedIndex: integer;
    fFindLastKey: RawUTF8;
    fNameValue: TSynNameValue;
    fRamUsed: cardinal;
    fMaxRamUsed: cardinal;
    fTimeoutSeconds: cardinal;
    fTimeoutTix: cardinal;
    procedure ResetIfNeeded;
  public
    /// initialize the internal storage
    // - aMaxCacheRamUsed can set the maximum RAM to be used for values, in bytes
    // (default is 16 MB), after which the cache is flushed
    // - by default, key search is done case-insensitively, but you can specify
    // another option here
    // - by default, there is no timeout period, but you may specify a number of
    // seconds of inactivity (i.e. no Add call) after which the cache is flushed
    constructor Create(aMaxCacheRamUsed: cardinal=16 shl 20;
      aCaseSensitive: boolean=false; aTimeoutSeconds: cardinal=0); reintroduce;
    /// find a Key in the cache entries
    // - return '' if nothing found: you may call Add() just after to insert
    // the expected value in the cache
    // - return the associated Value otherwise, and the associated integer tag
    // if aResultTag address is supplied
    // - this method is not thread-safe, unless you call Safe.Lock before
    // calling Find(), and Safe.Unlock after calling Add()
    function Find(const aKey: RawUTF8; aResultTag: PPtrInt=nil): RawUTF8;
    /// add a Key and its associated value (and tag) to the cache entries
    // - you MUST always call Find() with the associated Key first
    // - this method is not thread-safe, unless you call Safe.Lock before
    // calling Find(), and Safe.Unlock after calling Add()
    procedure Add(const aValue: RawUTF8; aTag: PtrInt);
    /// add a Key/Value pair in the cache entries
    // - returns true if aKey was not existing yet, and aValue has been stored
    // - returns false if aKey did already exist in the internal cache, and
    // its entry has been updated with the supplied aValue/aTag
    // - this method is thread-safe, using the Safe locker of this instance
    function AddOrUpdate(const aKey, aValue: RawUTF8; aTag: PtrInt): boolean;
    /// called after a write access to the database to flush the cache
    // - set Count to 0
    // - release all cache memory
    // - returns TRUE if was flushed, i.e. if there was something in cache
    // - this method is thread-safe, using the Safe locker of this instance
    function Reset: boolean;
    /// number of entries in the cache
    function Count: integer;
    /// access to the internal locker, for thread-safe process
    // - Find/Add methods calls should be protected as such:
    // ! cache.Safe.Lock;
    // ! try
    // !   ... cache.Find/cache.Add ...
    // ! finally
    // !   cache.Safe.Unlock;
    // ! end;
    property Safe: PSynLocker read fSafe;
    /// the current global size of Values in RAM cache, in bytes
    property RamUsed: cardinal read fRamUsed;
    /// the maximum RAM to be used for values, in bytes
    // - the cache is flushed when ValueSize reaches this limit
    // - default is 16 MB (16 shl 20)
    property MaxRamUsed: cardinal read fMaxRamUsed;
    /// after how many seconds betwen Add() calls the cache should be flushed
    // - equals 0 by default, meaning no time out
    property TimeoutSeconds: cardinal read fTimeoutSeconds;
  end;


  /// abstract ancestor to manage a dynamic array of TObject
  // - do not use this abstract class directly, but rather the inherited
  // TObjectListHashed and TObjectListPropertyHashed
  TObjectListHashedAbstract = class
  protected
    fList: TObjectDynArray;
    fCount: integer;
    fHash: TDynArrayHashed;
    fFreeItems: boolean;
  public
    /// initialize the class instance
    // - if aFreeItems is TRUE (default), will behave like a TObjectList
    // - if aFreeItems is FALSE, will behave like a TList
    constructor Create(aFreeItems: boolean=true); reintroduce;
    /// release used memory
    destructor Destroy; override;
    /// search and add an object reference to the list
    // - returns the found/added index
    function Add(aObject: TObject; out wasAdded: boolean): integer; virtual; abstract;
    /// retrieve an object index within the list, using a fast hash table
    // - returns -1 if not found
    function IndexOf(aObject: TObject): integer; virtual; abstract;
    /// delete an object from the list
    procedure Delete(aIndex: integer); overload;
    /// delete an object from the list
    procedure Delete(aObject: TObject); overload;
    /// direct access to the items list array
    property List: TObjectDynArray read fList;
    /// returns the count of stored objects
    property Count: integer read fCount;
    /// direct access to the underlying hashing engine
    property Hash: TDynArrayHashed read fHash;
  end;

  /// this class behaves like TList/TObjectList, but will use hashing
  // for (much) faster IndexOf() method
  TObjectListHashed = class(TObjectListHashedAbstract)
  public
    /// search and add an object reference to the list
    // - returns the found/added index
    // - if added, hash is stored and Items[] := aObject
    function Add(aObject: TObject; out wasAdded: boolean): integer; override;
    /// retrieve an object index within the list, using a fast hash table
    // - returns -1 if not found
    function IndexOf(aObject: TObject): integer; override;
  end;

  /// function prototype used to retrieve a pointer to the hashed property
  // value of a TObjectListPropertyHashed list
  TObjectListPropertyHashedAccessProp = function(aObject: TObject): pointer;

  /// this class will hash and search for a sub property of the stored objects
  TObjectListPropertyHashed = class(TObjectListHashedAbstract)
  protected
    fSubPropAccess: TObjectListPropertyHashedAccessProp;
    function IntHash(const Elem): cardinal;
    function IntComp(const A,B): integer;
  public
    /// initialize the class instance with the corresponding callback in order
    // to handle sub-property hashing and search
    // - see TSetWeakZeroClass in mORMot.pas unit as example:
    // !  function WeakZeroClassSubProp(aObject: TObject): TObject;
    // !  begin
    // !    result := TSetWeakZeroInstance(aObject).fInstance;
    // !  end;
    // - by default, aHashElement/aCompare will hash/search for pointers:
    // you can specify the hash/search methods according to your sub property
    // (e.g. HashAnsiStringI/SortDynArrayAnsiStringI for a RawUTF8)
    // - if aFreeItems is TRUE (default), will behave like a TObjectList;
    // if aFreeItems is FALSE, will behave like a TList
    constructor Create(aSubPropAccess: TObjectListPropertyHashedAccessProp;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aFreeItems: boolean=true); reintroduce;
    /// search and add an object reference to the list
    // - returns the found/added index
    // - if added, only the hash is stored: caller has to set List[i]
    function Add(aObject: TObject; out wasAdded: boolean): integer; override;
    /// retrieve an object index within the list, using a fast hash table
    // - returns -1 if not found
    function IndexOf(aObject: TObject): integer; override;
  end;

  /// abstract class stored by a TPointerClassHash list
  TPointerClassHashed = class
  protected
    fInfo: pointer;
  public
    /// initialize the instance
    constructor Create(aInfo: pointer);
    /// the associated information of this instance
    // - may be e.g. a PTypeInfo value, when caching RTTI information
    property Info: pointer read fInfo write fInfo;
  end;
  /// a reference to a TPointerClassHashed instance
  PPointerClassHashed = ^TPointerClassHashed;

  /// handle a O(1) hashed-based storage of TPointerClassHashed, from a pointer
  // - used e.g. to store RTTI information from its PTypeInfo value
  // - if not thread safe, but could be used to store RTTI, since all type
  // information should have been initialized before actual process
  TPointerClassHash = class(TObjectListPropertyHashed)
  public
    /// initialize the storage list
    constructor Create;
    /// try to add an entry to the storage
    // - returns nil if the supplied information is already in the list
    // - returns a pointer to where a newly created TPointerClassHashed
    // instance should be stored
    // - this method is not thread-safe
    function TryAdd(aInfo: pointer): PPointerClassHashed;
    /// search for a stored instance, from its supplied pointer reference
    // - returns nil if aInfo was not previously added by FindOrAdd()
    // - this method is not thread-safe
    function Find(aInfo: pointer): TPointerClassHashed;
  end;

  /// handle a O(1) hashed-based storage of TPointerClassHashed, from a pointer
  // - this inherited class add a mutex to be thread-safe
  TPointerClassHashLocked = class(TPointerClassHash)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the storage list
    constructor Create;
    /// finalize the storage list
    destructor Destroy; override;
    /// try to add an entry to the storage
    // - returns false if the supplied information is already in the list
    // - returns true, and a pointer to where a newly created TPointerClassHashed
    // instance should be stored: in this case, you should call UnLock once set
    // - could be used as such:
    // !var entry: PPointerClassHashed;
    // !...
    // !  if HashList.TryAddLocked(aTypeInfo,entry) then
    // !  try
    // !    entry^ := TMyCustomPointerClassHashed.Create(aTypeInfo,...);
    // !  finally
    // !    HashList.Unlock;
    // !  end;
    // !...
    function TryAddLocked(aInfo: pointer; out aNewEntry: PPointerClassHashed): boolean;
    /// release the lock after a previous TryAddLocked()=true call
    procedure Unlock;
    /// search for a stored instance, from its supplied pointer reference
    // - returns nil if aInfo was not previously added by FindOrAdd()
    // - this overriden method is thread-safe
    function FindLocked(aInfo: pointer): TPointerClassHashed;
  end;

  /// add locking methods to a standard TObjectList
  // - this class overrides the regular TObjectList, and do not share any code
  // with the TObjectListHashedAbstract/TObjectListHashed classes
  // - caller has to call the Safe.Lock/Unlock methods by hand to protect the
  // execution of regular TObjectList methods (like Add/Remove/Count...),
  // or use the SafeAdd/SafeRemove/SafeExists/SafeCount wrapper methods
  TObjectListLocked = class(TObjectList)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the list instance
    // - the stored TObject instances will be owned by this TObjectListLocked,
    // unless AOwnsObjects is set to false
    constructor Create(AOwnsObjects: Boolean=true); reintroduce;
    /// release the list instance (including the locking resource)
    destructor Destroy; override;
    /// Add an TObject instance using the global critical section
    function SafeAdd(AObject: TObject): integer;
    /// find and delete a TObject instance using the global critical section
    function SafeRemove(AObject: TObject): integer;
    /// find a TObject instance using the global critical section
    function SafeExists(AObject: TObject): boolean;
    /// returns the number of instances stored using the global critical section
    function SafeCount: integer;
    /// delete all items of the list using global critical section
    procedure SafeClear;
    /// the critical section associated to this list instance
    // - could be used to protect shared resources within the internal process
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
  end;

  /// TStringList-class optimized to work with our native UTF-8 string type
  // - cross-compiler, from Delphi 6 and up, i.e is Unicode Ready for all
  TRawUTF8List = class
  protected
    fCount: PtrInt;
    fList: TRawUTF8DynArray;
    fObjects: TObjectDynArray;
    fObjectsOwned: boolean;
    fNameValueSep: AnsiChar;
    fCaseSensitive: boolean;
    fOnChange, fOnChangeHidden: TNotifyEvent;
    fOnChangeTrigerred: boolean;
    fOnChangeLevel: PtrInt;
    procedure Changed; virtual;
    procedure OnChangeHidden(Sender: TObject);
    procedure SetCapacity(const Value: PtrInt);
    function GetCapacity: PtrInt;
    procedure Put(Index: PtrInt; const Value: RawUTF8);
    function GetCount: PtrInt; {$ifdef HASINLINE}inline;{$endif}
    procedure PutObject(Index: PtrInt; const Value: TObject);
    function GetName(Index: PtrInt): RawUTF8;
    function GetValue(const Name: RawUTF8): RawUTF8;
    procedure SetValue(const Name, Value: RawUTF8);
    function GetTextCRLF: RawUTF8;
    procedure SetTextCRLF(const Value: RawUTF8);
    procedure SetTextPtr(P,PEnd: PUTF8Char; const Delimiter: RawUTF8);
    function GetListPtr: PPUtf8CharArray;
    function GetObjectPtr: PPointerArray; {$ifdef HASINLINE}inline;{$endif}
    procedure SetCaseSensitive(Value: boolean); virtual;
  public
    /// initialize the class instance
    // - by default, any associated Objects[] are just weak references
    // - also define CaseSensitive=true
    // - you may supply aOwnObjects=true to force object instance management
    constructor Create(aOwnObjects: boolean=false);
    /// finalize the internal objects stored
    // - if instance was created with aOwnObjects=true
    destructor Destroy; override;
    /// get a stored RawUTF8 item
    // - returns '' and raise no exception in case of out of range supplied index
    function Get(Index: PtrInt): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    /// get a stored Object item by index
    // - returns nil and raise no exception in case of out of range supplied index
    function GetObject(Index: PtrInt): TObject; {$ifdef HASINLINE}inline;{$endif}
    /// get a stored Object item by name
    // - returns nil and raise no exception in case of out of range supplied index
    function GetObjectByName(const Name: RawUTF8): TObject;
    /// store a new RawUTF8 item
    // - returns -1 and raise no exception in case of self=nil
    function Add(const aText: RawUTF8): PtrInt; {$ifdef HASINLINE}inline;{$endif}
    /// store a new RawUTF8 item if not already in the list
    // - returns -1 and raise no exception in case of self=nil
    function AddIfNotExisting(const aText: RawUTF8; wasAdded: PBoolean=nil): PtrInt; virtual;
    /// store a new RawUTF8 item, and its associated TObject
    // - returns -1 and raise no exception in case of self=nil
    function AddObject(const aText: RawUTF8; aObject: TObject): PtrInt;
    /// store a new RawUTF8 item if not already in the list, and its associated TObject
    // - returns -1 and raise no exception in case of self=nil
    function AddObjectIfNotExisting(const aText: RawUTF8; aObject: TObject;
      wasAdded: PBoolean=nil): PtrInt; virtual;
    /// append a specified list to the current content
    procedure AddRawUTF8List(List: TRawUTF8List);
    /// delete a stored RawUTF8 item, and its associated TObject
    // - raise no exception in case of out of range supplied index
    procedure Delete(Index: PtrInt); overload; virtual;
    /// delete a stored RawUTF8 item, and its associated TObject
    // - will search for the value using IndexOf(aText), and returns its index
    // - returns -1 if no entry was found and deleted
    function Delete(const aText: RawUTF8): PtrInt; overload; virtual;
    /// delete a stored RawUTF8 item, and its associated TObject, from
    // a given Name when stored as 'Name=Value' pairs
    // - raise no exception in case of out of range supplied index
    function DeleteFromName(const Name: RawUTF8): PtrInt; virtual;
    /// update Value from an existing Name=Value, then optinally delete the entry
    procedure UpdateValue(const Name: RawUTF8; var Value: RawUTF8; ThenDelete: boolean);
    /// retrieve and delete the first RawUTF8 item in the list
    // - could be used as a FIFO
    function PopFirst(out aText: RawUTF8; aObject: PObject=nil): boolean; virtual;
    /// retrieve and delete the last RawUTF8 item in the list
    // - could be used as a FILO
    function PopLast(out aText: RawUTF8; aObject: PObject=nil): boolean; virtual;
    /// erase all stored RawUTF8 items
    // - and corresponding objects (if aOwnObjects was true at constructor)
    procedure Clear; virtual;
    /// find a RawUTF8 item in the stored Strings[] list
    // - this search is case sensitive if CaseSensitive property is TRUE (which
    // is the default)
    function IndexOf(const aText: RawUTF8): PtrInt; virtual;
    /// find the index of a given Name when stored as 'Name=Value' pairs
    // - search on Name is case-insensitive with 'Name=Value' pairs
    function IndexOfName(const Name: RawUTF8): PtrInt;
    /// find a TObject item index in the stored Objects[] list
    function IndexOfObject(aObject: TObject): PtrInt;
    /// access to the Value of a given 'Name=Value' pair
    function GetValueAt(Index: PtrInt): RawUTF8;
    /// retrieve the all lines, separated by the supplied delimiter
    function GetText(const Delimiter: RawUTF8=#13#10): RawUTF8;
    /// the OnChange event will be raised only when EndUpdate will be called
    procedure BeginUpdate;
    /// call the OnChange event if changes occured
    procedure EndUpdate;
    /// set all lines, separated by the supplied delimiter
    procedure SetText(const aText: RawUTF8; const Delimiter: RawUTF8=#13#10);
    /// set all lines from an UTF-8 text file
    // - expect the file is explicitly an UTF-8 file
    // - will ignore any trailing UTF-8 BOM in the file content, but will not
    // expect one either
    procedure LoadFromFile(const FileName: TFileName);
    /// write all lines into the supplied stream
    procedure SaveToStream(Dest: TStream; const Delimiter: RawUTF8=#13#10);
    /// write all lines into a new file
    procedure SaveToFile(const FileName: TFileName; const Delimiter: RawUTF8=#13#10);
    /// return the count of stored RawUTF8
    property Count: PtrInt read GetCount;
    /// set or retrive the current memory capacity of the RawUTF8 list
    property Capacity: PtrInt read GetCapacity write SetCapacity;
    /// get or set a RawUTF8 item
    // - returns '' and raise no exception in case of out of range supplied index
    // - if you want to use it with the VCL, use UTF8ToString() function
    property Strings[Index: PtrInt]: RawUTF8 read Get write Put; default;
    /// get or set a Object item
    // - returns nil and raise no exception in case of out of range supplied index
    property Objects[Index: PtrInt]: TObject read GetObject write PutObject;
    /// set if IndexOf() shall be case sensitive or not
    // - default is TRUE
    property CaseSensitive: boolean read fCaseSensitive write SetCaseSensitive;
    /// retrieve the corresponding Name when stored as 'Name=Value' pairs
    property names[Index: PtrInt]: RawUTF8 read GetName;
    /// access to the corresponding 'Name=Value' pairs
    // - search on Name is case-insensitive with 'Name=Value' pairs
    property Values[const Name: RawUTF8]: RawUTF8 read GetValue write SetValue;
    /// the char separator between 'Name=Value' pairs
    // - equals '=' by default
    property NameValueSep: AnsiChar read fNameValueSep write fNameValueSep;
    /// set or retrieve all items as text lines
    // - lines are separated by #13#10 (CRLF) by default; use GetText and
    // SetText methods if you want to use another line delimiter (even a comma)
    property Text: RawUTF8 read GetTextCRLF write SetTextCRLF;
    /// Event triggered when an entry is modified
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
    /// direct access to the memory of the RawUTF8 array
    property ListPtr: PPUtf8CharArray read GetListPtr;
    /// direct access to the memory of the Objects array
    property ObjectPtr: PPointerArray read GetObjectPtr;
  end;

  /// a TRawUTF8List with an associated lock for thread-safety
  TRawUTF8ListLocked = class(TRawUTF8List)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the class instance
    constructor Create(aOwnObjects: boolean=false);
    /// finalize the instance
    // - and all internal objects stored, if was created with Create(true)
    destructor Destroy; override;
    /// thread-safe adding of an item to the list
    // - will just call Add() within Safe.Lock/Unlock
    // - you may use SafePop to handle a thread-safe FIFO
    procedure SafePush(const aValue: RawUTF8);
    /// thread-safe retrieving of an item to the list
    // - returns TRUE and set aValue from the oldest SafePush() content
    // - returns FALSE if there is no pending item in the list
    // - you may have used SafePush before to handle a thread-safe FIFO
    function SafePop(out aValue: RawUTF8): boolean;
    /// thread-safe delete all items from the list
    procedure SafeClear;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
  end;

  /// a TRawUTF8List which will use an internal hash table for faster IndexOf()
  // - purpose of this class is to allow faster access of a static list of RawUTF8
  // values (e.g. service method names) which are somewhat fixed during run
  // - uses a rather rough implementation: all values are re-hashed after change,
  // just before IndexOf() call, or explicitly via the ReHash method
  TRawUTF8ListHashed = class(TRawUTF8List)
  protected
    fHash: TDynArrayHashed;
    fChanged: boolean;
    procedure SetCaseSensitive(Value: boolean); override;
    /// will set fChanged=true to force re-hash of all items
    procedure Changed; override;
  public
    /// initialize the class instance
    constructor Create(aOwnObjects: boolean=false);
    /// find a RawUTF8 item in the stored Strings[] list
    // - this overridden method will update the internal hash table (if needed),
    // then use it to retrieve the corresponding matching index
    // - if your purpose is to test if an item is existing, then add it on need,
    // use rather the AddObjectIfNotExisting() method which would preserve
    // the internal hash array, so would perform better
    function IndexOf(const aText: RawUTF8): PtrInt; override;
    /// store a new RawUTF8 item if not already in the list
    // - returns -1 and raise no exception in case of self=nil
    // - this overridden method will update and use the internal hash table,
    // so is preferred to plain Add if you want faster insertion
    // into the TRawUTF8ListHashed
    function AddIfNotExisting(const aText: RawUTF8; wasAdded: PBoolean=nil): PtrInt; override;
    /// store a new RawUTF8 item if not already in the list, and its associated TObject
    // - returns -1 and raise no exception in case of self=nil
    // - this overridden method will update and use the internal hash table,
    // so is preferred to plain Add if you want faster insertion
    // into the TRawUTF8ListHashed
    function AddObjectIfNotExisting(const aText: RawUTF8; aObject: TObject;
      wasAdded: PBoolean=nil): PtrInt; override;
    /// search in the low-level internal hashing table
    function HashFind(aHashCode: cardinal): integer; {$ifdef HASINLINE}inline;{$endif}
    /// ensure all items are hashed if necessay
    // - could be executed after several Add/AddObject calls to ensure the hash
    // table is computed and this instance ready for the next IndexOf() call
    // - will hash all items only if fChanged or aForceRehash is true
    // - returns true if stored information has been re-hashed
    function ReHash(aForceRehash: boolean=false): boolean; virtual;
    /// access to the low-level internal hashing table
    // - could be used e.g. to retrieve Hash.IsHashElementWithoutCollision state
    property Hash: TDynArrayHashed read fHash;
  end;

  /// a TRawUTF8List with an internal hash, with thread-safe locking methods
  // - by default, inherited methods are not protected by the mutex: you have
  // to explicitely call Safe.Lock/UnLock to enter or leave the critical section,
  // or use the methods overriden at this class level
  TRawUTF8ListHashedLocked = class(TRawUTF8ListHashed)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the class instance
    constructor Create(aOwnObjects: boolean=false);
    /// finalize the instance
    // - and all internal objects stored, if was created with Create(true)
    destructor Destroy; override;
    /// access to the locking methods of this instance
    // - use Safe.Lock/TryLock with a try ... finally Safe.Unlock block
    property Safe: TSynLocker read fSafe;
    /// add a RawUTF8 item in the stored Strings[] list
    // - just a wrapper over Add() using Safe.Lock/Unlock
    // - warning: this method WON'T update the internal hash array: use
    // AddIfNotExisting/AddObjectIfNotExisting() methods instead
    function LockedAdd(const aText: RawUTF8): PtrInt; virtual;
    /// find a RawUTF8 item in the stored Strings[] list
    // - just a wrapper over IndexOf() using Safe.Lock/Unlock
    function IndexOf(const aText: RawUTF8): PtrInt; override;
    /// find a RawUTF8 item in the stored Strings[] list
    // - just a wrapper over GetObjectByName() using Safe.Lock/Unlock
    // - warning: the object instance should remain in the list, so the caller
    // should not make any Delete/LockedDeleteFromName otherwise a GPF may occur
    function LockedGetObjectByName(const aText: RawUTF8): TObject; virtual;
    /// add a RawUTF8 item in the internal storage
    // - just a wrapper over AddIfNotExisting() using Safe.Lock/Unlock
    function AddIfNotExisting(const aText: RawUTF8; wasAdded: PBoolean=nil): PtrInt; override;
    /// add a RawUTF8 item in the internal storage, with an optional object
    // - just a wrapper over AddObjectIfNotExisting() using Safe.Lock/Unlock
    function AddObjectIfNotExisting(const aText: RawUTF8; aObject: TObject;
      wasAdded: PBoolean=nil): PtrInt; override;
    /// find and delete an RawUTF8 item in the stored Strings[] list
    // - just a wrapper over inherited Delete(aText) using Safe.Lock/Unlock
    function Delete(const aText: RawUTF8): PtrInt; override;
    /// find and delete an RawUTF8 item from its Name=... in the stored Strings[] list
    // - just a wrapper over inherited DeleteFromName() using Safe.Lock/Unlock
    function DeleteFromName(const Name: RawUTF8): PtrInt; override;
    /// retrieve and delete the first RawUTF8 item in the list
    // - could be used as a FIFO
    // - just a wrapper over inherited PopFirst() using Safe.Lock/Unlock
    function PopFirst(out aText: RawUTF8; aObject: PObject=nil): boolean; override;
    /// retrieve and delete the last RawUTF8 item in the list
    // - could be used as a FILO
    // - just a wrapper over inherited PopLast() using Safe.Lock/Unlock
    function PopLast(out aText: RawUTF8; aObject: PObject=nil): boolean; override;
    /// delete all RawUTF8 items in the list
    // - just a wrapper over inherited Clear using Safe.Lock/Unlock
    procedure Clear; override;
    /// ensure all items are hashed if necessay
    // - just a wrapper over inherited Rehash using Safe.Lock/Unlock
    function ReHash(aForceRehash: boolean=false): boolean; override;
  end;

  /// this class stores TMethod callbacks with an associated UTF-8 string
  // - event names will be hashed for O(1) fast access
  TRawUTF8MethodList = class(TRawUTF8ListHashed)
  protected
    fEvents: TMethodDynArray;
  public
    /// delete a stored RawUTF8 item, and its associated event
    // - raise no exception in case of out of range supplied index
    procedure Delete(Index: PtrInt); override;
    /// erase all stored RawUTF8 items and events
    procedure Clear; override;
    /// register a callback with its name
    function AddEvent(const aName: RawUTF8; const aEvent: TMethod): PtrInt;
    /// retrieve a callback from its index
    // - return FALSE if not previously set via AddEvent()
    // - return TRUE if found, and set aEvent to the corresponding callback
    function GetEvent(aIndex: PtrInt; out aEvent: TMethod): boolean;
    /// retrieve a callback from its hashed name
    // - return FALSE if not found
    // - return TRUE if found, and set aEvent to the corresponding callback
    function GetEventByName(const aText: RawUTF8; out aEvent: TMethod): boolean;
  end;

  /// define the implemetation used by TAlgoCompress.Decompress()
  TAlgoCompressLoad = (aclNormal, aclSafeSlow, aclNoCrcFast);

  /// abstract low-level parent class for generic compression/decompression algorithms
  // - will encapsulate the compression algorithm with crc32c hashing
  // - all Algo* abtract methods should be overriden by inherited classes
  TAlgoCompress = class(TSynPersistent)
  public
    /// should return a genuine byte identifier
    // - 0 is reserved for stored, 1 for TAlgoSynLz, 2/3 for TAlgoDeflate/Fast
    // (in mORMot.pas), 4/5/6 for TAlgoLizard/Fast/Huffman (in SynLizard.pas)
    function AlgoID: byte; virtual; abstract;
    /// computes by default the crc32c() digital signature of the buffer
    function AlgoHash(Previous: cardinal; Data: pointer; DataLen: integer): cardinal; virtual;
    /// get maximum possible (worse) compressed size for the supplied length
    function AlgoCompressDestLen(PlainLen: integer): integer; virtual; abstract;
    /// this method will compress the supplied data
    function AlgoCompress(Plain: pointer; PlainLen: integer; Comp: pointer): integer; virtual; abstract;
    /// this method will return the size of the decompressed data
    function AlgoDecompressDestLen(Comp: pointer): integer; virtual; abstract;
    /// this method will decompress the supplied data
    function AlgoDecompress(Comp: pointer; CompLen: integer; Plain: pointer): integer; virtual; abstract;
    /// this method will partially and safely decompress the supplied data
    // - expects PartialLen <= result < PartialLenMax, depending on the algorithm
    function AlgoDecompressPartial(Comp: pointer; CompLen: integer;
      Partial: pointer; PartialLen, PartialLenMax: integer): integer; virtual; abstract;
  public
    /// will register AlgoID in the global list, for Algo() class methods
    // - no need to free this instance, since it will be owned by the global list
    // - raise a ESynException if the class or its AlgoID are already registered
    // - you should never have to call this constructor, but define a global
    // variable holding a reference to a shared instance
    constructor Create; override;
    /// get maximum possible (worse) compressed size for the supplied length
    // - including the crc32c + algo 9 bytes header
    function CompressDestLen(PlainLen: integer): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// compress a memory buffer with crc32c hashing to a RawByteString
    function Compress(const Plain: RawByteString; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false; BufferOffset: integer=0): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// compress a memory buffer with crc32c hashing to a RawByteString
    function Compress(Plain: PAnsiChar; PlainLen: integer; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false; BufferOffset: integer=0): RawByteString; overload;
    /// compress a memory buffer with crc32c hashing
    // - supplied Comp buffer should contain at least CompressDestLen(PlainLen) bytes
    function Compress(Plain, Comp: PAnsiChar; PlainLen, CompLen: integer;
      CompressionSizeTrigger: integer=100; CheckMagicForCompressed: boolean=false): integer; overload;
    /// compress a memory buffer with crc32c hashing to a TByteDynArray
    function CompressToBytes(const Plain: RawByteString; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false): TByteDynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// compress a memory buffer with crc32c hashing to a TByteDynArray
    function CompressToBytes(Plain: PAnsiChar; PlainLen: integer; CompressionSizeTrigger: integer=100;
      CheckMagicForCompressed: boolean=false): TByteDynArray; overload;
    /// uncompress a RawByteString memory buffer with crc32c hashing
    function Decompress(const Comp: RawByteString; Load: TAlgoCompressLoad=aclNormal;
      BufferOffset: integer=0): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// uncompress a RawByteString memory buffer with crc32c hashing
    // - returns TRUE on success
    function TryDecompress(const Comp: RawByteString; out Dest: RawByteString;
      Load: TAlgoCompressLoad=aclNormal): boolean;
    /// uncompress a memory buffer with crc32c hashing
    procedure Decompress(Comp: PAnsiChar; CompLen: integer; out Result: RawByteString;
      Load: TAlgoCompressLoad=aclNormal; BufferOffset: integer=0); overload;
    /// uncompress a RawByteString memory buffer with crc32c hashing
    function Decompress(const Comp: TByteDynArray): RawByteString; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// uncompress a RawByteString memory buffer with crc32c hashing
    // - returns nil if crc32 hash failed, i.e. if the supplied Comp is not correct
    // - returns a pointer to the uncompressed data and fill PlainLen variable,
    // after crc32c hash
    // - avoid any memory allocation in case of a stored content - otherwise, would
    // uncompress to the tmp variable, and return pointer(tmp) and length(tmp)
    function Decompress(const Comp: RawByteString; out PlainLen: integer;
      var tmp: RawByteString; Load: TAlgoCompressLoad=aclNormal): pointer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// uncompress a RawByteString memory buffer with crc32c hashing
    // - returns nil if crc32 hash failed, i.e. if the supplied Data is not correct
    // - returns a pointer to an uncompressed data buffer of PlainLen bytes
    // - avoid any memory allocation in case of a stored content - otherwise, would
    // uncompress to the tmp variable, and return pointer(tmp) and length(tmp)
    function Decompress(Comp: PAnsiChar; CompLen: integer; out PlainLen: integer;
      var tmp: RawByteString; Load: TAlgoCompressLoad=aclNormal): pointer; overload;
    /// decode the header of a memory buffer compressed via the Compress() method
    // - validates the crc32c of the compressed data (unless Load=aclNoCrcFast),
    // then return the uncompressed size in bytes, or 0 if the crc32c does not match
    // - should call DecompressBody() later on to actually retrieve the content
    function DecompressHeader(Comp: PAnsiChar; CompLen: integer;
      Load: TAlgoCompressLoad=aclNormal): integer;
    /// decode the content of a memory buffer compressed via the Compress() method
    // - PlainLen has been returned by a previous call to DecompressHeader()
    function DecompressBody(Comp,Plain: PAnsiChar; CompLen,PlainLen: integer;
      Load: TAlgoCompressLoad=aclNormal): boolean;
    /// partial decoding of a memory buffer compressed via the Compress() method
    // - returns 0 on error, or how many bytes have been written to Partial
    // - will call virtual AlgoDecompressPartial() which is slower, but expected
    // to avoid any buffer overflow on the Partial destination buffer
    // - some algorithms (e.g. Lizard) may need some additional bytes in the
    // decode buffer, so PartialLenMax bytes should be allocated in Partial^,
    // with PartialLenMax > expected PartialLen, and returned bytes may be >
    // PartialLen, but always <= PartialLenMax
    function DecompressPartial(Comp,Partial: PAnsiChar; CompLen,PartialLen,PartialLenMax: integer): integer;
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    class function Algo(Comp: PAnsiChar; CompLen: integer): TAlgoCompress; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    // - also identifies "stored" content in IsStored variable
    class function Algo(Comp: PAnsiChar; CompLen: integer; out IsStored: boolean): TAlgoCompress; overload;
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    class function Algo(const Comp: RawByteString): TAlgoCompress; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the TAlgoCompress instance corresponding to the AlgoID stored
    // in the supplied compressed buffer
    // - returns nil if no algorithm was identified
    class function Algo(const Comp: TByteDynArray): TAlgoCompress; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// get the TAlgoCompress instance corresponding to the supplied AlgoID
    // - returns nil if no algorithm was identified
    // - stored content is identified as TAlgoSynLZ
    class function Algo(AlgoID: byte): TAlgoCompress; overload;
    /// quickly validate a compressed buffer content, without uncompression
    // - extract the TAlgoCompress, and call DecompressHeader() to check the
    // hash of the compressed data, and return then uncompressed size
    // - returns 0 on error (e.g. unknown algorithm or incorrect hash)
    class function UncompressedSize(const Comp: RawByteString): integer;
    /// returns the algorithm name, from its classname
    // - e.g. TAlgoSynLZ->'synlz' TAlgoLizard->'lizard' nil->'none'
    function AlgoName: TShort16;
  end;

  /// implement our fast SynLZ compression as a TAlgoCompress class
  // - please use the AlgoSynLZ global variable methods instead of the deprecated
  // SynLZCompress/SynLZDecompress wrapper functions
  TAlgoSynLZ = class(TAlgoCompress)
  public
    /// returns 1 as genuine byte identifier for SynLZ
    function AlgoID: byte; override;
    /// get maximum possible (worse) SynLZ compressed size for the supplied length
    function AlgoCompressDestLen(PlainLen: integer): integer; override;
    /// compress the supplied data using SynLZ
    function AlgoCompress(Plain: pointer; PlainLen: integer; Comp: pointer): integer; override;
    /// return the size of the SynLZ decompressed data
    function AlgoDecompressDestLen(Comp: pointer): integer; override;
    /// decompress the supplied data using SynLZ
    function AlgoDecompress(Comp: pointer; CompLen: integer; Plain: pointer): integer; override;
    /// partial (and safe) decompression of the supplied data using SynLZ
    function AlgoDecompressPartial(Comp: pointer; CompLen: integer;
      Partial: pointer; PartialLen, PartialLenMax: integer): integer; override;
  end;

  TAlgoCompressWithNoDestLenProcess = (doCompress, doUnCompress, doUncompressPartial);

  /// abstract class storing the plain length before calling compression API
  // - some libraries (e.g. Deflate or Lizard) don't provide the uncompressed
  // length from its output buffer - inherit from this class to store this value
  // as ToVarUInt32, and override the RawProcess abstract protected method
  TAlgoCompressWithNoDestLen = class(TAlgoCompress)
  protected
    /// inherited classes should implement this single method for the actual process
    // - dstMax is oinly used for doUncompressPartial
    function RawProcess(src,dst: pointer; srcLen,dstLen,dstMax: integer;
      process: TAlgoCompressWithNoDestLenProcess): integer; virtual; abstract;
  public
    /// performs the compression, storing PlainLen and calling protected RawProcess
    function AlgoCompress(Plain: pointer; PlainLen: integer; Comp: pointer): integer; override;
    /// return the size of the decompressed data (using FromVarUInt32)
    function AlgoDecompressDestLen(Comp: pointer): integer; override;
    /// performs the decompression, retrieving PlainLen and calling protected RawProcess
    function AlgoDecompress(Comp: pointer; CompLen: integer; Plain: pointer): integer; override;
    /// performs the decompression, retrieving PlainLen and calling protected RawProcess
    function AlgoDecompressPartial(Comp: pointer; CompLen: integer;
      Partial: pointer; PartialLen, PartialLenMax: integer): integer; override;
  end;


  TSynDictionaryInArray = (
    iaFind, iaFindAndDelete, iaFindAndUpdate, iaFindAndAddIfNotExisting, iaAdd);

  /// event called by TSynDictionary.ForEach methods to iterate over stored items
  // - if the implementation method returns TRUE, will continue the loop
  // - if the implementation method returns FALSE, will stop values browsing
  // - aOpaque is a custom value specified at ForEach() method call
  TSynDictionaryEvent = function(const aKey; var aValue; aIndex,aCount: integer;
    aOpaque: pointer): boolean of object;

  /// event called by TSynDictionary.DeleteDeprecated
  // - called just before deletion: return false to by-pass this item
  TSynDictionaryCanDeleteEvent = function(const aKey, aValue; aIndex: integer): boolean of object;

  /// thread-safe dictionary to store some values from associated keys
  // - will maintain a dynamic array of values, associated with a hashed dynamic
  // array for the keys, so that setting or retrieving values would be O(1)
  // - all process is protected by a TSynLocker, so will be thread-safe
  // - TDynArray is a wrapper which do not store anything, whereas this class
  // is able to store both keys and values, and provide convenient methods to
  // access the stored data, including JSON serialization and binary storage
  TSynDictionary = class(TSynPersistentLock)
  protected
    fKeys: TDynArrayHashed;
    fValues: TDynArray;
    fTimeOut: TCardinalDynArray;
    fTimeOuts: TDynArray;
    fCompressAlgo: TAlgoCompress;
    fOnCanDelete: TSynDictionaryCanDeleteEvent;
    function InArray(const aKey,aArrayValue; aAction: TSynDictionaryInArray): boolean;
    procedure SetTimeouts;
    function ComputeNextTimeOut: cardinal;
    function KeyFullHash(const Elem): cardinal;
    function KeyFullCompare(const A,B): integer;
    function GetCapacity: integer;
    procedure SetCapacity(const Value: integer);
    function GetTimeOutSeconds: cardinal;
  public
    /// initialize the dictionary storage, specifyng dynamic array keys/values
    // - aKeyTypeInfo should be a dynamic array TypeInfo() RTTI pointer, which
    // would store the keys within this TSynDictionary instance
    // - aValueTypeInfo should be a dynamic array TypeInfo() RTTI pointer, which
    // would store the values within this TSynDictionary instance
    // - by default, string keys would be searched following exact case, unless
    // aKeyCaseInsensitive is TRUE
    // - you can set an optional timeout period, in seconds - you should call
    // DeleteDeprecated periodically to search for deprecated items
    constructor Create(aKeyTypeInfo,aValueTypeInfo: pointer;
      aKeyCaseInsensitive: boolean=false; aTimeoutSeconds: cardinal=0;
      aCompressAlgo: TAlgoCompress=nil); reintroduce; virtual;
    /// finalize the storage
    // - would release all internal stored values
    destructor Destroy; override;
    /// try to add a value associated with a primary key
    // - returns the index of the inserted item, -1 if aKey is already existing
    // - this method is thread-safe, since it will lock the instance
    function Add(const aKey, aValue): integer;
    /// store a value associated with a primary key
    // - returns the index of the matching item
    // - if aKey does not exist, a new entry is added
    // - if aKey does exist, the existing entry is overriden with aValue
    // - this method is thread-safe, since it will lock the instance
    function AddOrUpdate(const aKey, aValue): integer;
    /// clear the value associated via aKey
    // - does not delete the entry, but reset its value
    // - returns the index of the matching item, -1 if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function Clear(const aKey): integer;
    /// delete all key/value stored in the current instance
    procedure DeleteAll;
    /// delete a key/value association from its supplied aKey
    // - this would delete the entry, i.e. matching key and value pair
    // - returns the index of the deleted item, -1 if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function Delete(const aKey): integer;
    /// delete a key/value association from its internal index
    // - this method is not thread-safe: you should use fSafe.Lock/Unlock
    // e.g. then Find/FindValue to retrieve the index value
    function DeleteAt(aIndex: integer): boolean;
    /// search and delete all deprecated items according to TimeoutSeconds
    // - returns how many items have been deleted
    // - you can call this method very often: it will ensure that the
    // search process will take place at most once every second
    // - this method is thread-safe, but blocking during the process
    function DeleteDeprecated: integer;
    /// search of a primary key within the internal hashed dictionary
    // - returns the index of the matching item, -1 if aKey was not found
    // - if you want to access the value, you should use fSafe.Lock/Unlock:
    // consider using Exists or FindAndCopy thread-safe methods instead
    // - aUpdateTimeOut will update the associated timeout value of the entry
    function Find(const aKey; aUpdateTimeOut: boolean=false): integer;
    /// search of a primary key within the internal hashed dictionary
    // - returns a pointer to the matching item, nil if aKey was not found
    // - if you want to access the value, you should use fSafe.Lock/Unlock:
    // consider using Exists or FindAndCopy thread-safe methods instead
    // - aUpdateTimeOut will update the associated timeout value of the entry
    function FindValue(const aKey; aUpdateTimeOut: boolean=false; aIndex: PInteger=nil): pointer;
    /// search of a primary key within the internal hashed dictionary
    // - returns a pointer to the matching or already existing item
    // - if you want to access the value, you should use fSafe.Lock/Unlock:
    // consider using Exists or FindAndCopy thread-safe methods instead
    // - will update the associated timeout value of the entry, if applying
    function FindValueOrAdd(const aKey; var added: boolean; aIndex: PInteger=nil): pointer;
    /// search of a stored value by its primary key, and return a local copy
    // - so this method is thread-safe
    // - returns TRUE if aKey was found, FALSE if no match exists
    // - will update the associated timeout value of the entry, unless
    // aUpdateTimeOut is set to false
    function FindAndCopy(const aKey; out aValue; aUpdateTimeOut: boolean=true): boolean;
    /// search of a stored value by its primary key, then delete and return it
    // - returns TRUE if aKey was found, fill aValue with its content,
    // and delete the entry in the internal storage
    // - so this method is thread-safe
    // - returns FALSE if no match exists
    function FindAndExtract(const aKey; out aValue): boolean;
    /// search for a primary key presence
    // - returns TRUE if aKey was found, FALSE if no match exists
    // - this method is thread-safe
    function Exists(const aKey): boolean;
    /// apply a specified event over all items stored in this dictionnary
    // - would browse the list in the adding order
    // - returns the number of times OnEach has been called
    // - this method is thread-safe, since it will lock the instance
    function ForEach(const OnEach: TSynDictionaryEvent; Opaque: pointer=nil): integer; overload;
    /// apply a specified event over matching items stored in this dictionnary
    // - would browse the list in the adding order, comparing each key and/or
    // value item with the supplied comparison functions and aKey/aValue content
    // - returns the number of times OnMatch has been called, i.e. how many times
    // KeyCompare(aKey,Keys[#])=0 or ValueCompare(aValue,Values[#])=0
    // - this method is thread-safe, since it will lock the instance
    function ForEach(const OnMatch: TSynDictionaryEvent;
      KeyCompare,ValueCompare: TDynArraySortCompare; const aKey,aValue;
      Opaque: pointer=nil): integer; overload;
    /// touch the entry timeout field so that it won't be deprecated sooner
    // - this method is not thread-safe, and is expected to be execute e.g.
    // from a ForEach() TSynDictionaryEvent callback
    procedure SetTimeoutAtIndex(aIndex: integer);
    /// search aArrayValue item in a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.Find
    // to delete any aArrayValue match in the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey or aArrayValue
    // were not found
    // - this method is thread-safe, since it will lock the instance
    function FindInArray(const aKey, aArrayValue): boolean;
    /// search of a stored key by its associated key, and return a key local copy
    // - won't use any hashed index but TDynArray.IndexOf over fValues,
    // so is much slower than FindAndCopy()
    // - will update the associated timeout value of the entry, unless
    // aUpdateTimeOut is set to false
    // - so this method is thread-safe
    // - returns TRUE if aValue was found, FALSE if no match exists
    function FindKeyFromValue(const aValue; out aKey; aUpdateTimeOut: boolean=true): boolean;
    /// add aArrayValue item within a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.Add
    // to add aArrayValue to the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function AddInArray(const aKey, aArrayValue): boolean;
    /// add once aArrayValue within a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use
    // TDynArray.FindAndAddIfNotExisting to add once aArrayValue to the
    // associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey was not found
    // - this method is thread-safe, since it will lock the instance
    function AddOnceInArray(const aKey, aArrayValue): boolean;
    /// clear aArrayValue item of a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.FindAndDelete
    // to delete any aArrayValue match in the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey or aArrayValue were
    // not found
    // - this method is thread-safe, since it will lock the instance
    function DeleteInArray(const aKey, aArrayValue): boolean;
    /// replace aArrayValue item of a dynamic-array value associated via aKey
    // - expect the stored value to be a dynamic array itself
    // - would search for aKey as primary key, then use TDynArray.FindAndUpdate
    // to delete any aArrayValue match in the associated dynamic array
    // - returns FALSE if Values is not a tkDynArray, or if aKey or aArrayValue were
    // not found
    // - this method is thread-safe, since it will lock the instance
    function UpdateInArray(const aKey, aArrayValue): boolean;
    {$ifndef DELPHI5OROLDER}
    /// make a copy of the stored values
    // - this method is thread-safe, since it will lock the instance during copy
    // - resulting length(Dest) will match the exact values count
    // - T*ObjArray will be reallocated and copied by content (using a temporary
    // JSON serialization), unless ObjArrayByRef is true and pointers are copied
    procedure CopyValues(out Dest; ObjArrayByRef: boolean=false);
    {$endif DELPHI5OROLDER}
    /// serialize the content as a "key":value JSON object
    procedure SaveToJSON(W: TTextWriter; EnumSetsAsText: boolean=false); overload;
    /// serialize the content as a "key":value JSON object
    function SaveToJSON(EnumSetsAsText: boolean=false): RawUTF8; overload;
    /// serialize the Values[] as a JSON array
    function SaveValuesToJSON(EnumSetsAsText: boolean=false): RawUTF8;
    /// unserialize the content from "key":value JSON object
    // - if the JSON input may not be correct (i.e. if not coming from SaveToJSON),
    // you may set EnsureNoKeyCollision=TRUE for a slow but safe keys validation
    function LoadFromJSON(const JSON: RawUTF8; EnsureNoKeyCollision: boolean=false): boolean; overload;
    /// unserialize the content from "key":value JSON object
    // - note that input JSON buffer is not modified in place: no need to create
    // a temporary copy if the buffer is about to be re-used
    // - if the JSON input may not be correct (i.e. if not coming from SaveToJSON),
    // you may set EnsureNoKeyCollision=TRUE for a slow but safe keys validation
    function LoadFromJSON(JSON: PUTF8Char; EnsureNoKeyCollision: boolean=false): boolean; overload;
    /// save the content as SynLZ-compressed raw binary data
    // - warning: this format is tied to the values low-level RTTI, so if you
    // change the value/key type definitions, LoadFromBinary() would fail
    function SaveToBinary(NoCompression: boolean=false): RawByteString;
    /// load the content from SynLZ-compressed raw binary data
    // - as previously saved by SaveToBinary method
    function LoadFromBinary(const binary: RawByteString): boolean;
    /// can be assigned to OnCanDeleteDeprecated to check TSynPersistentLock(aValue).Safe.IsLocked
    class function OnCanDeleteSynPersistentLock(const aKey, aValue; aIndex: integer): boolean;
    /// can be assigned to OnCanDeleteDeprecated to check TSynPersistentLock(aValue).Safe.IsLocked
    class function OnCanDeleteSynPersistentLocked(const aKey, aValue; aIndex: integer): boolean;
    /// returns how many items are currently stored in this dictionary
    // - this method is thread-safe
    function Count: integer;
    /// fast returns how many items are currently stored in this dictionary
    // - this method is NOT thread-safe so should be protected by fSafe.Lock/UnLock
    function RawCount: integer; {$ifdef HASINLINE}inline;{$endif}
    /// direct access to the primary key identifiers
    // - if you want to access the keys, you should use fSafe.Lock/Unlock
    property Keys: TDynArrayHashed read fKeys;
    /// direct access to the associated stored values
    // - if you want to access the values, you should use fSafe.Lock/Unlock
    property Values: TDynArray read fValues;
    /// defines how many items are currently stored in Keys/Values internal arrays
    property Capacity: integer read GetCapacity write SetCapacity;
    /// direct low-level access to the internal access tick (GetTickCount64 shr 10)
    // - may be nil if TimeOutSeconds=0
    property TimeOut: TCardinalDynArray read fTimeOut;
    /// returns the aTimeOutSeconds parameter value, as specified to Create()
    property TimeOutSeconds: cardinal read GetTimeOutSeconds;
    /// the compression algorithm used for binary serialization
    property CompressAlgo: TAlgoCompress read fCompressAlgo write fCompressAlgo;
    /// callback to by-pass DeleteDeprecated deletion by returning false
    // - can be assigned e.g. to OnCanDeleteSynPersistentLock if Value is a
    // TSynPersistentLock instance, to avoid any potential access violation
    property OnCanDeleteDeprecated: TSynDictionaryCanDeleteEvent read fOnCanDelete write fOnCanDelete;
  end;

  /// thread-safe FIFO (First-In-First-Out) in-order queue of records
  // - uses internally a dynamic array storage, with a sliding algorithm
  // (more efficient than the FPC or Delphi TQueue)
  TSynQueue = class(TSynPersistentLock)
  protected
    fValues: TDynArray;
    fValueVar: pointer;
    fCount, fFirst, fLast: integer;
    fWaitPopFlags: set of (wpfDestroying);
    fWaitPopCounter: integer;
    procedure InternalGrow;
    function InternalDestroying(incPopCounter: integer): boolean;
    function InternalWaitDone(endtix: Int64; const idle: TThreadMethod): boolean;
  public
    /// initialize the queue storage
    // - aTypeInfo should be a dynamic array TypeInfo() RTTI pointer, which
    // would store the values within this TSynQueue instance
    constructor Create(aTypeInfo: pointer); reintroduce; virtual;
    /// finalize the storage
    // - would release all internal stored values, and call WaitPopFinalize
    destructor Destroy; override;
    /// store one item into the queue
    // - this method is thread-safe, since it will lock the instance
    procedure Push(const aValue);
    /// extract one item from the queue, as FIFO (First-In-First-Out)
    // - returns true if aValue has been filled with a pending item, which
    // is removed from the queue (use Peek if you don't want to remove it)
    // - returns false if the queue is empty
    // - this method is thread-safe, since it will lock the instance
    function Pop(out aValue): boolean;
    /// lookup one item from the queue, as FIFO (First-In-First-Out)
    // - returns true if aValue has been filled with a pending item, without
    // removing it from the queue (as Pop method does)
    // - returns false if the queue is empty
    // - this method is thread-safe, since it will lock the instance
    function Peek(out aValue): boolean;
    /// waiting extract of one item from the queue, as FIFO (First-In-First-Out)
    // - returns true if aValue has been filled with a pending item within the
    // specified aTimeoutMS time
    // - returns false if nothing was pushed into the queue in time, or if
    // WaitPopFinalize has been called
    // - aWhenIdle could be assigned e.g. to VCL/LCL Application.ProcessMessages
    // - this method is thread-safe, but will lock the instance only if needed
    function WaitPop(aTimeoutMS: integer; const aWhenIdle: TThreadMethod; out aValue): boolean;
    /// waiting lookup of one item from the queue, as FIFO (First-In-First-Out)
    // - returns a pointer to a pending item within the specified aTimeoutMS
    // time - the Safe.Lock is still there, so that caller could check its content,
    // then call Pop() if it is the expected one, and eventually always call Safe.Unlock
    // - returns nil if nothing was pushed into the queue in time
    // - this method is thread-safe, but will lock the instance only if needed
    function WaitPeekLocked(aTimeoutMS: integer; const aWhenIdle: TThreadMethod): pointer;
    /// ensure any pending or future WaitPop() returns immediately as false
    // - is always called by Destroy destructor
    // - could be also called e.g. from an UI OnClose event to avoid any lock
    // - this method is thread-safe, but will lock the instance only if needed
    procedure WaitPopFinalize;
    /// delete all items currently stored in this queue, and void its capacity
    // - this method is thread-safe, since it will lock the instance
    procedure Clear;
    /// initialize a dynamic array with the stored queue items
    // - aDynArrayValues should be a variable defined as aTypeInfo from Create
    // - you can retrieve an optional TDynArray wrapper, e.g. for binary or JSON
    // persistence
    // - this method is thread-safe, and will make a copy of the queue data
    procedure Save(out aDynArrayValues; aDynArray: PDynArray=nil);
    /// returns how many items are currently stored in this queue
    // - this method is thread-safe
    function Count: Integer;
    /// returns how much slots is currently reserved in memory
    // - the queue has an optimized auto-sizing algorithm, you can use this
    // method to return its current capacity
    // - this method is thread-safe
    function Capacity: integer;
    /// returns true if there are some items currently pending in the queue
    // - slightly faster than checking Count=0, and much faster than Pop or Peek
    function Pending: boolean;
  end;

  /// event signature to locate a service for a given string key
  // - used e.g. by TRawUTF8ObjectCacheList.OnKeyResolve property
  TOnKeyResolve = function(const aInterface: TGUID; const Key: RawUTF8; out Obj): boolean of object;
  /// event signature to notify a given string key
  TOnKeyNotify = procedure(Sender: TObject; const Key: RawUTF8) of object;
  
var
  /// mORMot.pas will registry here its T*ObjArray serialization process
  // - will be used by TDynArray.GetIsObjArray
  DynArrayIsObjArray: function(aDynArrayTypeInfo: Pointer): TPointerClassHashed;

type
  /// handle memory mapping of a file content
  {$ifdef FPC_OR_UNICODE}TMemoryMap = record private
  {$else}TMemoryMap = object protected{$endif}
    fBuf: PAnsiChar;
    fBufSize: PtrUInt;
    fFile: THandle;
    {$ifdef MSWINDOWS}
    fMap: THandle;
    {$endif}
    fFileSize: Int64;
    fFileLocal: boolean;
  public
    /// map the corresponding file handle
    // - if aCustomSize and aCustomOffset are specified, the corresponding
    // map view if created (by default, will map whole file)
    function Map(aFile: THandle; aCustomSize: PtrUInt=0; aCustomOffset: Int64=0): boolean; overload;
    /// map the file specified by its name
    // - file will be closed when UnMap will be called
    function Map(const aFileName: TFileName): boolean; overload;
    /// set a fixed buffer for the content
    // - emulated a memory-mapping from an existing buffer
    procedure Map(aBuffer: pointer; aBufferSize: PtrUInt); overload;
    /// unmap the file
    procedure UnMap;
    /// retrieve the memory buffer mapped to the file content
    property Buffer: PAnsiChar read fBuf;
    /// retrieve the buffer size
    property Size: PtrUInt read fBufSize;
  end;

  {$M+}
  /// able to read a UTF-8 text file using memory map
  // - much faster than TStringList.LoadFromFile()
  // - will ignore any trailing UTF-8 BOM in the file content, but will not
  // expect one either
  TMemoryMapText = class
  protected
    fLines: PPointerArray;
    fLinesMax: integer;
    fCount: integer;
    fMapEnd: PUTF8Char;
    fMap: TMemoryMap;
    fFileName: TFileName;
    fAppendedLines: TRawUTF8DynArray;
    fAppendedLinesCount: integer;
    function GetLine(aIndex: integer): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    function GetString(aIndex: integer): string; {$ifdef HASINLINE}inline;{$endif}
    /// call once by Create constructors when fMap has been initialized
    procedure LoadFromMap(AverageLineLength: integer=32); virtual;
    /// call once per line, from LoadFromMap method
    // - default implementation will set  fLines[fCount] := LineBeg;
    // - override this method to add some per-line process at loading: it will
    // avoid reading the entire file more than once
    procedure ProcessOneLine(LineBeg, LineEnd: PUTF8Char); virtual;
  public
    /// initialize the memory mapped text file
    // - this default implementation just do nothing but is called by overloaded
    // constructors so may be overriden to initialize an inherited class
    constructor Create; overload; virtual;
    /// read an UTF-8 encoded text file
    // - every line beginning is stored into LinePointers[]
    constructor Create(const aFileName: TFileName); overload;
    /// read an UTF-8 encoded text file content
    // - every line beginning is stored into LinePointers[]
    // - this overloaded constructor accept an existing memory buffer (some
    // uncompressed data e.g.)
    constructor Create(aFileContent: PUTF8Char; aFileSize: integer); overload;
    /// release the memory map and internal LinePointers[]
    destructor Destroy; override;
    /// save the whole content into a specified stream
    // - including any runtime appended values via AddInMemoryLine()
    procedure SaveToStream(Dest: TStream; const Header: RawUTF8);
    /// save the whole content into a specified file
    // - including any runtime appended values via AddInMemoryLine()
    // - an optional header text can be added to the beginning of the file
    procedure SaveToFile(FileName: TFileName; const Header: RawUTF8='');
    /// add a new line to the already parsed content
    // - this line won't be stored in the memory mapped file, but stay in memory
    // and appended to the existing lines, until this instance is released
    procedure AddInMemoryLine(const aNewLine: RawUTF8); virtual;
    /// clear all in-memory appended rows
    procedure AddInMemoryLinesClear; virtual;
    /// retrieve the number of UTF-8 chars of the given line
    // - warning: no range check is performed about supplied index
    function LineSize(aIndex: integer): integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// check if there is at least a given number of UTF-8 chars in the given line
    // - this is faster than LineSize(aIndex)<aMinimalCount for big lines
    function LineSizeSmallerThan(aIndex, aMinimalCount: integer): boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// returns TRUE if the supplied text is contained in the corresponding line
    function LineContains(const aUpperSearch: RawUTF8; aIndex: Integer): Boolean; virtual;
    /// retrieve a line content as UTF-8
    // - a temporary UTF-8 string is created
    // - will return '' if aIndex is out of range
    property Lines[aIndex: integer]: RawUTF8 read GetLine;
    /// retrieve a line content as generic VCL string type
    // - a temporary VCL string is created (after conversion for UNICODE Delphi)
    // - will return '' if aIndex is out of range
    property Strings[aIndex: integer]: string read GetString;
    /// direct access to each text line
    // - use LineSize() method to retrieve line length, since end of line will
    // NOT end with #0, but with #13 or #10
    // - warning: no range check is performed about supplied index
    property LinePointers: PPointerArray read fLines;
    /// the memory map used to access the raw file content
    property Map: TMemoryMap read fMap;
  published
    /// the file name which was opened by this instance
    property FileName: TFileName read fFileName write fFileName;
    /// the number of text lines
    property Count: integer read fCount;
  end;
  {$M-}

  /// a fake TStream, which will just count the number of bytes written
  TFakeWriterStream = class(TStream)
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;

  /// a TStream using a RawByteString as internal storage
  // - default TStringStream uses WideChars since Delphi 2009, so it is
  // not compatible with previous versions, and it does make sense to
  // work with RawByteString in our UTF-8 oriented framework
  // - jus tlike TStringSTream, is designed for appending data, not modifying
  // in-place, as requested e.g. by TTextWriter or TFileBufferWriter classes
  TRawByteStringStream = class(TStream)
  protected
    fDataString: RawByteString;
    fPosition: Integer;
    procedure SetSize(NewSize: Longint); override;
  public
    /// initialize the storage, optionally with some RawByteString content
    constructor Create(const aString: RawByteString=''); overload;
    /// read some bytes from the internal storage
    // - returns the number of bytes filled into Buffer (<=Count)
    function Read(var Buffer; Count: Longint): Longint; override;
    /// change the current Read/Write position, within current stored range
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    /// append some data to the buffer
    // - will resize the buffer, i.e. will replace the end of the string from
    // the current position with the supplied data
    function Write(const Buffer; Count: Longint): Longint; override;
    /// direct low-level access to the internal RawByteString storage
    property DataString: RawByteString read fDataString write fDataString;
  end;

  /// a TStream pointing to some in-memory data, for instance UTF-8 text
  // - warning: there is no local copy of the supplied content: the
  // source data must be available during all the TSynMemoryStream usage
  TSynMemoryStream = class(TCustomMemoryStream)
  public
    /// create a TStream with the supplied text data
    // - warning: there is no local copy of the supplied content: the aText
    // variable must be available during all the TSynMemoryStream usage:
    // don't release aText before calling TSynMemoryStream.Free
    // - aText can be on any AnsiString format, e.g. RawUTF8 or RawByteString
    constructor Create(const aText: RawByteString); overload;
    /// create a TStream with the supplied data buffer
    // - warning: there is no local copy of the supplied content: the
    // Data/DataLen buffer must be available during all the TSynMemoryStream usage:
    // don't release the source Data before calling TSynMemoryStream.Free
    constructor Create(Data: pointer; DataLen: PtrInt); overload;
    /// this TStream is read-only: calling this method will raise an exception
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

  /// a TStream created from a file content, using fast memory mapping
  TSynMemoryStreamMapped = class(TSynMemoryStream)
  protected
    fMap: TMemoryMap;
    fFileStream: TFileStream;
    fFileName: TFileName;
  public
    /// create a TStream from a file content using fast memory mapping
    // - if aCustomSize and aCustomOffset are specified, the corresponding
    // map view if created (by default, will map whole file)
    constructor Create(const aFileName: TFileName;
      aCustomSize: PtrUInt=0; aCustomOffset: Int64=0); overload;
    /// create a TStream from a file content using fast memory mapping
    // - if aCustomSize and aCustomOffset are specified, the corresponding
    // map view if created (by default, will map whole file)
    constructor Create(aFile: THandle;
      aCustomSize: PtrUInt=0; aCustomOffset: Int64=0); overload;
    /// release any internal mapped file instance
    destructor Destroy; override;
    /// the file name, if created from such Create(aFileName) constructor
    property FileName: TFileName read fFileName;
  end;

  /// available kind of integer array storage, corresponding to the data layout
  // - wkUInt32 will write the content as "plain" 4 bytes binary (this is the
  // prefered way if the integers can be negative)
  // - wkVarUInt32 will write the content using our 32-bit variable-length integer
  // encoding
  // - wkVarInt32 will write the content using our 32-bit variable-length integer
  // encoding and the by-two complement (0=0,1=1,2=-1,3=2,4=-2...)
  // - wkSorted will write an increasing array of integers, handling the special
  // case of a difference of similar value (e.g. 1) between two values
  // - wkOffsetU and wkOffsetI will write the difference between two successive
  // values, handling constant difference (Unsigned or Integer) in an optimized manner
  // - wkFakeMarker won't be used by WriteVarUInt32Array, but to notify a
  // custom encoding
  TFileBufferWriterKind = (wkUInt32, wkVarUInt32, wkVarInt32, wkSorted,
    wkOffsetU, wkOffsetI, wkFakeMarker);

  /// this class can be used to speed up writing to a file
  // - big speed up if data is written in small blocks
  // - also handle optimized storage of any dynamic array of Integer/Int64/RawUTF8
  // - use TFileBufferReader or TFastReader for decoding of the stored binary
  TFileBufferWriter = class
  private
    fPos: integer;
    fBufLen: Integer;
    fStream: TStream;
    fTotalWritten: Int64;
    fInternalStream: boolean;
    fTag: PtrInt;
    fBuffer: PByteArray;
    fBufInternal: RawByteString;
  public
    /// initialize the buffer, and specify a file handle to use for writing
    // - use an internal buffer of the specified size
    constructor Create(aFile: THandle; BufLen: integer=65536); overload;
    /// initialize the buffer, and specify a TStream to use for writing
    // - use an internal buffer of the specified size
    constructor Create(aStream: TStream; BufLen: integer=65536); overload;
    /// initialize the buffer, and specify a file to use for writing
    // - use an internal buffer of the specified size
    // - would replace any existing file by default, unless Append is TRUE
    constructor Create(const aFileName: TFileName; BufLen: integer=65536;
      Append: boolean=false); overload;
    /// initialize the buffer, using an internal TStream instance
    // - parameter could be e.g. THeapMemoryStream or TRawByteStringStream
    // - use Flush then TMemoryStream(Stream) to retrieve its content, or
    // TRawByteStringStream(Stream).DataString
    constructor Create(aClass: TStreamClass; BufLen: integer=4096); overload;
    /// initialize with a specified buffer and TStream class
    // - use a specified external buffer (which may be allocated on stack),
    // to avoid a memory allocation
    constructor Create(aStream: TStream; aTempBuf: pointer; aTempLen: integer); overload;
    /// initialize with a specified buffer
    // - use a specified external buffer (which may be allocated on stack),
    // to avoid a memory allocation
    // - aStream parameter could be e.g. THeapMemoryStream or TRawByteStringStream
    constructor Create(aClass: TStreamClass; aTempBuf: pointer; aTempLen: integer); overload;
    /// release internal TStream (after AssignToHandle call)
    // - warning: an explicit call to Flush is needed to write the data pending
    // in internal buffer
    destructor Destroy; override;
    /// append some data at the current position
    procedure Write(Data: pointer; DataLen: integer); overload;
    /// append 1 byte of data at the current position
    procedure Write1(Data: Byte); {$ifdef HASINLINE}inline;{$endif}
    /// append 2 bytes of data at the current position
    procedure Write2(Data: Word); {$ifdef HASINLINE}inline;{$endif}
    /// append 4 bytes of data at the current position
    procedure Write4(Data: integer); {$ifdef HASINLINE}inline;{$endif}
    /// append 4 bytes of data, encoded as BigEndian, at the current position
    procedure Write4BigEndian(Data: integer); {$ifdef HASINLINE}inline;{$endif}
    /// append 8 bytes of data at the current position
    procedure Write8(const Data8Bytes); {$ifdef HASINLINE}inline;{$endif}
    /// append the same byte a given number of occurences at the current position
    procedure WriteN(Data: Byte; Count: integer);
    /// append some UTF-8 encoded text at the current position
    // - will write the string length (as VarUInt32), then the string content, as expected
    // by the FromVarString() function
    procedure Write(const Text: RawByteString); overload; {$ifdef HASINLINE}inline;{$endif}
    /// append some UTF-8 encoded text at the current position
    // - will write the string length (as VarUInt32), then the string content
    procedure WriteShort(const Text: ShortString);
    /// append some content at the current position
    // - will write the binary data, without any length prefix
    procedure WriteBinary(const Data: RawByteString);
    {$ifndef NOVARIANTS}
    /// append some variant value at the current position
    // - matches FromVarVariant() and VariantSave/VariantLoad format
    procedure Write(const Value: variant); overload;
    /// append some TDocVariant value at the current position, as JSON string
    // - matches TFastReader.NextDocVariantData format
    procedure WriteDocVariantData(const Value: variant);
    {$endif}
    /// append some dynamic array at the current position
    // - will use the binary serialization as for:
    // ! aWriter.WriteBinary(DA.SaveTo);
    // but writing directly into the buffer, if possible
    procedure WriteDynArray(const DA: TDynArray);
    /// append "New[0..Len-1] xor Old[0..Len-1]" bytes
    // - as used e.g. by ZeroCompressXor/TSynBloomFilterDiff.SaveTo
    procedure WriteXor(New,Old: PAnsiChar; Len: integer; crc: PCardinal=nil);
    /// append a cardinal value using 32-bit variable-length integer encoding
    procedure WriteVarUInt32(Value: PtrUInt);
    /// append an integer value using 32-bit variable-length integer encoding of
    // the by-two complement of the given value
    procedure WriteVarInt32(Value: PtrInt);
    /// append an integer value using 64-bit variable-length integer encoding of
    // the by-two complement of the given value
    procedure WriteVarInt64(Value: Int64);
    /// append an unsigned integer value using 64-bit variable-length encoding
    procedure WriteVarUInt64(Value: QWord);
    /// append cardinal values (NONE must be negative!) using 32-bit
    // variable-length integer encoding or other specialized algorithm,
    // depending on the data layout
    procedure WriteVarUInt32Array(const Values: TIntegerDynArray; ValuesCount: integer;
      DataLayout: TFileBufferWriterKind);
    /// append cardinal values (NONE must be negative!) using 32-bit
    // variable-length integer encoding or other specialized algorithm,
    // depending on the data layout
    procedure WriteVarUInt32Values(Values: PIntegerArray; ValuesCount: integer;
      DataLayout: TFileBufferWriterKind);
    /// append UInt64 values using 64-bit variable length integer encoding
    // - if Offset is TRUE, then it will store the difference between
    // two values using 64-bit variable-length integer encoding (in this case,
    // a fixed-sized record storage is also handled separately)
    // - could be decoded later on via TFileBufferReader.ReadVarUInt64Array
    procedure WriteVarUInt64DynArray(const Values: TInt64DynArray;
      ValuesCount: integer; Offset: Boolean);
    /// append the RawUTF8 dynamic array
    // - handled the fixed size strings array case in a very efficient way
    procedure WriteRawUTF8DynArray(const Values: TRawUTF8DynArray; ValuesCount: integer);
    /// append the RawUTF8List content
    // - if StoreObjectsAsVarUInt32 is TRUE, all Objects[] properties will be
    // stored as VarUInt32
    procedure WriteRawUTF8List(List: TRawUTF8List; StoreObjectsAsVarUInt32: Boolean=false);
    /// append a TStream content
    // - is StreamSize is left as -1, the Stream.Size is used
    // - the size of the content is stored in the resulting stream
    procedure WriteStream(aStream: TCustomMemoryStream; aStreamSize: Integer=-1);
    /// allows to write directly to a memory buffer
    // - caller should specify the maximum possible number of bytes to be written
    // - then write the data to the returned pointer, and call WriteDirectEnd
    function WriteDirectStart(maxSize: integer; const TooBigMessage: RawUTF8=''): PByte;
    /// finalize a direct write to a memory buffer
    // - by specifying the number of bytes written to the buffer
    procedure WriteDirectEnd(realSize: integer);
    /// write any pending data in the internal buffer to the file
    // - after a Flush, it's possible to call FileSeek64(aFile,....)
    // - returns the number of bytes written between two FLush method calls
    function Flush: Int64;
    /// write any pending data, then call algo.Compress() on the buffer
    // - expect the instance to have been created via
    // ! TFileBufferWriter.Create(TRawByteStringStream)
    // - if algo is left to its default nil, will use global AlgoSynLZ
    // - features direct compression from internal buffer, if stream was not used
    // - BufferOffset could be set to reserve some bytes before the compressed buffer
    function FlushAndCompress(nocompression: boolean=false; algo: TAlgoCompress=nil;
      BufferOffset: integer=0): RawByteString;
    /// rewind the Stream to the position when Create() was called
    // - note that this does not clear the Stream content itself, just
    // move back its writing position to its initial place
    procedure CancelAll; virtual;
    /// the associated writing stream
    property Stream: TStream read fStream;
    /// get the byte count written since last Flush
    property TotalWritten: Int64 read fTotalWritten;
    /// simple property used to store some integer content
    property Tag: PtrInt read fTag write fTag;
  end;

  PFileBufferReader = ^TFileBufferReader;

  /// this structure can be used to speed up reading from a file
  // - use internaly memory mapped files for a file up to 2 GB (Windows has
  // problems with memory mapped files bigger than this size limit - at least
  // with 32-bit executables) - but sometimes, Windows fails to allocate
  // more than 512 MB for a memory map, because it does lack of contiguous
  // memory space: in this case, we fall back on direct file reading
  // - maximum handled file size has no limit (but will use slower direct
  // file reading)
  // - can handle sophisticated storage layout of TFileBufferWriter for
  // dynamic arrays of Integer/Int64/RawUTF8
  // - is defined either as an object either as a record, due to a bug
  // in Delphi 2009/2010 compiler (at least): this structure is not initialized
  // if defined as an object on the stack, but will be as a record :(
  {$ifdef FPC_OR_UNICODE}TFileBufferReader = record private
  {$else}TFileBufferReader = object protected{$endif}
    fCurrentPos: PtrUInt;
    fMap: TMemoryMap;
    /// get Isize + buffer from current memory map or fBufTemp into (P,PEnd)
    procedure ReadChunk(out P, PEnd: PByte; var BufTemp: RawByteString);
  public
    /// initialize the buffer, and specify a file to use for reading
    // - will try to map the whole file content in memory
    // - if memory mapping failed, methods will use default slower file API
    procedure Open(aFile: THandle);
    /// initialize the buffer from an already existing memory block
    // - may be e.g. a resource or a TMemoryStream
    procedure OpenFrom(aBuffer: pointer; aBufferSize: PtrUInt); overload;
    /// initialize the buffer from an already existing memory block
    procedure OpenFrom(const aBuffer: RawByteString); overload;
    /// initialize the buffer from an already existing Stream
    // - accept either TFileStream or TCustomMemoryStream kind of stream
    function OpenFrom(Stream: TStream): boolean; overload;
    /// close all internal mapped files
    // - call Open() again to use the Read() methods
    procedure Close;
    {$ifndef CPU64}
    /// change the current reading position, from the beginning of the file
    // - returns TRUE if success, or FALSE if Offset is out of range
    function Seek(Offset: Int64): boolean; overload;
    {$endif}
    /// change the current reading position, from the beginning of the file
    // - returns TRUE if success, or FALSE if Offset is out of range
    function Seek(Offset: PtrInt): boolean; overload;
    /// read some bytes from the given reading position
    // - returns the number of bytes which was read
    // - if Data is nil, it won't read content but will forward reading position
    function Read(Data: pointer; DataLen: integer): integer; overload;
    /// read some UTF-8 encoded text at the current position
    // - returns the resulting text length, in bytes
    function Read(out Text: RawUTF8): integer; overload;
    /// read some buffer texgt at the current position
    // - returns the resulting text length, in bytes
    function Read(out Text: RawByteString): integer; overload;
    /// read some UTF-8 encoded text at the current position
    // - returns the resulting text
    function ReadRawUTF8: RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    /// read one byte
    // - if reached end of file, don't raise any error, but returns 0
    function ReadByte: PtrUInt; {$ifdef HASINLINE}inline;{$endif}
    /// read one cardinal, which was written as fixed length
    // - if reached end of file, don't raise any error, but returns 0
    function ReadCardinal: cardinal;
    /// read one cardinal value encoded using our 32-bit variable-length integer
    function ReadVarUInt32: PtrUInt;
    /// read one integer value encoded using our 32-bit variable-length integer,
    // and the by-two complement
    function ReadVarInt32: PtrInt;
    /// read one UInt64 value encoded using our 64-bit variable-length integer
    function ReadVarUInt64: QWord;
    /// read one Int64 value encoded using our 64-bit variable-length integer
    function ReadVarInt64: Int64;
    /// retrieved cardinal values encoded with TFileBufferWriter.WriteVarUInt32Array
    // - returns the number of items read into Values[] (may differ from
    // length(Values), which will be resized, so could be void before calling)
    // - if the returned integer is negative, it is -Count, and testifies from
    // wkFakeMarker and the content should be retrieved by the caller
    function ReadVarUInt32Array(var Values: TIntegerDynArray): PtrInt;
    /// retrieved Int64 values encoded with TFileBufferWriter.WriteVarUInt64DynArray
    // - returns the number of items read into Values[] (may differ from length(Values))
    function ReadVarUInt64Array(var Values: TInt64DynArray): PtrInt;
    /// retrieved RawUTF8 values encoded with TFileBufferWriter.WriteRawUTF8DynArray
    // - returns the number of items read into Values[] (may differ from length(Values))
    function ReadVarRawUTF8DynArray(var Values: TRawUTF8DynArray): PtrInt;
    /// retrieve the RawUTF8List content encoded with TFileBufferWriter.WriteRawUTF8List
    // - if StoreObjectsAsVarUInt32 was TRUE, all Objects[] properties will be
    // retrieved as VarUInt32
    function ReadRawUTF8List(List: TRawUTF8List): boolean;
    /// retrieve a pointer to the current position, for a given data length
    // - if the data is available in the current memory mapped file, it
    // will just return a pointer to it
    // - otherwise (i.e. if the data is split between to 1GB memory map buffers),
    // data will be copied into the temporary aTempData buffer before retrieval
    function ReadPointer(DataLen: PtrUInt; var aTempData: RawByteString): pointer;
    /// create a TMemoryStream instance from the current position
    // - the content size is either specified by DataLen>=0, either available at
    // the current position, as saved by TFileBufferWriter.WriteStream method
    // - if this content fit in the current 1GB memory map buffer, a
    // TSynMemoryStream instance is returned, with no data copy (faster)
    // - if this content is not already mapped in memory, a separate memory map
    // will be created (the returned instance is a TSynMemoryStreamMapped)
    function ReadStream(DataLen: PtrInt=-1): TCustomMemoryStream;
    /// retrieve the current in-memory pointer
    // - if file was not memory-mapped, returns nil
    // - if DataLen>0, will increment the current in-memory position
    function CurrentMemory(DataLen: PtrUInt=0): pointer;
    /// retrieve the current in-memory position
    // - if file was not memory-mapped, returns -1
    function CurrentPosition: integer;
    /// raise an exception in case of invalid content
    procedure ErrorInvalidContent;
    /// read-only access to the global file size
    property FileSize: Int64 read fMap.fFileSize;
    /// read-only access to the global mapped buffer binary
    property MappedBuffer: PAnsiChar read fMap.fBuf;
  end;

/// FileSeek() overloaded function, working with huge files
// - Delphi FileSeek() is buggy -> use this function to safe access files > 2 GB
// (thanks to sanyin for the report)
function FileSeek64(Handle: THandle; const Offset: Int64; Origin: cardinal): Int64;

/// wrapper to serialize a T*ObjArray dynamic array as JSON
// - as expected by TJSONSerializer.RegisterObjArrayForJSON()
function ObjArrayToJSON(const aObjArray;
  aOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;

/// encode the supplied data as an UTF-8 valid JSON object content
// - data must be supplied two by two, as Name,Value pairs, e.g.
// ! JSONEncode(['name','John','year',1972]) = '{"name":"John","year":1972}'
// - or you can specify nested arrays or objects with '['..']' or '{'..'}':
// ! J := JSONEncode(['doc','{','name','John','abc','[','a','b','c',']','}','id',123]);
// ! assert(J='{"doc":{"name":"John","abc":["a","b","c"]},"id":123}');
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
// - you can pass nil as parameter for a null JSON value
function JSONEncode(const NameValuePairs: array of const): RawUTF8; overload;

{$ifndef NOVARIANTS}
/// encode the supplied (extended) JSON content, with parameters,
// as an UTF-8 valid JSON object content
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names:
// ! aJSON := JSONEncode('{id:?,%:{name:?,birthyear:?}}',['doc'],[10,'John',1982]);
// - you can use nested _Obj() / _Arr() instances
// ! aJSON := JSONEncode('{%:{$in:[?,?]}}',['type'],['food','snack']);
// ! aJSON := JSONEncode('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
// ! // will both return
// ! '{"type":{"$in":["food","snack"]}}')
// - if the SynMongoDB unit is used in the application, the MongoDB Shell
// syntax will also be recognized to create TBSONVariant, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// !  aJSON := JSONEncode('{name:?,field:/%/i}',['acme.*corp'],['John']))
// ! // will return
// ! '{"name":"John","field":{"$regex":"acme.*corp","$options":"i"}}'
// - will call internally _JSONFastFmt() to create a temporary TDocVariant with
// all its features - so is slightly slower than other JSONEncode* functions
function JSONEncode(const Format: RawUTF8; const Args,Params: array of const): RawUTF8; overload;
{$endif}

/// encode the supplied RawUTF8 array data as an UTF-8 valid JSON array content
function JSONEncodeArrayUTF8(const Values: array of RawUTF8): RawUTF8; overload;

/// encode the supplied integer array data as a valid JSON array
function JSONEncodeArrayInteger(const Values: array of integer): RawUTF8; overload;

/// encode the supplied floating-point array data as a valid JSON array
function JSONEncodeArrayDouble(const Values: array of double): RawUTF8; overload;

/// encode the supplied array data as a valid JSON array content
// - if WithoutBraces is TRUE, no [ ] will be generated
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean=false): RawUTF8; overload;

/// encode the supplied array data as a valid JSON array content
// - if WithoutBraces is TRUE, no [ ] will be generated
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
procedure JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean; var result: RawUTF8); overload;

/// encode as JSON {"name":value} object, from a potential SQL quoted value
// - will unquote the SQLValue using TTextWriter.AddQuotedStringAsJSON()
procedure JSONEncodeNameSQLValue(const Name,SQLValue: RawUTF8; var result: RawUTF8);

type
  /// points to one value of raw UTF-8 content, decoded from a JSON buffer
  // - used e.g. by JSONDecode() overloaded function to returns names/values
  {$ifdef FPC_OR_UNICODE}TValuePUTF8Char = record{$else}TValuePUTF8Char = object{$endif}
  public
    /// a pointer to the actual UTF-8 text
    Value: PUTF8Char;
    /// how many UTF-8 bytes are stored in Value
    ValueLen: PtrInt;
    /// convert the value into a UTF-8 string
    procedure ToUTF8(var Text: RawUTF8); overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert the value into a UTF-8 string
    function ToUTF8: RawUTF8; overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert the value into a VCL/generic string
    function ToString: string;
    /// convert the value into a signed integer
    function ToInteger: PtrInt; {$ifdef HASINLINE}inline;{$endif}
    /// convert the value into an unsigned integer
    function ToCardinal: PtrUInt; {$ifdef HASINLINE}inline;{$endif}
    /// will call IdemPropNameU() over the stored text Value
    function Idem(const Text: RawUTF8): boolean; {$ifdef HASINLINE}inline;{$endif}
  end;
  /// used e.g. by JSONDecode() overloaded function to returns values
  TValuePUTF8CharArray = array[0..maxInt div SizeOf(TValuePUTF8Char)-1] of TValuePUTF8Char;
  PValuePUTF8CharArray = ^TValuePUTF8CharArray;

  /// store one name/value pair of raw UTF-8 content, from a JSON buffer
  // - used e.g. by JSONDecode() overloaded function to returns names/values
  TNameValuePUTF8Char = record
    /// a pointer to the actual UTF-8 name text
    Name: PUTF8Char;
    /// a pointer to the actual UTF-8 value text
    Value: PUTF8Char;
    /// how many UTF-8 bytes are stored in Name
    NameLen: integer;
    /// how many UTF-8 bytes are stored in Value
    ValueLen: integer;
  end;
  /// used e.g. by JSONDecode() overloaded function to returns name/value pairs
  TNameValuePUTF8CharDynArray = array of TNameValuePUTF8Char;

/// decode the supplied UTF-8 JSON content for the supplied names
// - data will be set in Values, according to the Names supplied e.g.
// ! JSONDecode(JSON,['name','year'],@Values) -> Values[0].Value='John'; Values[1].Value='1972';
// - if any supplied name wasn't found its corresponding Values[] will be nil
// - this procedure will decode the JSON content in-memory, i.e. the PUtf8Char
// array is created inside JSON, which is therefore modified: make a private
// copy first if you want to reuse the JSON content
// - if HandleValuesAsObjectOrArray is TRUE, then this procedure will handle
// JSON arrays or objects
// - support enhanced JSON syntax, e.g. '{name:'"John",year:1972}' is decoded
// just like '{"name":'"John","year":1972}'
procedure JSONDecode(var JSON: RawUTF8; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean=false); overload;

/// decode the supplied UTF-8 JSON content for the supplied names
// - an overloaded function when the JSON is supplied as a RawJSON variable
procedure JSONDecode(var JSON: RawJSON; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean=false); overload;

/// decode the supplied UTF-8 JSON content for the supplied names
// - data will be set in Values, according to the Names supplied e.g.
// ! JSONDecode(P,['name','year'],Values) -> Values[0]^='John'; Values[1]^='1972';
// - if any supplied name wasn't found its corresponding Values[] will be nil
// - this procedure will decode the JSON content in-memory, i.e. the PUtf8Char
// array is created inside P, which is therefore modified: make a private
// copy first if you want to reuse the JSON content
// - if HandleValuesAsObjectOrArray is TRUE, then this procedure will handle
// JSON arrays or objects
// - if ValuesLen is set, ValuesLen[] will contain the length of each Values[]
// - returns a pointer to the next content item in the JSON buffer
function JSONDecode(P: PUTF8Char; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char; overload;

/// decode the supplied UTF-8 JSON content into an array of name/value pairs
// - this procedure will decode the JSON content in-memory, i.e. the PUtf8Char
// array is created inside JSON, which is therefore modified: make a private
// copy first if you want to reuse the JSON content
// - the supplied JSON buffer should stay available until Name/Value pointers
// from returned Values[] are accessed
// - if HandleValuesAsObjectOrArray is TRUE, then this procedure will handle
// JSON arrays or objects
// - support enhanced JSON syntax, e.g. '{name:'"John",year:1972}' is decoded
// just like '{"name":'"John","year":1972}'
function JSONDecode(P: PUTF8Char; out Values: TNameValuePUTF8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char; overload;

/// decode the supplied UTF-8 JSON content for the one supplied name
// - this function will decode the JSON content in-memory, so will unescape it
// in-place: it must be called only once with the same JSON data
function JSONDecode(var JSON: RawUTF8; const aName: RawUTF8='result';
  wasString: PBoolean=nil; HandleValuesAsObjectOrArray: Boolean=false): RawUTF8; overload;

/// retrieve a pointer to JSON string field content
// - returns either ':' for name field, either '}',',' for value field
// - returns nil on JSON content error
// - this function won't touch the JSON buffer, so you can call it before
// using in-place escape process via JSONDecode() or GetJSONField()
function JSONRetrieveStringField(P: PUTF8Char; out Field: PUTF8Char;
  out FieldLen: integer; ExpectNameField: boolean): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// decode a JSON field in an UTF-8 encoded buffer (used in TSQLTableJSON.Create)
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that P^ is not shared
// - PDest points to the next field to be decoded, or nil when end is reached
// - EndOfObject (if not nil) is set to the JSON value char (',' ':' or '}' e.g.)
// - optional wasString is set to true if the JSON value was a JSON "string"
// - '"strings"' are decoded as 'strings', with wasString=true, properly JSON
// unescaped (e.g. any \u0123 pattern would be converted into UTF-8 content)
// - null is decoded as nil, with wasString=false
// - true/false boolean values are returned as 'true'/'false', with wasString=false
// - any number value is returned as its ascii representation, with wasString=false
// - works for both field names or values (e.g. '"FieldName":' or 'Value,')
function GetJSONField(P: PUTF8Char; out PDest: PUTF8Char;
  wasString: PBoolean=nil; EndOfObject: PUTF8Char=nil; Len: PInteger=nil): PUTF8Char;

/// decode a JSON field name in an UTF-8 encoded buffer
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that P^ is not shared
// - it will return the property name (with an ending #0) or nil on error
// - this function will handle strict JSON property name (i.e. a "string"), but
// also MongoDB extended syntax, e.g. {age:{$gt:18}} or {'people.age':{$gt:18}}
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
function GetJSONPropName(var P: PUTF8Char; Len: PInteger=nil): PUTF8Char; overload;

/// decode a JSON field name in an UTF-8 encoded shortstring variable
// - this function would left the P^ buffer memory untouched, so may be safer
// than the overloaded GetJSONPropName() function in some cases
// - it will return the property name as a local UTF-8 encoded shortstring,
// or PropName='' on error
// - this function won't unescape the property name, as strict JSON (i.e. a "st\"ring")
// - but it will handle MongoDB syntax, e.g. {age:{$gt:18}} or {'people.age':{$gt:18}}
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
procedure GetJSONPropName(var P: PUTF8Char; out PropName: shortstring); overload;

/// decode a JSON content in an UTF-8 encoded buffer
// - GetJSONField() will only handle JSON "strings" or numbers - if
// HandleValuesAsObjectOrArray is TRUE, this function will process JSON {
// objects } or [ arrays ] and add a #0 at the end of it
// - this function decodes in the P^ buffer memory itself (no memory allocation
// or copy), for faster process - so take care that it is an unique string
// - returns a pointer to the value start, and moved P to the next field to
// be decoded, or P=nil in case of any unexpected input
// - wasString is set to true if the JSON value was a "string"
// - EndOfObject (if not nil) is set to the JSON value end char (',' ':' or '}')
// - if Len is set, it will contain the length of the returned pointer value
function GetJSONFieldOrObjectOrArray(var P: PUTF8Char; wasString: PBoolean=nil;
  EndOfObject: PUTF8Char=nil; HandleValuesAsObjectOrArray: Boolean=false;
  NormalizeBoolean: Boolean=true; Len: PInteger=nil): PUTF8Char;

/// retrieve the next JSON item as a RawJSON variable
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - EndOfObject (if not nil) is set to the JSON value end char (',' ':' or '}')
procedure GetJSONItemAsRawJSON(var P: PUTF8Char; var result: RawJSON;
  EndOfObject: PAnsiChar=nil);

/// retrieve the next JSON item as a RawUTF8 decoded buffer
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - EndOfObject (if not nil) is set to the JSON value end char (',' ':' or '}')
// - just call GetJSONField(), and create a new RawUTF8 from the returned value,
// after proper unescape if wasString^=true
function GetJSONItemAsRawUTF8(var P: PUTF8Char; var output: RawUTF8;
  wasString: PBoolean=nil; EndOfObject: PUTF8Char=nil): boolean;

/// test if the supplied buffer is a "string" value or a numerical value
// (floating point or integer), according to the characters within
// - this version will recognize null/false/true as strings
// - e.g. IsString('0')=false, IsString('abc')=true, IsString('null')=true
function IsString(P: PUTF8Char): boolean;

/// test if the supplied buffer is a "string" value or a numerical value
// (floating or integer), according to the JSON encoding schema
// - this version will NOT recognize JSON null/false/true as strings
// - e.g. IsStringJSON('0')=false, IsStringJSON('abc')=true,
// but IsStringJSON('null')=false
// - will follow the JSON definition of number, i.e. '0123' is a string (i.e.
// '0' is excluded at the begining of a number) and '123' is not a string
function IsStringJSON(P: PUTF8Char): boolean;

/// reach positon just after the current JSON item in the supplied UTF-8 buffer
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - returns nil if the specified buffer is not valid JSON content
// - returns the position in buffer just after the item excluding the separator
// character - i.e. result^ may be ',','}',']'
function GotoEndJSONItem(P: PUTF8Char): PUTF8Char;

/// reach the positon of the next JSON item in the supplied UTF-8 buffer
// - buffer can be either any JSON item, i.e. a string, a number or even a
// JSON array (ending with ]) or a JSON object (ending with })
// - returns nil if the specified number of items is not available in buffer
// - returns the position in buffer after the item including the separator
// character (optionally in EndOfObject) - i.e. result will be at the start of
// the next object, and EndOfObject may be ',','}',']'
function GotoNextJSONItem(P: PUTF8Char; NumberOfItemsToJump: cardinal=1;
  EndOfObject: PAnsiChar=nil): PUTF8Char;

/// read the position of the JSON value just after a property identifier
// - this function will handle strict JSON property name (i.e. a "string"), but
// also MongoDB extended syntax, e.g. {age:{$gt:18}} or {'people.age':{$gt:18}}
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
function GotoNextJSONPropName(P: PUTF8Char): PUTF8Char;

/// reach the position of the next JSON object of JSON array
// - first char is expected to be either '[' or '{'
// - will return nil in case of parsing error or unexpected end (#0)
// - will return the next character after ending ] or } - i.e. may be , } ]
function GotoNextJSONObjectOrArray(P: PUTF8Char): PUTF8Char; overload;
  {$ifdef FPC}inline;{$endif}

/// reach the position of the next JSON object of JSON array
// - first char is expected to be just after the initial '[' or '{'
// - specify ']' or '}' as the expected EndChar
// - will return nil in case of parsing error or unexpected end (#0)
// - will return the next character after ending ] or } - i.e. may be , } ]
function GotoNextJSONObjectOrArray(P: PUTF8Char; EndChar: AnsiChar): PUTF8Char; overload;
  {$ifdef FPC}inline;{$endif}

/// reach the position of the next JSON object of JSON array
// - first char is expected to be either '[' or '{'
// - this version expects a maximum position in PMax: it may be handy to break
// the parsing for HUGE content - used e.g. by JSONArrayCount(P,PMax)
// - will return nil in case of parsing error or if P reached PMax limit
// - will return the next character after ending ] or { - i.e. may be , } ]
function GotoNextJSONObjectOrArrayMax(P,PMax: PUTF8Char): PUTF8Char;

/// compute the number of elements of a JSON array
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char AFTER the initial '[' (which
// may be a closing ']')
// - returns -1 if the supplied input is invalid, or the number of identified
// items in the JSON array buffer
function JSONArrayCount(P: PUTF8Char): integer; overload;

/// compute the number of elements of a JSON array
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char after the initial '[' (which
// may be a closing ']')
// - this overloaded method will abort if P reaches a certain position: for
// really HUGE arrays, it is faster to allocate the content within the loop,
// not ahead of time
function JSONArrayCount(P,PMax: PUTF8Char): integer; overload;

/// go to the #nth item of a JSON array
// - implemented via a fast SAX-like approach: the input buffer is not changed,
// nor no memory buffer allocated neither content copied
// - returns nil if the supplied index is out of range
// - returns a pointer to the index-nth item in the JSON array (first index=0)
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '[' char
function JSONArrayItem(P: PUTF8Char; Index: integer): PUTF8Char;

/// retrieve all elements of a JSON array
// - this will handle any kind of arrays, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char AFTER the initial '[' (which
// may be a closing ']')
// - returns false if the supplied input is invalid
// - returns true on success, with Values[] pointing to each unescaped value,
// may be a JSON string, object, array of constant
function JSONArrayDecode(P: PUTF8Char; out Values: TPUTF8CharDynArray): boolean;

/// compute the number of fields in a JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first char after the initial '{' (which
// may be a closing '}')
function JSONObjectPropCount(P: PUTF8Char): integer;

/// go to a named property of a JSON object
// - implemented via a fast SAX-like approach: the input buffer is not changed,
// nor no memory buffer allocated neither content copied
// - returns nil if the supplied property name does not exist
// - returns a pointer to the matching item in the JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '{' char
function JsonObjectItem(P: PUTF8Char; const PropName: RawUTF8;
  PropNameFound: PRawUTF8=nil): PUTF8Char;

/// go to a property of a JSON object, by its full path, e.g. 'parent.child'
// - implemented via a fast SAX-like approach: the input buffer is not changed,
// nor no memory buffer allocated neither content copied
// - returns nil if the supplied property path does not exist
// - returns a pointer to the matching item in the JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '{' char
function JsonObjectByPath(JsonObject,PropPath: PUTF8Char): PUTF8Char;

/// return all matching properties of a JSON object
// - here the PropPath could be a comma-separated list of full paths,
// e.g. 'Prop1,Prop2' or 'Obj1.Obj2.Prop1,Obj1.Prop2'
// - returns '' if no property did match
// - returns a JSON object of all matching properties
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
// - incoming P^ should point to the first initial '{' char
function JsonObjectsByPath(JsonObject,PropPath: PUTF8Char): RawUTF8;

/// convert one JSON object into two JSON arrays of keys and values
// - i.e. makes the following transformation:
// $ {key1:value1,key2,value2...} -> [key1,key2...] + [value1,value2...]
// - this function won't allocate any memory during its process, nor
// modify the JSON input buffer
// - is the reverse of the TTextWriter.AddJSONArraysAsJSONObject() method
function JSONObjectAsJSONArrays(JSON: PUTF8Char; out keys,values: RawUTF8): boolean;

/// remove comments from a text buffer before passing it to JSON parser
// - handle two types of comments: starting from // till end of line
// or /* ..... */ blocks anywhere in the text content
// - may be used to prepare configuration files before loading;
// for example we store server configuration in file config.json and
// put some comments in this file then code for loading is:
// !var cfg: RawUTF8;
// !  cfg := StringFromFile(ExtractFilePath(paramstr(0))+'Config.json');
// !  RemoveCommentsFromJSON(@cfg[1]);
// !  pLastChar := JSONToObject(sc,pointer(cfg),configValid);
procedure RemoveCommentsFromJSON(P: PUTF8Char);

const
  /// standard header for an UTF-8 encoded XML file
  XMLUTF8_HEADER = '<?xml version="1.0" encoding="UTF-8"?>'#13#10;

  /// standard namespace for a generic XML File
  XMLUTF8_NAMESPACE = '<contents xmlns="http://www.w3.org/2001/XMLSchema-instance">';

/// convert a JSON array or document into a simple XML content
// - just a wrapper around TTextWriter.AddJSONToXML, with an optional
// header before the XML converted data (e.g. XMLUTF8_HEADER), and an optional
// name space content node which will nest the generated XML data (e.g.
// '<contents xmlns="http://www.w3.org/2001/XMLSchema-instance">') - the
// corresponding ending token will be appended after (e.g. '</contents>')
// - WARNING: the JSON buffer is decoded in-place, so P^ WILL BE modified
procedure JSONBufferToXML(P: PUTF8Char; const Header,NameSpace: RawUTF8; out result: RawUTF8);

/// convert a JSON array or document into a simple XML content
// - just a wrapper around TTextWriter.AddJSONToXML, making a private copy
// of the supplied JSON buffer using TSynTempBuffer (so that JSON content
// would stay untouched)
// - the optional header is added at the beginning of the resulting string
// - an optional name space content node could be added around the generated XML,
// e.g. '<content>'
function JSONToXML(const JSON: RawUTF8; const Header: RawUTF8=XMLUTF8_HEADER;
  const NameSpace: RawUTF8=''): RawUTF8;

/// formats and indents a JSON array or document to the specified layout
// - just a wrapper around TTextWriter.AddJSONReformat() method
// - WARNING: the JSON buffer is decoded in-place, so P^ WILL BE modified
procedure JSONBufferReformat(P: PUTF8Char; out result: RawUTF8;
  Format: TTextWriterJSONFormat=jsonHumanReadable);

/// formats and indents a JSON array or document to the specified layout
// - just a wrapper around TTextWriter.AddJSONReformat, making a private
// of the supplied JSON buffer (so that JSON content  would stay untouched)
function JSONReformat(const JSON: RawUTF8;
  Format: TTextWriterJSONFormat=jsonHumanReadable): RawUTF8;

/// formats and indents a JSON array or document as a file
// - just a wrapper around TTextWriter.AddJSONReformat() method
// - WARNING: the JSON buffer is decoded in-place, so P^ WILL BE modified
function JSONBufferReformatToFile(P: PUTF8Char; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;

/// formats and indents a JSON array or document as a file
// - just a wrapper around TTextWriter.AddJSONReformat, making a private
// of the supplied JSON buffer (so that JSON content  would stay untouched)
function JSONReformatToFile(const JSON: RawUTF8; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;


const
  /// map a PtrInt type to the TJSONCustomParserRTTIType set
  ptPtrInt  = {$ifdef CPU64}ptInt64{$else}ptInteger{$endif};
  /// map a PtrUInt type to the TJSONCustomParserRTTIType set
  ptPtrUInt = {$ifdef CPU64}ptQWord{$else}ptCardinal{$endif};
  /// which TJSONCustomParserRTTIType types are not simple types
  // - ptTimeLog is complex, since could be also TCreateTime or TModTime
  PT_COMPLEXTYPES = [ptArray, ptRecord, ptCustom, ptTimeLog];
  /// could be used to compute the index in a pointer list from its position
  POINTERSHR = {$ifdef CPU64}3{$else}2{$endif};
  /// could be used to compute the bitmask of a pointer integer
  POINTERAND = {$ifdef CPU64}7{$else}3{$endif};


{ ************ some other common types and conversion routines ************** }

type
  /// timestamp stored as second-based Unix Time
  // - i.e. the number of seconds since 1970-01-01 00:00:00 UTC
  // - is stored as 64-bit value, so that it won't be affected by the
  // "Year 2038" overflow issue
  // - see TUnixMSTime for a millisecond resolution Unix Timestamp
  // - use UnixTimeToDateTime/DateTimeToUnixTime functions to convert it to/from
  // a regular TDateTime
  // - use UnixTimeUTC to return the current timestamp, using fast OS API call
  // - also one of the encodings supported by SQLite3 date/time functions
  TUnixTime = type Int64;

  /// timestamp stored as millisecond-based Unix Time
  // - i.e. the number of milliseconds since 1970-01-01 00:00:00 UTC
  // - see TUnixTime for a second resolution Unix Timestamp
  // - use UnixMSTimeToDateTime/DateTimeToUnixMSTime functions to convert it
  // to/from a regular TDateTime
  // - also one of the JavaScript date encodings
  TUnixMSTime = type Int64;

  /// pointer to a timestamp stored as second-based Unix Time
  PUnixTime = ^TUnixTime;
  /// pointer to a timestamp stored as millisecond-based Unix Time
  PUnixMSTime = ^TUnixMSTime;
  /// dynamic array of timestamps stored as second-based Unix Time
  TUnixTimeDynArray = array of TUnixTime;
  /// dynamic array of timestamps stored as millisecond-based Unix Time
  TUnixMSTimeDynArray = array of TUnixMSTime;

type
  /// calling context of TSynLogExceptionToStr callbacks
  TSynLogExceptionContext = record
    /// the raised exception class
    EClass: ExceptClass;
    /// the Delphi Exception instance
    // - may be nil for external/OS exceptions
    EInstance: Exception;
    /// the OS-level exception code
    // - could be $0EEDFAE0 of $0EEDFADE for Delphi-generated exceptions
    ECode: DWord;
    /// the address where the exception occured
    EAddr: PtrUInt;
    /// the optional stack trace
    EStack: PPtrUInt;
    /// = FPC's RaiseProc() FrameCount if EStack is Frame: PCodePointer
    EStackCount: integer;
    /// the timestamp of this exception, as number of seconds since UNIX Epoch
    // - UnixTimeUTC is faster than NowUTC or GetSystemTime
    // - use UnixTimeToDateTime() to convert it into a regular TDateTime
    ETimestamp: TUnixTime;
    /// the logging level corresponding to this exception
    // - may be either sllException or sllExceptionOS
    ELevel: TSynLogInfo;
  end;

  /// global hook callback to customize exceptions logged by TSynLog
  // - should return TRUE if all needed information has been logged by the
  // event handler
  // - should return FALSE if Context.EAddr and Stack trace is to be appended
  TSynLogExceptionToStr = function(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean;

  {$M+}
  /// generic parent class of all custom Exception types of this unit
  // - all our classes inheriting from ESynException are serializable,
  // so you could use ObjectToJSONDebug(anyESynException) to retrieve some
  // extended information
  ESynException = class(Exception)
  protected
    fRaisedAt: pointer;
  public
    /// constructor which will use FormatUTF8() instead of Format()
    // - expect % as delimiter, so is less error prone than %s %d %g
    // - will handle vtPointer/vtClass/vtObject/vtVariant kind of arguments,
    // appending class name for any class or object, the hexa value for a
    // pointer, or the JSON representation of any supplied TDocVariant
    constructor CreateUTF8(const Format: RawUTF8; const Args: array of const);
    /// constructor appending some FormatUTF8() content to the GetLastError
    // - message will contain GetLastError value followed by the formatted text
    // - expect % as delimiter, so is less error prone than %s %d %g
    // - will handle vtPointer/vtClass/vtObject/vtVariant kind of arguments,
    // appending class name for any class or object, the hexa value for a
    // pointer, or the JSON representation of any supplied TDocVariant
    constructor CreateLastOSError(const Format: RawUTF8; const Args: array of const);
    {$ifndef NOEXCEPTIONINTERCEPT}
    /// can be used to customize how the exception is logged
    // - this default implementation will call the DefaultSynLogExceptionToStr()
    // function or the TSynLogExceptionToStrCustom global callback, if defined
    // - override this method to provide a custom logging content
    // - should return TRUE if Context.EAddr and Stack trace is not to be
    // written (i.e. as for any TSynLogExceptionToStr callback)
    function CustomLog(WR: TTextWriter; const Context: TSynLogExceptionContext): boolean; virtual;
    {$endif}
    /// the code location when this exception was triggered
    // - populated by SynLog unit, during interception - so may be nil
    // - you can use TSynMapFile.FindLocation(ESynException) class function to
    // guess the corresponding source code line
    // - will be serialized as "Address": hexadecimal and source code location
    // (using TSynMapFile .map/.mab information) in TJSONSerializer.WriteObject
    // when woStorePointer option is defined - e.g. with ObjectToJSONDebug()
    property RaisedAt: pointer read fRaisedAt write fRaisedAt;
  published
    property Message;
  end;
  {$M-}
  ESynExceptionClass = class of ESynException;

  /// exception class associated to TDocVariant JSON/BSON document
  EDocVariant = class(ESynException);

  /// exception raised during TFastReader decoding
  EFastReader = class(ESynException);

var
  /// allow to customize the ESynException logging message
  TSynLogExceptionToStrCustom: TSynLogExceptionToStr = nil;

  {$ifndef NOEXCEPTIONINTERCEPT}
  /// default exception logging callback - will be set by the SynLog unit
  // - will add the default Exception details, including any Exception.Message
  // - if the exception inherits from ESynException
  // - returns TRUE: caller will then append ' at EAddr' and the stack trace
  DefaultSynLogExceptionToStr: TSynLogExceptionToStr = nil;
  {$endif}


/// convert a string into its INTEGER Curr64 (value*10000) representation
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - if NoDecimal is defined, will be set to TRUE if there is no decimal, AND
// the returned value will be an Int64 (not a PInt64(@Curr)^)
function StrToCurr64(P: PUTF8Char; NoDecimal: PBoolean=nil): Int64;

/// convert a string into its currency representation
// - will call StrToCurr64()
function StrToCurrency(P: PUTF8Char): currency;

/// convert a currency value into a string
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
function CurrencyToStr(Value: currency): RawUTF8;

/// convert an INTEGER Curr64 (value*10000) into a string
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
function Curr64ToStr(const Value: Int64): RawUTF8; overload;

/// convert an INTEGER Curr64 (value*10000) into a string
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
procedure Curr64ToStr(const Value: Int64; var result: RawUTF8); overload;

/// convert an INTEGER Curr64 (value*10000) into a string
// - this type is compatible with Delphi currency memory map with PInt64(@Curr)^
// - fast conversion, using only integer operations
// - decimals are joined by 2 (no decimal, 2 decimals, 4 decimals)
// - return the number of chars written to Dest^
function Curr64ToPChar(const Value: Int64; Dest: PUTF8Char): PtrInt;

/// internal fast INTEGER Curr64 (value*10000) value to text conversion
// - expect the last available temporary char position in P
// - return the last written char position (write in reverse order in P^)
// - will return 0 for Value=0, or a string representation with always 4 decimals
//   (e.g. 1->'0.0001' 500->'0.0500' 25000->'2.5000' 30000->'3.0000')
// - is called by Curr64ToPChar() and Curr64ToStr() functions
function StrCurr64(P: PAnsiChar; const Value: Int64): PAnsiChar;

/// truncate a Currency value to only 2 digits
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
function TruncTo2Digits(Value: Currency): Currency;

/// truncate a Currency value, stored as Int64, to only 2 digits
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
procedure TruncTo2DigitsCurr64(var Value: Int64);
  {$ifdef HASINLINE}inline;{$endif}

/// simple, no banker rounding of a Currency value to only 2 digits
// - #.##51 will round to #.##+0.01 and #.##50 will be truncated to #.##
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
function SimpleRoundTo2Digits(Value: Currency): Currency;

/// simple, no banker rounding of a Currency value, stored as Int64, to only 2 digits
// - #.##51 will round to #.##+0.01 and #.##50 will be truncated to #.##
// - implementation will use fast Int64 math to avoid any precision loss due to
// temporary floating-point conversion
procedure SimpleRoundTo2DigitsCurr64(var Value: Int64);

var
  /// a conversion table from hexa chars into binary data
  // - returns 255 for any character out of 0..9,A..Z,a..z range
  // - used e.g. by HexToBin() function
  // - is defined globally, since may be used from an inlined function
  ConvertHexToBin: array[byte] of byte;

  /// naive but efficient cache to avoid string memory allocation for
  // 0..999 small numbers by Int32ToUTF8/UInt32ToUTF8
  // - use around 16KB of heap (since each item consumes 16 bytes), but increase
  // overall performance and reduce memory allocation (and fragmentation),
  // especially during multi-threaded execution
  // - noticeable when strings are used as array indexes (e.g. in SynMongoDB BSON)
  // - is defined globally, since may be used from an inlined function
  SmallUInt32UTF8: array[0..999] of RawUTF8;

/// fast conversion from hexa chars into binary data
// - BinBytes contain the bytes count to be converted: Hex^ must contain
//  at least BinBytes*2 chars to be converted, and Bin^ enough space
// - if Bin=nil, no output data is written, but the Hex^ format is checked
// - return false if any invalid (non hexa) char is found in Hex^
// - using this function with Bin^ as an integer value will decode in big-endian
// order (most-signignifican byte first)
function HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean; overload;

/// fast conversion from one hexa char pair into a 8 bit AnsiChar
// - return false if any invalid (non hexa) char is found in Hex^
// - similar to HexToBin(Hex,nil,1)
function HexToCharValid(Hex: PAnsiChar): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast check if the supplied Hex buffer is an hexadecimal representation
// of a binary buffer of a given number of bytes
function IsHex(const Hex: RawByteString; BinBytes: integer): boolean;

/// fast conversion from one hexa char pair into a 8 bit AnsiChar
// - return false if any invalid (non hexa) char is found in Hex^
// - similar to HexToBin(Hex,Bin,1) but with Bin<>nil
// - use HexToCharValid if you want to check a hexadecimal char content
function HexToChar(Hex: PAnsiChar; Bin: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from two hexa bytes into a 16 bit UTF-16 WideChar
// - similar to HexToBin(Hex,@wordvar,2) + bswap(wordvar)
function HexToWideChar(Hex: PAnsiChar): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from binary data into hexa chars
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with BinBytes^ as an integer value will encode it
// in low-endian order (less-signignifican byte first): don't use it for display
procedure BinToHex(Bin, Hex: PAnsiChar; BinBytes: integer); overload;

/// fast conversion from hexa chars into binary data
function HexToBin(const Hex: RawUTF8): RawByteString; overload;

/// fast conversion from binary data into hexa chars
function BinToHex(const Bin: RawByteString): RawUTF8; overload;

/// fast conversion from binary data into hexa chars
function BinToHex(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from binary data into hexa chars, ready to be displayed
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with Bin^ as an integer value will encode it
// in big-endian order (most-signignifican byte first): use it for display
procedure BinToHexDisplay(Bin, Hex: PAnsiChar; BinBytes: integer); overload;

/// fast conversion from binary data into hexa chars, ready to be displayed
function BinToHexDisplay(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from binary data into lowercase hexa chars
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with BinBytes^ as an integer value will encode it
// in low-endian order (less-signignifican byte first): don't use it for display
procedure BinToHexLower(Bin, Hex: PAnsiChar; BinBytes: integer); overload;

/// fast conversion from binary data into lowercase hexa chars
function BinToHexLower(const Bin: RawByteString): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from binary data into lowercase hexa chars
function BinToHexLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from binary data into lowercase hexa chars
procedure BinToHexLower(Bin: PAnsiChar; BinBytes: integer; var result: RawUTF8); overload;

/// fast conversion from binary data into lowercase hexa chars
// - BinBytes contain the bytes count to be converted: Hex^ must contain
// enough space for at least BinBytes*2 chars
// - using this function with Bin^ as an integer value will encode it
// in big-endian order (most-signignifican byte first): use it for display
procedure BinToHexDisplayLower(Bin, Hex: PAnsiChar; BinBytes: PtrInt); overload;

/// fast conversion from binary data into lowercase hexa chars
function BinToHexDisplayLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from up to 127 bytes of binary data into lowercase hexa chars
function BinToHexDisplayLowerShort(Bin: PAnsiChar; BinBytes: integer): shortstring;

/// fast conversion from up to 64-bit of binary data into lowercase hexa chars
function BinToHexDisplayLowerShort16(Bin: Int64; BinBytes: integer): TShort16;

/// fast conversion from binary data into hexa lowercase chars, ready to be
// used as a convenient TFileName prefix
function BinToHexDisplayFile(Bin: PAnsiChar; BinBytes: integer): TFileName;

/// append one byte as hexadecimal char pairs, into a text buffer
function ByteToHex(P: PAnsiChar; Value: byte): PAnsiChar;

/// fast conversion from binary data to escaped text
// - non printable characters will be written as $xx hexadecimal codes
// - will be #0 terminated, with '...' characters trailing on overflow
// - ensure the destination buffer contains at least max*3+3 bytes, which is
// always the case when using LogEscape() and its local TLogEscape variable
function EscapeBuffer(s,d: PAnsiChar; len,max: integer): PAnsiChar;

const
  /// maximum size, in bytes, of a TLogEscape / LogEscape() buffer
  LOGESCAPELEN = 200;
type
  /// buffer to be allocated on stack when using LogEscape()
  TLogEscape = array[0..LOGESCAPELEN*3+5] of AnsiChar;

/// fill TLogEscape stack buffer with the (hexadecimal) chars of the input binary
// - up to LOGESCAPELEN (i.e. 200) bytes will be escaped and appended to a
// Local temp: TLogEscape variable, using the EscapeBuffer() low-level function
// - you can then log the resulting escaped text by passing the returned
// PAnsiChar as % parameter to a TSynLog.Log() method
// - the "enabled" parameter can be assigned from a process option, avoiding to
// process the escape if verbose logs are disabled
// - used e.g. to implement logBinaryFrameContent option for WebSockets
function LogEscape(source: PAnsiChar; sourcelen: integer; var temp: TLogEscape;
  enabled: boolean=true): PAnsiChar;
  {$ifdef HASINLINE}inline;{$endif}

/// returns a text buffer with the (hexadecimal) chars of the input binary
// - is much slower than LogEscape/EscapeToShort, but has no size limitation
function LogEscapeFull(source: PAnsiChar; sourcelen: integer): RawUTF8; overload;

/// returns a text buffer with the (hexadecimal) chars of the input binary
// - is much slower than LogEscape/EscapeToShort, but has no size limitation
function LogEscapeFull(const source: RawByteString): RawUTF8; overload;

/// fill a shortstring with the (hexadecimal) chars of the input text/binary
function EscapeToShort(source: PAnsiChar; sourcelen: integer): shortstring; overload;

/// fill a shortstring with the (hexadecimal) chars of the input text/binary
function EscapeToShort(const source: RawByteString): shortstring; overload;

/// fast conversion from a pointer data into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
function PointerToHex(aPointer: Pointer): RawUTF8; overload;

/// fast conversion from a pointer data into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
procedure PointerToHex(aPointer: Pointer; var result: RawUTF8); overload;

/// fast conversion from a pointer data into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
function PointerToHexShort(aPointer: Pointer): TShort16; overload;

/// fast conversion from a Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToCardinal()
function CardinalToHex(aCardinal: Cardinal): RawUTF8;

/// fast conversion from a Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplayLower()
// - reverse function of HexDisplayToCardinal()
function CardinalToHexLower(aCardinal: Cardinal): RawUTF8;

/// fast conversion from a Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
function CardinalToHexShort(aCardinal: Cardinal): TShort16;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToInt64()
function Int64ToHex(aInt64: Int64): RawUTF8; overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToInt64()
procedure Int64ToHex(aInt64: Int64; var result: RawUTF8); overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
procedure Int64ToHexShort(aInt64: Int64; out result: TShort16); overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - such result type would avoid a string allocation on heap
function Int64ToHexShort(aInt64: Int64): TShort16; overload;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
// - reverse function of HexDisplayToInt64()
function Int64ToHexString(aInt64: Int64): string;

/// fast conversion from hexa chars into a binary buffer
function HexDisplayToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: integer): boolean;

/// fast conversion from hexa chars into a cardinal
// - reverse function of CardinalToHex()
// - returns false and set aValue=0 if Hex is not a valid hexadecimal 32-bit
// unsigned integer
// - returns true and set aValue with the decoded number, on success
function HexDisplayToCardinal(Hex: PAnsiChar; out aValue: cardinal): boolean;
    {$ifndef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}
    // inline gives an error under release conditions with FPC

/// fast conversion from hexa chars into a cardinal
// - reverse function of Int64ToHex()
// - returns false and set aValue=0 if Hex is not a valid hexadecimal 64-bit
// signed integer
// - returns true and set aValue with the decoded number, on success
function HexDisplayToInt64(Hex: PAnsiChar; out aValue: Int64): boolean; overload;
    {$ifndef FPC}{$ifdef HASINLINE}inline;{$endif}{$endif}
    { inline gives an error under release conditions with FPC }

/// fast conversion from hexa chars into a cardinal
// - reverse function of Int64ToHex()
// - returns 0 if the supplied text buffer is not a valid hexadecimal 64-bit
// signed integer
function HexDisplayToInt64(const Hex: RawByteString): Int64; overload;
  {$ifdef HASINLINE}inline;{$endif}


/// fast conversion from binary data into Base64 encoded UTF-8 text
function BinToBase64(const s: RawByteString): RawUTF8; overload;

/// fast conversion from binary data into Base64 encoded UTF-8 text
function BinToBase64(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from binary data into prefixed/suffixed Base64 encoded UTF-8 text
// - with optional JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64(const data, Prefix, Suffix: RawByteString; WithMagic: boolean): RawUTF8; overload;

/// fast conversion from binary data into Base64 encoded UTF-8 text
// with JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64WithMagic(const data: RawByteString): RawUTF8; overload;

/// fast conversion from binary data into Base64 encoded UTF-8 text
// with JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64WithMagic(Data: pointer; DataLen: integer): RawUTF8; overload;

/// fast conversion from Base64 encoded text into binary data
// - is now just an alias to Base64ToBinSafe() overloaded function
// - returns '' if s was not a valid Base64-encoded input
function Base64ToBin(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - is now just an alias to Base64ToBinSafe() overloaded function
// - returns '' if sp/len buffer was not a valid Base64-encoded input
function Base64ToBin(sp: PAnsiChar; len: PtrInt): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - is now just an alias to Base64ToBinSafe() overloaded function
// - returns false and data='' if sp/len buffer was invalid
function Base64ToBin(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - returns TRUE on success, FALSE if sp/len buffer was invvalid
function Base64ToBin(sp: PAnsiChar; len: PtrInt; var Blob: TSynTempBuffer): boolean; overload;

/// fast conversion from Base64 encoded text into binary data
// - returns TRUE on success, FALSE if base64 does not match binlen
// - nofullcheck is deprecated and not used any more, since nofullcheck=false
// is now processed with no performance cost
function Base64ToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt;
  nofullcheck: boolean=true): boolean; overload;

/// fast conversion from Base64 encoded text into binary data
// - returns TRUE on success, FALSE if base64 does not match binlen
// - nofullcheck is deprecated and not used any more, since nofullcheck=false
// is now processed with no performance cost
function Base64ToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt;
  nofullcheck: boolean=true): boolean; overload;

/// fast conversion from Base64 encoded text into binary data
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinSafe(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean; overload;

/// just a wrapper around Base64ToBin() for in-place decode of JSON_BASE64_MAGIC
// '\uFFF0base64encodedbinary' content into binary
// - input ParamValue shall have been checked to match the expected pattern
procedure Base64MagicDecode(var ParamValue: RawUTF8);

/// check and decode '\uFFF0base64encodedbinary' content into binary
// - this method will check the supplied value to match the expected
// JSON_BASE64_MAGIC pattern, decode and set Blob and return TRUE
function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: RawByteString): boolean; overload;

/// check and decode '\uFFF0base64encodedbinary' content into binary
// - this method will check the supplied value to match the expected
// JSON_BASE64_MAGIC pattern, decode and set Blob and return TRUE
function Base64MagicCheckAndDecode(Value: PUTF8Char; ValueLen: Integer;
  var Blob: RawByteString): boolean; overload;

/// check and decode '\uFFF0base64encodedbinary' content into binary
// - this method will check the supplied value to match the expected
// JSON_BASE64_MAGIC pattern, decode and set Blob and return TRUE
function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: TSynTempBuffer): boolean; overload;

/// check if the supplied text is a valid Base64 encoded stream
function IsBase64(const s: RawByteString): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// check if the supplied text is a valid Base64 encoded stream
function IsBase64(sp: PAnsiChar; len: PtrInt): boolean; overload;

/// retrieve the expected encoded length after Base64 process
function BinToBase64Length(len: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the expected undecoded length of a Base64 encoded buffer
// - here len is the number of bytes in sp
function Base64ToBinLength(sp: PAnsiChar; len: PtrInt): PtrInt;

/// retrieve the expected undecoded length of a Base64 encoded buffer
// - here len is the number of bytes in sp
// - will check supplied text is a valid Base64 encoded stream
function Base64ToBinLengthSafe(sp: PAnsiChar; len: PtrInt): PtrInt;

/// direct low-level decoding of a Base64 encoded buffer
// - here len is the number of 4 chars chunks in sp input
// - deprecated low-level function: use Base64ToBin/Base64ToBinSafe instead
function Base64Decode(sp,rp: PAnsiChar; len: PtrInt): boolean;

/// fast conversion from binary data into Base64-like URI-compatible encoded text
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function BinToBase64uri(const s: RawByteString): RawUTF8; overload;

/// fast conversion from a binary buffer into Base64-like URI-compatible encoded text
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function BinToBase64uri(Bin: PAnsiChar; BinBytes: integer): RawUTF8; overload;

/// fast conversion from a binary buffer into Base64-like URI-compatible encoded shortstring
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - returns '' if BinBytes void or too big for the resulting shortstring
function BinToBase64uriShort(Bin: PAnsiChar; BinBytes: integer): shortstring;

/// conversion from any Base64 encoded value into URI-compatible encoded text
// - warning: will modify the supplied base64 string in-place
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
procedure Base64ToURI(var base64: RawUTF8);

/// low-level conversion from a binary buffer into Base64-like URI-compatible encoded text
// - you should rather use the overloaded BinToBase64uri() functions
procedure Base64uriEncode(rp, sp: PAnsiChar; len: cardinal);

/// retrieve the expected encoded length after Base64-URI process
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function BinToBase64uriLength(len: PtrUInt): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the expected undecoded length of a Base64-URI encoded buffer
// - here len is the number of bytes in sp
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBinLength(len: PtrInt): PtrInt;

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBin(sp: PAnsiChar; len: PtrInt): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
procedure Base64uriToBin(sp: PAnsiChar; len: PtrInt; var result: RawByteString); overload;

/// fast conversion from Base64-URI encoded text into binary data
// - caller should always execute temp.Done when finished with the data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBin(sp: PAnsiChar; len: PtrInt; var temp: TSynTempBuffer): boolean; overload;

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
function Base64uriToBin(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - will check supplied text is a valid Base64-URI encoded stream
function Base64uriToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt): boolean; overload;

/// fast conversion from Base64-URI encoded text into binary data
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - will check supplied text is a valid Base64-URI encoded stream
function Base64uriToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// direct low-level decoding of a Base64-URI encoded buffer
// - the buffer is expected to be at least Base64uriToBinLength() bytes long
// - returns true if the supplied sp[] buffer has been successfully decoded
// into rp[] - will break at any invalid character, so is always safe to use
// - in comparison to Base64 standard encoding, will trim any right-sided '='
// unsignificant characters, and replace '+' or '/' by '_' or '-'
// - you should better not use this, but Base64uriToBin() overloaded functions
function Base64uriDecode(sp,rp: PAnsiChar; len: PtrInt): boolean;


/// generate some pascal source code holding some data binary as constant
// - can store sensitive information (e.g. certificates) within the executable
// - generates a source code snippet of the following format:
// ! const
// !   // Comment
// !   ConstName: array[0..2] of byte = (
// !     $01,$02,$03);
procedure BinToSource(Dest: TTextWriter; const ConstName, Comment: RawUTF8;
  Data: pointer; Len: integer; PerLine: integer=16); overload;

/// generate some pascal source code holding some data binary as constant
// - can store sensitive information (e.g. certificates) within the executable
// - generates a source code snippet of the following format:
// ! const
// !   // Comment
// !   ConstName: array[0..2] of byte = (
// !     $01,$02,$03);
function BinToSource(const ConstName, Comment: RawUTF8; Data: pointer;
  Len: integer; PerLine: integer=16; const Suffix: RawUTF8=''): RawUTF8; overload;


/// revert the value as encoded by TTextWriter.AddInt18ToChars3() or Int18ToChars3()
// - no range check is performed: you should ensure that the incoming text
// follows the expected 3-chars layout
function Chars3ToInt18(P: pointer): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the value as encoded by TTextWriter.AddInt18ToChars3() method
function Int18ToChars3(Value: cardinal): RawUTF8; overload;

/// compute the value as encoded by TTextWriter.AddInt18ToChars3() method
procedure Int18ToChars3(Value: cardinal; var result: RawUTF8); overload;

/// add the 4 digits of integer Y to P^ as '0000'..'9999'
procedure YearToPChar(Y: PtrUInt; P: PUTF8Char);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// creates a 3 digits string from a 0..999 value as '000'..'999'
// - consider using UInt3DigitsToShort() to avoid temporary memory allocation,
// e.g. when used as FormatUTF8() parameter
function UInt3DigitsToUTF8(Value: Cardinal): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 4 digits string from a 0..9999 value as '0000'..'9999'
// - consider using UInt4DigitsToShort() to avoid temporary memory allocation,
// e.g. when used as FormatUTF8() parameter
function UInt4DigitsToUTF8(Value: Cardinal): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// used e.g. by UInt4DigitsToShort/UInt3DigitsToShort/UInt2DigitsToShort
  // - such result type would avoid a string allocation on heap
  TShort4 = string[4];

/// creates a 4 digits short string from a 0..9999 value
// - using TShort4 as returned string would avoid a string allocation on heap
// - could be used e.g. as parameter to FormatUTF8()
function UInt4DigitsToShort(Value: Cardinal): TShort4;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 3 digits short string from a 0..999 value
// - using TShort4 as returned string would avoid a string allocation on heap
// - could be used e.g. as parameter to FormatUTF8()
function UInt3DigitsToShort(Value: Cardinal): TShort4;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 2 digits short string from a 0..99 value
// - using TShort4 as returned string would avoid a string allocation on heap
// - could be used e.g. as parameter to FormatUTF8()
function UInt2DigitsToShort(Value: byte): TShort4;
  {$ifdef HASINLINE}inline;{$endif}

/// creates a 2 digits short string from a 0..99 value
// - won't test Value>99 as UInt2DigitsToShort()
function UInt2DigitsToShortFast(Value: byte): TShort4;
  {$ifdef HASINLINE}inline;{$endif}


/// compute CRC16-CCITT checkum on the supplied buffer
// - i.e. 16-bit CRC-CCITT, with polynomial x^16 + x^12 + x^5 + 1 ($1021)
// and $ffff as initial value
// - this version is not optimized for speed, but for correctness
function crc16(Data: PAnsiChar; Len: integer): cardinal;

// our custom hash/checksum function, specialized for Text comparaison
// - it is a checksum algorithm, not a hash function: has less colision than
// Adler32 for short strings, but more than xxhash32 or crc32/crc32c
// - written in simple plain pascal, with no L1 CPU cache pollution
// - overloaded version for direct binary content hashing
// - crc32c() has less collision - but is faster only on a SSE4.2 x86_64 CPU;
// some numbers on FPC/Linux64, with a SSE4.2 enabled CPU:
// $ -- 8 bytes buffers
// $ crc32c 8B in 12us i.e. 41,666,666/s, aver. 0us, 317.8 MB/s
// $ xxhash32 8B in 10us i.e. 50,000,000/s, aver. 0us, 381.4 MB/s
// $ hash32 8B in 9us i.e. 55,555,555/s, aver. 0us, 423.8 MB/s
// $ -- 50 bytes buffers
// $ crc32c 50B in 11us i.e. 45,454,545/s, aver. 0us, 2.1 GB/s
// $ xxhash32 50B in 14us i.e. 35,714,285/s, aver. 0us, 1.6 GB/s
// $ hash32 50B in 10us i.e. 50,000,000/s, aver. 0us, 2.3 GB/s
// $ -- 100 bytes buffers
// $ crc32c 100B in 12us i.e. 41,666,666/s, aver. 0us, 3.8 GB/s
// $ xxhash32 100B in 19us i.e. 26,315,789/s, aver. 0us, 2.4 GB/s
// $ hash32 100B in 13us i.e. 38,461,538/s, aver. 0us, 3.5 GB/s
// $ -- 1000 bytes buffers
// $ crc32c 0.9KB in 37us i.e. 13,513,513/s, aver. 0us, 12.5 GB/s
// $ xxhash32 0.9KB in 96us i.e. 5,208,333/s, aver. 0us, 4.8 GB/s
// $ hash32 0.9KB in 62us i.e. 8,064,516/s, aver. 0us, 7.5 GB/s
// $ -- 10000 bytes buffers
// $ crc32c 9.7KB in 282us i.e. 1,773,049/s, aver. 0us, 16.5 GB/s
// $ xxhash32 9.7KB in 927us i.e. 539,374/s, aver. 1us, 5 GB/s
// $ hash32 9.7KB in 487us i.e. 1,026,694/s, aver. 0us, 9.5 GB/s
function Hash32(Data: PCardinalArray; Len: integer): cardinal; overload;

// our custom hash/checsum function, specialized for Text comparaison
// - it is a checksum algorithm, not a hash function: has less colision than
// Adler32 for short strings, but more than xxhash32 or crc32/crc32c
// - is faster than CRC32 or Adler32, since uses DQWord (128-bit) aligned read
// - overloaded function using RawByteString for binary content hashing,
// whatever the codepage is
function Hash32(const Text: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// standard Kernighan & Ritchie hash from "The C programming Language", 3rd edition
// - simple and efficient code, but too much collisions for THasher
// - kr32() is 898.8 MB/s - crc32cfast() 1.7 GB/s, crc32csse42() 4.3 GB/s
function kr32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;

/// simple FNV-1a hashing function
// - when run over our regression suite, is similar to crc32c() about collisions,
// and 4 times better than kr32(), but also slower than the others
// - fnv32() is 715.5 MB/s - kr32() 898.8 MB/s
// - this hash function should not be usefull, unless you need several hashing
// algorithms at once (e.g. if crc32c with diverse seeds is not enough)
function fnv32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;

/// perform very fast xxHash hashing in 32-bit mode
// - will use optimized asm for x86/x64, or a pascal version on other CPUs
function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;

type
  TCrc32tab = array[0..{$ifdef PUREPASCAL}3{$else}7{$endif},byte] of cardinal;
  PCrc32tab = ^TCrc32tab;

var
  /// tables used by crc32cfast() function
  // - created with a polynom diverse from zlib's crc32() algorithm, but
  // compatible with SSE 4.2 crc32 instruction
  // - tables content is created from code in initialization section below
  // - will also be used internally by SymmetricEncrypt, FillRandom and
  // TSynUniqueIdentifierGenerator as 1KB master/reference key tables
  crc32ctab: TCrc32tab;

/// compute CRC32C checksum on the supplied buffer using x86/x64 code
// - result is compatible with SSE 4.2 based hardware accelerated instruction
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 4.3 GB/s
// - you should use crc32c() function instead of crc32cfast() or crc32csse42()
function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

/// compute CRC32C checksum on the supplied buffer using inlined code
// - if the compiler supports inlining, will compute a slow but safe crc32c
// checksum of the binary buffer, without calling the main crc32c() function
// - may be used e.g. to identify patched executable at runtime, for a licensing
// protection system
function crc32cinlined(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// compute CRC64C checksum on the supplied buffer, cascading two crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single Int64 result
// - by design, such combined hashes cannot be cascaded
function crc64c(buf: PAnsiChar; len: cardinal): Int64;

/// compute CRC63C checksum on the supplied buffer, cascading two crc32c
// - similar to crc64c, but with 63-bit, so no negative value: may be used
// safely e.g. as mORMot's TID source
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single Int64 result
// - by design, such combined hashes cannot be cascaded
function crc63c(buf: PAnsiChar; len: cardinal): Int64;

type
  /// binary access to an unsigned 32-bit value (4 bytes in memory)
  TDWordRec = record
    case integer of
    0: (V: DWord);
    1: (L,H: word);
    2: (B: array[0..3] of byte);
  end;
  /// points to the binary of an unsigned 32-bit value
  PDWordRec = ^TDWordRec;

  /// binary access to an unsigned 64-bit value (8 bytes in memory)
  TQWordRec = record
    case integer of
    0: (V: Qword);
    1: (L,H: cardinal);
    2: (W: array[0..3] of word);
    3: (B: array[0..7] of byte);
  end;
  /// points to the binary of an unsigned 64-bit value
  PQWordRec = ^TQWordRec;

  /// store a 128-bit hash value
  // - e.g. a MD5 digest, or array[0..3] of cardinal (TBlock128)
  // - consumes 16 bytes of memory
  THash128 = array[0..15] of byte;
  /// pointer to a 128-bit hash value
  PHash128 = ^THash128;
  /// store a 160-bit hash value
  // - e.g. a SHA-1 digest
  // - consumes 20 bytes of memory
  THash160 = array[0..19] of byte;
  /// pointer to a 160-bit hash value
  PHash160 = ^THash160;
  /// store a 192-bit hash value
  // - consumes 24 bytes of memory
  THash192 = array[0..23] of byte;
  /// pointer to a 192-bit hash value
  PHash192 = ^THash192;
  /// store a 256-bit hash value
  // - e.g. a SHA-256 digest, a TECCSignature result, or array[0..7] of cardinal
  // - consumes 32 bytes of memory
  THash256 = array[0..31] of byte;
  /// pointer to a 256-bit hash value
  PHash256 = ^THash256;
  /// store a 384-bit hash value
  // - e.g. a SHA-384 digest
  // - consumes 48 bytes of memory
  THash384 = array[0..47] of byte;
  /// pointer to a 384-bit hash value
  PHash384 = ^THash384;
  /// store a 512-bit hash value
  // - e.g. a SHA-512 digest, a TECCSignature result, or array[0..15] of cardinal
  // - consumes 64 bytes of memory
  THash512 = array[0..63] of byte;
  /// pointer to a 512-bit hash value
  PHash512 = ^THash512;

  /// store a 128-bit buffer
  // - e.g. an AES block
  // - consumes 16 bytes of memory
  TBlock128 = array[0..3] of cardinal;
  /// pointer to a 128-bit buffer
  PBlock128 = ^TBlock128;

  /// map an infinite array of 128-bit hash values
  // - each item consumes 16 bytes of memory
  THash128Array = array[0..(maxInt div SizeOf(THash128))-1] of THash128;
  /// pointer to an infinite array of 128-bit hash values
  PHash128Array = ^THash128Array;
  /// store several 128-bit hash values
  // - e.g. MD5 digests
  // - consumes 16 bytes of memory per item
  THash128DynArray = array of THash128;
  /// map a 128-bit hash as an array of lower bit size values
  // - consumes 16 bytes of memory
  THash128Rec = packed record
  case integer of
  0: (Lo,Hi: Int64);
  1: (L,H: QWord);
  2: (i0,i1,i2,i3: integer);
  3: (c0,c1,c2,c3: cardinal);
  4: (c: TBlock128);
  5: (b: THash128);
  6: (w: array[0..7] of word);
  end;
  /// pointer to 128-bit hash map variable record
  PHash128Rec = ^THash128Rec;

  /// map an infinite array of 256-bit hash values
  // - each item consumes 32 bytes of memory
  THash256Array = array[0..(maxInt div SizeOf(THash256))-1] of THash256;
  /// pointer to an infinite array of 256-bit hash values
  PHash256Array = ^THash256Array;
  /// store several 256-bit hash values
  // - e.g. SHA-256 digests, TECCSignature results, or array[0..7] of cardinal
  // - consumes 32 bytes of memory per item
  THash256DynArray = array of THash256;
  /// map a 256-bit hash as an array of lower bit size values
  // - consumes 32 bytes of memory
  THash256Rec = packed record
  case integer of
  0: (Lo,Hi: THash128);
  1: (d0,d1,d2,d3: Int64);
  2: (i0,i1,i2,i3,i4,i5,i6,i7: integer);
  3: (c0,c1: TBlock128);
  4: (b: THash256);
  5: (q: array[0..3] of QWord);
  6: (c: array[0..7] of cardinal);
  7: (w: array[0..15] of word);
  end;
  /// pointer to 256-bit hash map variable record
  PHash256Rec = ^THash256Rec;

  /// map an infinite array of 512-bit hash values
  // - each item consumes 64 bytes of memory
  THash512Array = array[0..(maxInt div SizeOf(THash512))-1] of THash512;
  /// pointer to an infinite array of 512-bit hash values
  PHash512Array = ^THash512Array;
  /// store several 512-bit hash values
  // - e.g. SHA-512 digests, or array[0..15] of cardinal
  // - consumes 64 bytes of memory per item
  THash512DynArray = array of THash512;
  /// map a 512-bit hash as an array of lower bit size values
  // - consumes 64 bytes of memory
  THash512Rec = packed record
  case integer of
  0: (Lo,Hi: THash256);
  1: (h0,h1,h2,h3: THash128);
  2: (d0,d1,d2,d3,d4,d5,d6,d7: Int64);
  3: (i0,i1,i2,i3,i4,i5,i6,i7,i8,i9,i10,i11,i12,i13,i14,i15: integer);
  4: (c0,c1,c2,c3: TBlock128);
  5: (b: THash512);
  6: (b160: THash160);
  7: (b384: THash384);
  8: (w: array[0..31] of word);
  9: (c: array[0..15] of cardinal);
  end;
  /// pointer to 512-bit hash map variable record
  PHash512Rec = ^THash512Rec;

/// compute a 128-bit checksum on the supplied buffer, cascading two crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single TAESBlock result
// - by design, such combined hashes cannot be cascaded
procedure crc128c(buf: PAnsiChar; len: cardinal; out crc: THash128);

/// compute a proprietary 128-bit CRC of 128-bit binary buffers
// - apply four crc32c() calls on the 128-bit input chunks, into a 128-bit crc
// - its output won't match crc128c() value, which works on 8-bit input
// - will use SSE 4.2 hardware accelerated instruction, if available
// - is used e.g. by SynEcc's TECDHEProtocol.ComputeMAC for macCrc128c
procedure crcblocks(crc128, data128: PBlock128; count: integer);

/// computation of our 128-bit CRC of a 128-bit binary buffer without SSE4.2
// - to be used for regression tests only: crcblock will use the fastest
// implementation available on the current CPU
procedure crcblockNoSSE42(crc128, data128: PBlock128);

/// compute a proprietary 128-bit CRC of a 128-bit binary buffer
// - apply four crc32c() calls on the 128-bit input chunk, into a 128-bit crc
// - its output won't match crc128c() value, which works on 8-bit input
// - will use SSE 4.2 hardware accelerated instruction, if available
// - is used e.g. by SynCrypto's TAESCFBCRC to check for data integrity
var crcblock: procedure(crc128, data128: PBlock128)  = crcblockNoSSE42;

/// returns TRUE if all 16 bytes of this 128-bit buffer equal zero
// - e.g. a MD5 digest, or an AES block
function IsZero(const dig: THash128): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 16 bytes of both 128-bit buffers do match
// - e.g. a MD5 digest, or an AES block
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash128): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 16 bytes of this 128-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash128); overload;

/// fast O(n) search of a 128-bit item in an array of such values
function HashFound(P: PHash128Rec; Count: integer; const h: THash128Rec): boolean;

/// convert a 32-bit integer (storing a IP4 address) into its full notation
// - returns e.g. '1.2.3.4' for any valid address, or '' if ip4=0
function IP4Text(ip4: cardinal): shortstring; overload;

/// convert a 128-bit buffer (storing an IP6 address) into its full notation
// - returns e.g. '2001:0db8:0a0b:12f0:0000:0000:0000:0001'
function IP6Text(ip6: PHash128): shortstring; overload; {$ifdef HASINLINE}inline;{$endif}

/// convert a 128-bit buffer (storing an IP6 address) into its full notation
// - returns e.g. '2001:0db8:0a0b:12f0:0000:0000:0000:0001'
procedure IP6Text(ip6: PHash128; result: PShortString); overload;

/// compute a 256-bit checksum on the supplied buffer using crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single THash256 result
// - by design, such combined hashes cannot be cascaded
procedure crc256c(buf: PAnsiChar; len: cardinal; out crc: THash256);

/// returns TRUE if all 20 bytes of this 160-bit buffer equal zero
// - e.g. a SHA-1 digest
function IsZero(const dig: THash160): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 20 bytes of both 160-bit buffers do match
// - e.g. a SHA-1 digest
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash160): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 20 bytes of this 160-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash160); overload;

/// returns TRUE if all 32 bytes of this 256-bit buffer equal zero
// - e.g. a SHA-256 digest, or a TECCSignature result
function IsZero(const dig: THash256): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 32 bytes of both 256-bit buffers do match
// - e.g. a SHA-256 digest, or a TECCSignature result
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash256): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 32 bytes of this 256-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash256); overload;

/// returns TRUE if all 48 bytes of this 384-bit buffer equal zero
// - e.g. a SHA-384 digest
function IsZero(const dig: THash384): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 48 bytes of both 384-bit buffers do match
// - e.g. a SHA-384 digest
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash384): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 32 bytes of this 384-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash384); overload;

/// returns TRUE if all 64 bytes of this 512-bit buffer equal zero
// - e.g. a SHA-512 digest
function IsZero(const dig: THash512): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all 64 bytes of both 512-bit buffers do match
// - e.g. two SHA-512 digests
// - this function is not sensitive to any timing attack, so is designed
// for cryptographic purpose
function IsEqual(const A,B: THash512): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fill all 64 bytes of this 512-bit buffer with zero
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(digest); end;
procedure FillZero(out dig: THash512); overload;

/// compute a 512-bit checksum on the supplied buffer using crc32c
// - will use SSE 4.2 hardware accelerated instruction, if available
// - will combine two crc32c() calls into a single THash512 result
// - by design, such combined hashes cannot be cascaded
procedure crc512c(buf: PAnsiChar; len: cardinal; out crc: THash512);

/// fill all bytes of this memory buffer with zeros, i.e. 'toto' -> #0#0#0#0
// - will write the memory buffer directly, so if this string instance is shared
// (i.e. has refcount>1), all other variables will contains zeros
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(secret); end;
procedure FillZero(var secret: RawByteString); overload;
  {$ifdef FPC}inline;{$endif}

/// fill all bytes of this UTF-8 string with zeros, i.e. 'toto' -> #0#0#0#0
// - will write the memory buffer directly, so if this string instance is shared
// (i.e. has refcount>1), all other variables will contains zeros
// - may be used to cleanup stack-allocated content
// ! ... finally FillZero(secret); end;
procedure FillZero(var secret: RawUTF8); overload;
  {$ifdef FPC}inline;{$endif}

  /// fill all bytes of a memory buffer with zero
  // - is expected to be used with a constant count from SizeOf() so that
  // inlining make it more efficient than FillCharFast(..,...,0):
  // ! FillZero(variable,SizeOf(variable));
procedure FillZero(var dest; count: PtrInt); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast computation of two 64-bit unsigned integers into a 128-bit value
procedure mul64x64(const left, right: QWord; out product: THash128Rec);
  {$ifdef FPC}{$ifndef CPUX64}inline;{$endif CPUX64}{$endif FPC}

type
  /// the potential features, retrieved from an Intel CPU
  // - see https://en.wikipedia.org/wiki/CPUID#EAX.3D1:_Processor_Info_and_Feature_Bits
  TIntelCpuFeature =
   ( { CPUID 1 in EDX }
   cfFPU, cfVME, cfDE, cfPSE, cfTSC, cfMSR, cfPAE, cfMCE,
   cfCX8, cfAPIC, cf_d10, cfSEP, cfMTRR, cfPGE, cfMCA, cfCMOV,
   cfPAT, cfPSE36, cfPSN, cfCLFSH, cf_d20, cfDS, cfACPI, cfMMX,
   cfFXSR, cfSSE, cfSSE2, cfSS, cfHTT, cfTM, cfIA64, cfPBE,
   { CPUID 1 in ECX }
   cfSSE3, cfCLMUL, cfDS64, cfMON, cfDSCPL, cfVMX, cfSMX, cfEST,
   cfTM2, cfSSSE3, cfCID, cfSDBG, cfFMA, cfCX16, cfXTPR, cfPDCM,
   cf_c16, cfPCID, cfDCA, cfSSE41, cfSSE42, cfX2A, cfMOVBE, cfPOPCNT,
   cfTSC2, cfAESNI, cfXS, cfOSXS, cfAVX, cfF16C, cfRAND, cfHYP,
   { extended features CPUID 7 in EBX, ECX, DL }
   cfFSGS, cf_b01, cfSGX, cfBMI1, cfHLE, cfAVX2, cf_b06, cfSMEP,
   cfBMI2, cfERMS, cfINVPCID, cfRTM, cfPQM, cf_b13, cfMPX, cfPQE,
   cfAVX512F, cfAVX512DQ, cfRDSEED, cfADX, cfSMAP, cfAVX512IFMA, cfPCOMMIT, cfCLFLUSH,
   cfCLWB, cfIPT, cfAVX512PF, cfAVX512ER, cfAVX512CD, cfSHA, cfAVX512BW, cfAVX512VL,
   cfPREFW1, cfAVX512VBMI, cfUMIP, cfPKU, cfOSPKE, cf_c05, cfAVX512VBMI2, cf_c07,
   cfGFNI, cfVAES, cfVCLMUL, cfAVX512NNI, cfAVX512BITALG, cf_c13, cfAVX512VPC, cf_c15,
   cf_cc16, cf_c17, cf_c18, cf_c19, cf_c20, cf_c21, cfRDPID, cf_c23,
   cf_c24, cf_c25, cf_c26, cf_c27, cf_c28, cf_c29, cfSGXLC, cf_c31,
   cf_d0, cf_d1, cfAVX512NNIW, cfAVX512MAS, cf_d4, cf_d5, cf_d6, cf_d7);

  /// all features, as retrieved from an Intel CPU
  TIntelCpuFeatures = set of TIntelCpuFeature;

/// convert Intel CPU features as plain CSV text
function ToText(const aIntelCPUFeatures: TIntelCpuFeatures;
  const Sep: RawUTF8=','): RawUTF8; overload;

{$ifdef CPUINTEL}
var
  /// the available CPU features, as recognized at program startup
  CpuFeatures: TIntelCpuFeatures;

/// compute CRC32C checksum on the supplied buffer using SSE 4.2
// - use Intel Streaming SIMD Extensions 4.2 hardware accelerated instruction
// - SSE 4.2 shall be available on the processor (i.e. cfSSE42 in CpuFeatures)
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 4.3 GB/s
// - you should use crc32c() function instead of crc32cfast() or crc32csse42()
function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$endif CPUINTEL}

/// naive symmetric encryption scheme using a 32-bit key
// - fast, but not very secure, since uses crc32ctab[] content as master cypher
// key: consider using SynCrypto proven AES-based algorithms instead
procedure SymmetricEncrypt(key: cardinal; var data: RawByteString);

type
  TCrc32cBy4 = function(crc, value: cardinal): cardinal;

var
  /// compute CRC32C checksum on the supplied buffer
  // - result is not compatible with zlib's crc32() - Intel/SCSI CRC32C is not
  // the same polynom - but will use the fastest mean available, e.g. SSE 4.2,
  // to achieve up to 16GB/s with the optimized implementation from SynCrypto.pas
  // - you should use this function instead of crc32cfast() or crc32csse42()
  crc32c: THasher;
  /// compute CRC32C checksum on one 32-bit unsigned integer
  // - can be used instead of crc32c() for inlined process during data acquisition
  // - doesn't make "crc := not crc" before and after the computation: caller has
  // to start with "crc := cardinal(not 0)" and make "crc := not crc" at the end,
  // to compute the very same hash value than regular crc32c()
  // - this variable will use the fastest mean available, e.g. SSE 4.2
  crc32cBy4: TCrc32cBy4;

/// compute the hexadecimal representation of the crc32 checkum of a given text
// - wrapper around CardinalToHex(crc32c(...))
function crc32cUTF8ToHex(const str: RawUTF8): RawUTF8;

var
  /// the default hasher used by TDynArrayHashed
  // - set to crc32csse42() if SSE4.2 instructions are available on this CPU,
  // or fallback to xxHash32() which performs better than crc32cfast()
  DefaultHasher: THasher;

  /// the hash function used by TRawUTF8Interning
  // - set to crc32csse42() if SSE4.2 instructions are available on this CPU,
  // or fallback to xxHash32() which performs better than crc32cfast()
  InterningHasher: THasher;

/// retrieve a particular bit status from a bit array
// - this function can't be inlined, whereas GetBitPtr() function can
function GetBit(const Bits; aIndex: PtrInt): boolean;

/// set a particular bit into a bit array
// - this function can't be inlined, whereas SetBitPtr() function can
procedure SetBit(var Bits; aIndex: PtrInt);

/// unset/clear a particular bit into a bit array
// - this function can't be inlined, whereas UnSetBitPtr() function can
procedure UnSetBit(var Bits; aIndex: PtrInt);

/// retrieve a particular bit status from a bit array
// - GetBit() can't be inlined, whereas this pointer-oriented function can
function GetBitPtr(Bits: pointer; aIndex: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// set a particular bit into a bit array
// - SetBit() can't be inlined, whereas this pointer-oriented function can
procedure SetBitPtr(Bits: pointer; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// unset/clear a particular bit into a bit array
// - UnSetBit() can't be inlined, whereas this pointer-oriented function can
procedure UnSetBitPtr(Bits: pointer; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// compute the number of bits set in a bit array
// - Count is the bit count, not byte size
function GetBitsCount(const Bits; Count: PtrInt): integer;

const
  /// constant array used by GetAllBits() function (when inlined)
  ALLBITS_CARDINAL: array[1..32] of Cardinal = (
    1 shl 1-1, 1 shl 2-1, 1 shl 3-1, 1 shl 4-1, 1 shl 5-1, 1 shl 6-1,
    1 shl 7-1, 1 shl 8-1, 1 shl 9-1, 1 shl 10-1, 1 shl 11-1, 1 shl 12-1,
    1 shl 13-1, 1 shl 14-1, 1 shl 15-1, 1 shl 16-1, 1 shl 17-1, 1 shl 18-1,
    1 shl 19-1, 1 shl 20-1, 1 shl 21-1, 1 shl 22-1, 1 shl 23-1, 1 shl 24-1,
    1 shl 25-1, 1 shl 26-1, 1 shl 27-1, 1 shl 28-1, 1 shl 29-1, 1 shl 30-1,
    $7fffffff, $ffffffff);

/// returns TRUE if all BitCount bits are set in the input 32-bit cardinal
function GetAllBits(Bits, BitCount: cardinal): boolean;
  {$ifdef HASINLINE}inline;{$endif}

type
  /// fast access to 8-bit integer bits
  // - the compiler will generate bt/btr/bts opcodes
  TBits8 = set of 0..7;
  PBits8 = ^TBits8;
  TBits8Array = array[0..maxInt-1] of TBits8;
  /// fast access to 32-bit integer bits
  // - the compiler will generate bt/btr/bts opcodes
  TBits32 = set of 0..31;
  PBits32 = ^TBits32;
  /// fast access to 64-bit integer bits
  // - the compiler will generate bt/btr/bts opcodes
  // - as used by GetBit64/SetBit64/UnSetBit64
  TBits64 = set of 0..63;
  PBits64 = ^TBits64;

/// retrieve a particular bit status from a 64-bit integer bits (max aIndex is 63)
function GetBit64(const Bits: Int64; aIndex: PtrInt): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// set a particular bit into a 64-bit integer bits (max aIndex is 63)
procedure SetBit64(var Bits: Int64; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// unset/clear a particular bit into a 64-bit integer bits (max aIndex is 63)
procedure UnSetBit64(var Bits: Int64; aIndex: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// logical OR of two memory buffers
// - will perform on all buffer bytes:
// ! Dest[i] := Dest[i] or Source[i];
procedure OrMemory(Dest,Source: PByteArray; size: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// logical XOR of two memory buffers
// - will perform on all buffer bytes:
// ! Dest[i] := Dest[i] xor Source[i];
procedure XorMemory(Dest,Source: PByteArray; size: PtrInt); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// logical XOR of two memory buffers into a third
// - will perform on all buffer bytes:
// ! Dest[i] := Source1[i] xor Source2[i];
procedure XorMemory(Dest,Source1,Source2: PByteArray; size: PtrInt); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// logical AND of two memory buffers
// - will perform on all buffer bytes:
// ! Dest[i] := Dest[i] and Source[i];
procedure AndMemory(Dest,Source: PByteArray; size: PtrInt);
  {$ifdef HASINLINE}inline;{$endif}

/// returns TRUE if all bytes equal zero
function IsZero(P: pointer; Length: integer): boolean; overload;

/// returns TRUE if Value is nil or all supplied Values[] equal ''
function IsZero(const Values: TRawUTF8DynArray): boolean; overload;

/// returns TRUE if Value is nil or all supplied Values[] equal 0
function IsZero(const Values: TIntegerDynArray): boolean; overload;

/// returns TRUE if Value is nil or all supplied Values[] equal 0
function IsZero(const Values: TInt64DynArray): boolean; overload;

/// fill all entries of a supplied array of RawUTF8 with ''
procedure FillZero(var Values: TRawUTF8DynArray); overload;

/// fill all entries of a supplied array of 32-bit integers with 0
procedure FillZero(var Values: TIntegerDynArray); overload;

/// fill all entries of a supplied array of 64-bit integers with 0
procedure FillZero(var Values: TInt64DynArray); overload;


/// name the current thread so that it would be easily identified in the IDE debugger
procedure SetCurrentThreadName(const Format: RawUTF8; const Args: array of const);

/// name a thread so that it would be easily identified in the IDE debugger
// - you can force this function to do nothing by setting the NOSETTHREADNAME
// conditional, if you have issues with this feature when debugging your app
procedure SetThreadName(ThreadID: TThreadID; const Format: RawUTF8;
  const Args: array of const);

/// could be used to override SetThreadNameInternal()
// - under Linux/FPC, calls pthread_setname_np API which truncates to 16 chars
procedure SetThreadNameDefault(ThreadID: TThreadID; const Name: RawUTF8);

var
  /// is overriden e.g. by mORMot.pas to log the thread name
  SetThreadNameInternal: procedure(ThreadID: TThreadID; const Name: RawUTF8) = SetThreadNameDefault;



/// low-level wrapper to add a callback to a dynamic list of events
// - by default, you can assign only one callback to an Event: but by storing
// it as a dynamic array of events, you can use this wrapper to add one callback
// to this list of events
// - if the event was already registered, do nothing (i.e. won't call it twice)
// - since this function uses an unsafe typeless EventList parameter, you should
// not use it in high-level code, but only as wrapper within dedicated methods
// - will add Event to EventList[] unless Event is already registered
// - is used e.g. by TTextWriter as such:
// ! ...
// !   fEchos: array of TOnTextWriterEcho;
// ! ...
// !   procedure EchoAdd(const aEcho: TOnTextWriterEcho);
// ! ...
// ! procedure TTextWriter.EchoAdd(const aEcho: TOnTextWriterEcho);
// ! begin
// !   MultiEventAdd(fEchos,TMethod(aEcho));
// ! end;
// then callbacks are then executed as such:
// ! if fEchos<>nil then
// !   for i := 0 to length(fEchos)-1 do
// !     fEchos[i](self,fEchoBuf);
// - use MultiEventRemove() to un-register a callback from the list
function MultiEventAdd(var EventList; const Event: TMethod): boolean;

/// low-level wrapper to remove a callback from a dynamic list of events
// - by default, you can assign only one callback to an Event: but by storing
// it as a dynamic array of events, you can use this wrapper to remove one
// callback already registered by MultiEventAdd() to this list of events
// - since this function uses an unsafe typeless EventList parameter, you should
// not use it in high-level code, but only as wrapper within dedicated methods
// - is used e.g. by TTextWriter as such:
// ! ...
// !   fEchos: array of TOnTextWriterEcho;
// ! ...
// !   procedure EchoRemove(const aEcho: TOnTextWriterEcho);
// ! ...
// ! procedure TTextWriter.EchoRemove(const aEcho: TOnTextWriterEcho);
// ! begin
// !   MultiEventRemove(fEchos,TMethod(aEcho));
// ! end;
procedure MultiEventRemove(var EventList; const Event: TMethod); overload;

/// low-level wrapper to remove a callback from a dynamic list of events
// - same as the same overloaded procedure, but accepting an EventList[] index
// to identify the Event to be suppressed
procedure MultiEventRemove(var EventList; Index: Integer); overload;

/// low-level wrapper to check if a callback is in a dynamic list of events
// - by default, you can assign only one callback to an Event: but by storing
// it as a dynamic array of events, you can use this wrapper to check if
// a callback has already been registered to this list of events
// - used internally by MultiEventAdd() and MultiEventRemove() functions
function MultiEventFind(const EventList; const Event: TMethod): integer;

/// low-level wrapper to add one or several callbacks from another list of events
// - all events of the ToBeAddedList would be added to DestList
// - the list is not checked for duplicates
procedure MultiEventMerge(var DestList; const ToBeAddedList);

/// compare two TMethod instances
function EventEquals(const eventA,eventB): boolean;
  {$ifdef HASINLINE}inline;{$endif}


{ ************ fast ISO-8601 types and conversion routines ***************** }

type
  /// a type alias, which will be serialized as ISO-8601 with milliseconds
  // - i.e. 'YYYY-MM-DD hh:mm:ss.sss' or 'YYYYMMDD hhmmss.sss' format
  TDateTimeMS = type TDateTime;

  /// a dynamic array of TDateTimeMS values
  TDateTimeMSDynArray = array of TDateTimeMS;
  PDateTimeMSDynArray = ^TDateTimeMSDynArray;

  /// a cross-platform and cross-compiler TSystemTime structure
  // - FPC's TSystemTime in datih.inc does NOT match Windows TSystemTime fields!
  // - also used to store a Date/Time in TSynTimeZone internal structures, or
  // for fast conversion from TDateTime to its ready-to-display members
  {$ifdef FPC_OR_UNICODE}TSynSystemTime = record{$else}TSynSystemTime = object{$endif}
  public
    Year, Month, DayOfWeek, Day,
    Hour, Minute, Second, MilliSecond: word;
    /// set all fields to 0
    procedure Clear; {$ifdef HASINLINE}inline;{$endif}
    /// returns true if all fields are zero
    function IsZero: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// returns true if all fields do match
    function IsEqual(const another{$ifndef DELPHI5OROLDER}: TSynSystemTime{$endif}): boolean;
    /// used by TSynTimeZone
    function EncodeForTimeChange(const aYear: word): TDateTime;
    /// fill fields with the current UTC time, using a 8-16ms thread-safe cache
    procedure FromNowUTC;
    /// fill fields with the current Local time, using a 8-16ms thread-safe cache
    procedure FromNowLocal;
    /// fill fields from the given value - but not DayOfWeek
    procedure FromDateTime(const dt: TDateTime);
    /// fill Year/Month/Day fields from the given value - but not DayOfWeek
    // - faster than the RTL DecodeDate() function
    procedure FromDate(const dt: TDateTime);
    /// fill Hour/Minute/Second/Millisecond fields from the given value
    // - faster than the RTL DecodeTime() function
    procedure FromTime(const dt: TDateTime);
    /// encode the stored date/time as text
    function ToText(Expanded: boolean=true; FirstTimeChar: AnsiChar='T'; const TZD: RawUTF8=''): RawUTF8;
    /// append the stored date and time, in a log-friendly format
    // - e.g. append '20110325 19241502' - with no trailing space nor tab
    // - as called by TTextWriter.AddCurrentLogTime()
    procedure AddLogTime(WR: TTextWriter);
    /// append the stored data and time, in apache-like format, to a TTextWriter
    // - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
    procedure AddNCSAText(WR: TTextWriter);
    /// append the stored data and time, in apache-like format, to a memory buffer
    // - e.g. append '19/Feb/2019:06:18:55 ' - including a trailing space
    // - returns the number of chars added to P, i.e. always 21
    function ToNCSAText(P: PUTF8Char): PtrInt;
    /// convert the stored time into a TDateTime
    function ToDateTime: TDateTime;
    /// add some 1..999 milliseconds to the stored time
    // - not to be used for computation, but e.g. for fast AddLogTime generation
    procedure IncrementMS(ms: integer);
  end;
  PSynSystemTime = ^TSynSystemTime;

  /// fast bit-encoded date and time value
  // - faster than Iso-8601 text and TDateTime, e.g. can be used as published
  // property field in mORMot's TSQLRecord (see also TModTime and TCreateTime)
  // - use internally for computation an abstract "year" of 16 months of 32 days
  // of 32 hours of 64 minutes of 64 seconds - same as Iso8601ToTimeLog()
  // - use TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow functions, or
  // type-cast any TTimeLog value with the TTimeLogBits memory structure for
  // direct access to its bit-oriented content (or via PTimeLogBits pointer)
  // - since TTimeLog type is bit-oriented, you can't just add or substract two
  // TTimeLog values when doing date/time computation: use a TDateTime temporary
  // conversion in such case:
  // ! aTimestamp := TimeLogFromDateTime(IncDay(TimeLogToDateTime(aTimestamp)));
  TTimeLog = type Int64;

  /// dynamic array of TTimeLog
  // - used by TDynArray JSON serialization to handle textual serialization
  TTimeLogDynArray = array of TTimeLog;

  /// pointer to a memory structure for direct access to a TTimeLog type value
  PTimeLogBits = ^TTimeLogBits;

  /// internal memory structure for direct access to a TTimeLog type value
  // - most of the time, you should not use this object, but higher level
  // TimeLogFromDateTime/TimeLogToDateTime/TimeLogNow/Iso8601ToTimeLog functions
  // - since TTimeLogBits.Value is bit-oriented, you can't just add or substract
  // two TTimeLog values when doing date/time computation: use a TDateTime
  // temporary conversion in such case
  // - TTimeLogBits.Value has a 38-bit precision, so features exact representation
  // as JavaScript numbers (stored in a 52-bit mantissa)
  {$ifdef FPC_OR_UNICODE}TTimeLogBits = record{$else}TTimeLogBits = object{$endif}
  public
    /// the bit-encoded value itself, which follows an abstract "year" of 16
    // months of 32 days of 32 hours of 64 minutes of 64 seconds
    // - bits 0..5   = Seconds (0..59)
    // - bits 6..11  = Minutes (0..59)
    // - bits 12..16 = Hours   (0..23)
    // - bits 17..21 = Day-1   (0..31)
    // - bits 22..25 = Month-1 (0..11)
    // - bits 26..38 = Year    (0..4095)
    Value: Int64;
    /// extract the date and time content in Value into individual values
    procedure Expand(out Date: TSynSystemTime);
    /// convert to Iso-8601 encoded text
    function Text(Expanded: boolean; FirstTimeChar: AnsiChar = 'T'): RawUTF8; overload;
    /// convert to Iso-8601 encoded text
    function Text(Dest: PUTF8Char; Expanded: boolean;
      FirstTimeChar: AnsiChar = 'T'): integer; overload;
    /// convert to ready-to-be displayed text
    // - using i18nDateText global event, if set (e.g. by mORMoti18n.pas)
    function i18nText: string;
    /// convert to a Delphi Time
    function ToTime: TDateTime;
    /// convert to a Delphi Date
    // - will return 0 if the stored value is not a valid date
    function ToDate: TDateTime;
    /// convert to a Delphi Date and Time
    // - will return 0 if the stored value is not a valid date
    function ToDateTime: TDateTime;
    /// convert to a second-based c-encoded time (from Unix epoch 1/1/1970)
    function ToUnixTime: TUnixTime;
    /// convert to a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
    // - of course, milliseconds will be 0 due to TTimeLog second resolution
    function ToUnixMSTime: TUnixMSTime;
    /// fill Value from specified Date and Time
    procedure From(Y,M,D, HH,MM,SS: cardinal); overload;
    /// fill Value from specified TDateTime
    procedure From(DateTime: TDateTime; DateOnly: Boolean=false); overload;
    /// fill Value from specified File Date
    procedure From(FileDate: integer); overload;
    /// fill Value from Iso-8601 encoded text
    procedure From(P: PUTF8Char; L: integer); overload;
    /// fill Value from Iso-8601 encoded text
    procedure From(const S: RawUTF8); overload;
    /// fill Value from specified Date/Time individual fields
    procedure From(Time: PSynSystemTime); overload;
    /// fill Value from second-based c-encoded time (from Unix epoch 1/1/1970)
    procedure FromUnixTime(const UnixTime: TUnixTime);
    /// fill Value from millisecond-based c-encoded time (from Unix epoch 1/1/1970)
    // - of course, millisecond resolution will be lost during conversion
    procedure FromUnixMSTime(const UnixMSTime: TUnixMSTime);
    /// fill Value from current local system Date and Time
    procedure FromNow;
    /// fill Value from current UTC system Date and Time
    // - FromNow uses local time: this function retrieves the system time
    // expressed in Coordinated Universal Time (UTC)
    procedure FromUTCTime;
    /// get the year (e.g. 2015) of the TTimeLog value
    function Year: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the month (1..12) of the TTimeLog value
    function Month: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the day (1..31) of the TTimeLog value
    function Day: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the hour (0..23) of the TTimeLog value
    function Hour: integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the minute (0..59) of the TTimeLog value
    function Minute: integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the second (0..59) of the TTimeLog value
    function Second: integer; {$ifdef HASINLINE}inline;{$endif}
  end;

/// get TTimeLog value from current local system date and time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogNow: TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// get TTimeLog value from current UTC system Date and Time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogNowUTC: TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// get TTimeLog value from a file date and time
// - handle TTimeLog bit-encoded Int64 format
function TimeLogFromFile(const FileName: TFileName): TTimeLog;

/// get TTimeLog value from a given Delphi date and time
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@aTime)^.From()
// - we defined such a function since TTimeLogBits(aTimeLog).From() won't change
// the aTimeLog variable content
function TimeLogFromDateTime(const DateTime: TDateTime): TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// get TTimeLog value from a given Unix seconds since epoch timestamp
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@aTime)^.FromUnixTime()
function TimeLogFromUnixTime(const UnixTime: TUnixTime): TTimeLog;
  {$ifdef HASINLINE}inline;{$endif}

/// Date/Time conversion from a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@Timestamp)^.ToDateTime
// - we defined such a function since TTimeLogBits(aTimeLog).ToDateTime gives an
// internall compiler error on some Delphi IDE versions (e.g. Delphi 6)
function TimeLogToDateTime(const Timestamp: TTimeLog): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// Unix seconds since epoch timestamp conversion from a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - just a wrapper around PTimeLogBits(@Timestamp)^.ToUnixTime
function TimeLogToUnixTime(const Timestamp: TTimeLog): TUnixTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a Iso8601 encoded string into a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - use this function only for fast comparaison between two Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
// - ContainsNoTime optional pointer can be set to a boolean, which will be
// set according to the layout in P (e.g. TRUE for '2012-05-26')
// - returns 0 in case of invalid input string
function Iso8601ToTimeLogPUTF8Char(P: PUTF8Char; L: integer; ContainsNoTime: PBoolean=nil): TTimeLog;

/// convert a Iso8601 encoded string into a TTimeLog value
// - handle TTimeLog bit-encoded Int64 format
// - use this function only for fast comparaison between two Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// test if P^ contains a valid ISO-8601 text encoded value
// - calls internally Iso8601ToTimeLogPUTF8Char() and returns true if contains
// at least a valid year (YYYY)
function IsIso8601(P: PUTF8Char; L: integer): boolean;
 {$ifdef HASINLINE}inline;{$endif}

/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
function Iso8601ToDateTime(const S: RawByteString): TDateTime; overload;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToDateTimePUTF8Char(P: PUTF8Char; L: integer=0): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// Date/Time conversion from ISO-8601
// - handle 'YYYYMMDDThhmmss' and 'YYYY-MM-DD hh:mm:ss' format, with potentially
// shorten versions has handled by the ISO-8601 standard (e.g. 'YYYY')
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
procedure Iso8601ToDateTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);

/// Date/Time conversion from strict ISO-8601 content
// - recognize 'YYYY-MM-DDThh:mm:ss[.sss]' or 'YYYY-MM-DD' or 'Thh:mm:ss[.sss]'
// patterns, as e.g. generated by TTextWriter.AddDateTime() or RecordSaveJSON()
// - will also recognize '.sss' milliseconds suffix, if any
function Iso8601CheckAndDecode(P: PUTF8Char; L: integer; var Value: TDateTime): boolean;

/// Time conversion from ISO-8601 (with no Date part)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer=0): TDateTime; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// Time conversion from ISO-8601 (with no Date part)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - will also recognize '.sss' milliseconds suffix, if any
// - if L is left to default 0, it will be computed from StrLen(P)
procedure Iso8601ToTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);

/// Time conversion from ISO-8601 (with no Date part)
// - regnozie 'hhmmss' and 'hh:mm:ss' format into H,M,S variables
// - will also recognize '.sss' milliseconds suffix, if any, into MS
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer; var H,M,S,MS: cardinal): boolean; overload;

/// Interval date/time conversion from simple text
// - expected format does not match ISO-8601 Time intervals format, but Oracle
// interval litteral representation, i.e. '+/-D HH:MM:SS'
// - e.g. IntervalTextToDateTime('+0 06:03:20') will return 0.25231481481 and
// IntervalTextToDateTime('-20 06:03:20') -20.252314815
// - as a consequence, negative intervals will be written as TDateTime values:
// !DateTimeToIso8601Text(IntervalTextToDateTime('+0 06:03:20'))='T06:03:20'
// !DateTimeToIso8601Text(IntervalTextToDateTime('+1 06:03:20'))='1899-12-31T06:03:20'
// !DateTimeToIso8601Text(IntervalTextToDateTime('-2 06:03:20'))='1899-12-28T06:03:20'
function IntervalTextToDateTime(Text: PUTF8Char): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// Interval date/time conversion from simple text
// - expected format does not match ISO-8601 Time intervals format, but Oracle
// interval litteral representation, i.e. '+/-D HH:MM:SS'
// - e.g. '+1 06:03:20' will return 1.25231481481
procedure IntervalTextToDateTimeVar(Text: PUTF8Char; var result: TDateTime);

/// basic Date/Time conversion into ISO-8601
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - you may rather use DateTimeToIso8601Text() to handle 0 or date-only values
function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar='T'; WithMS: boolean=false): RawUTF8;

/// basic Date conversion into ISO-8601
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8; overload;

/// basic Date conversion into ISO-8601
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DateToIso8601(Y,M,D: cardinal; Expanded: boolean): RawUTF8; overload;

/// basic Date period conversion into ISO-8601
// - will convert an elapsed number of days as ISO-8601 text
// - use 'YYYYMMDD' format if not Expanded
// - use 'YYYY-MM-DD' format if Expanded
function DaysToIso8601(Days: cardinal; Expanded: boolean): RawUTF8;

/// basic Time conversion into ISO-8601
// - use 'Thhmmss' format if not Expanded
// - use 'Thh:mm:ss' format if Expanded
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar='T';
  WithMS: boolean=false): RawUTF8;

/// Write a Date to P^ Ansi buffer
// - if Expanded is false, 'YYYYMMDD' date format is used
// - if Expanded is true, 'YYYY-MM-DD' date format is used
procedure DateToIso8601PChar(P: PUTF8Char; Expanded: boolean; Y,M,D: PtrUInt); overload;

/// convert a date into 'YYYY-MM-DD' date format
// - resulting text is compatible with all ISO-8601 functions
function DateToIso8601Text(Date: TDateTime): RawUTF8;

/// Write a Date/Time to P^ Ansi buffer
procedure DateToIso8601PChar(Date: TDateTime; P: PUTF8Char; Expanded: boolean); overload;

/// Write a TDateTime value, expanded as Iso-8601 encoded text into P^ Ansi buffer
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
procedure DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUTF8Char;
  FirstChar: AnsiChar='T'; WithMS: boolean=false);

/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar='T';
  WithMS: boolean=false): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar; var result: RawUTF8;
  WithMS: boolean=false);

/// write a TDateTime into strict ISO-8601 date and/or time text
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as 'YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as 'Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as 'YYYY-MM-DDThh:mm:ss'
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar; var result: string;
  WithMS: boolean=false);

/// Write a Time to P^ Ansi buffer
// - if Expanded is false, 'Thhmmss' time format is used
// - if Expanded is true, 'Thh:mm:ss' time format is used
// - you can custom the first char in from of the resulting text time
// - if WithMS is TRUE, will append MS as '.sss' for milliseconds resolution
procedure TimeToIso8601PChar(P: PUTF8Char; Expanded: boolean; H,M,S,MS: PtrUInt;
  FirstChar: AnsiChar = 'T'; WithMS: boolean=false); overload;

/// Write a Time to P^ Ansi buffer
// - if Expanded is false, 'Thhmmss' time format is used
// - if Expanded is true, 'Thh:mm:ss' time format is used
// - you can custom the first char in from of the resulting text time
// - if WithMS is TRUE, will append '.sss' for milliseconds resolution
procedure TimeToIso8601PChar(Time: TDateTime; P: PUTF8Char; Expanded: boolean;
  FirstChar: AnsiChar = 'T'; WithMS: boolean=false); overload;

var
  /// custom TTimeLog date to ready to be displayed text function
  // - you can override this pointer in order to display the text according
  // to your expected i18n settings
  // - this callback will therefore be set by the mORMoti18n.pas unit
  // - used e.g. by TTimeLogBits.i18nText and by TSQLTable.ExpandAsString()
  // methods, i.e. TSQLTableToGrid.DrawCell()
  i18nDateText: function(const Iso: TTimeLog): string = nil;
  /// custom date to ready to be displayed text function
  // - you can override this pointer in order to display the text according
  // to your expected i18n settings
  // - this callback will therefore be set by the mORMoti18n.pas unit
  // - used e.g. by TSQLTable.ExpandAsString() method,
  // i.e. TSQLTableToGrid.DrawCell()
  i18nDateTimeText: function(const DateTime: TDateTime): string = nil;

/// wrapper calling global i18nDateTimeText() callback if set,
// or returning ISO-8601 standard layout on default
function DateTimeToi18n(const DateTime: TDateTime): string;


/// fast conversion of 2 digit characters into a 0..99 value
// - returns FALSE on success, TRUE if P^ is not correct
function Char2ToByte(P: PUTF8Char; out Value: Cardinal): Boolean;

/// fast conversion of 3 digit characters into a 0..9999 value
// - returns FALSE on success, TRUE if P^ is not correct
function Char3ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;

/// fast conversion of 4 digit characters into a 0..9999 value
// - returns FALSE on success, TRUE if P^ is not correct
function Char4ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;

/// our own fast version of the corresponding low-level function
function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;

/// retrieve the current Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowToString(Expanded: boolean=true; FirstTimeChar: AnsiChar = ' '): RawUTF8;

/// retrieve the current UTC Date, in the ISO 8601 layout, but expanded and
// ready to be displayed
function NowUTCToString(Expanded: boolean=true; FirstTimeChar: AnsiChar = ' '): RawUTF8;

/// convert some date/time to the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
// - see also TTextWriter.AddDateTimeMS method
function DateTimeMSToString(DateTime: TDateTime; Expanded: boolean=true;
  FirstTimeChar: AnsiChar=' '; const TZD: RawUTF8='Z'): RawUTF8; overload;

/// convert some date/time to the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
// - see also TTextWriter.AddDateTimeMS method
function DateTimeMSToString(HH,MM,SS,MS,Y,M,D: cardinal; Expanded: boolean;
  FirstTimeChar: AnsiChar=' '; const TZD: RawUTF8='Z'): RawUTF8; overload;

/// convert some date/time to the "HTTP-date" format as defined by RFC 7231
// - i.e. "Tue, 15 Nov 1994 12:45:26 GMT" to be used as a value of
// "Date", "Expires" or "Last-Modified" HTTP header
// - if you care about timezones Value must be converted to UTC first
// using TSynTimeZone.LocalToUtc
function DateTimeToHTTPDate(UTCDateTime: TDateTime): RawUTF8;

/// convert some TDateTime to a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function DateTimeToFileShort(const DateTime: TDateTime): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert some TDateTime to a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
procedure DateTimeToFileShort(const DateTime: TDateTime; out result: TShort16); overload;

/// retrieve the current Time (whithout Date), in the ISO 8601 layout
// - useful for direct on screen logging e.g.
function TimeToString: RawUTF8;

const
  /// a contemporary, but elapsed, TUnixTime second-based value
  // - corresponds to Thu, 08 Dec 2016 08:50:20 GMT
  // - may be used to check for a valid just-generated Unix timestamp value
  UNIXTIME_MINIMAL = 1481187020;

/// convert a second-based c-encoded time as TDateTime
//  - i.e. number of seconds elapsed since Unix epoch 1/1/1970 into TDateTime
function UnixTimeToDateTime(const UnixTime: TUnixTime): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TDateTime into a second-based c-encoded time
//  - i.e. TDateTime into number of seconds elapsed since Unix epoch 1/1/1970
function DateTimeToUnixTime(const AValue: TDateTime): TUnixTime;
  {$ifdef HASINLINE}inline;{$endif}

/// returns the current UTC date/time as a second-based c-encoded time
// - i.e. current number of seconds elapsed since Unix epoch 1/1/1970
// - faster than NowUTC or GetTickCount64, on Windows or Unix platforms
// (will use e.g. fast clock_gettime(CLOCK_REALTIME_COARSE) under Linux,
// or GetSystemTimeAsFileTime under Windows)
// - returns a 64-bit unsigned value, so is "Year2038bug" free
function UnixTimeUTC: TUnixTime;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// the ISO 8601 text layout
// - use 'YYYYMMDDThhmmss' format if not Expanded
// - use 'YYYY-MM-DDThh:mm:ss' format if Expanded
function UnixTimeToString(const UnixTime: TUnixTime; Expanded: boolean=true;
  FirstTimeChar: AnsiChar='T'): RawUTF8;

/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
procedure UnixTimeToFileShort(const UnixTime: TUnixTime; out result: TShort16); overload;

/// convert some second-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, perfect e.g. for naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function UnixTimeToFileShort(const UnixTime: TUnixTime): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert some second-based c-encoded time to the ISO 8601 text layout, either
// as time or date elapsed period
// - this function won't add the Unix epoch 1/1/1970 offset to the timestamp
// - returns 'Thh:mm:ss' or 'YYYY-MM-DD' format, depending on the supplied value
function UnixTimePeriodToString(const UnixTime: TUnixTime; FirstTimeChar: AnsiChar='T'): RawUTF8;

/// returns the current UTC date/time as a millisecond-based c-encoded time
// - i.e. current number of milliseconds elapsed since Unix epoch 1/1/1970
// - faster than NowUTC or GetTickCount64, on Windows or Unix platforms
// (will use e.g. fast clock_gettime(CLOCK_REALTIME_COARSE) under Linux,
// or GetSystemTimeAsFileTime under Windows)
function UnixMSTimeUTC: TUnixMSTime;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// convert a millisecond-based c-encoded time (from Unix epoch 1/1/1970) as TDateTime
function UnixMSTimeToDateTime(const UnixMSTime: TUnixMSTime): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TDateTime into a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
// - if AValue is 0, will return 0 (since is likely to be an error constant)
function DateTimeToUnixMSTime(const AValue: TDateTime): TUnixMSTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert some millisecond-based c-encoded time (from Unix epoch 1/1/1970) to
// the ISO 8601 text layout, including milliseconds
// - i.e. 'YYYY-MM-DDThh:mm:ss.sssZ' or 'YYYYMMDDThhmmss.sssZ' format
// - TZD is the ending time zone designator ('', 'Z' or '+hh:mm' or '-hh:mm')
function UnixMSTimeToString(const UnixMSTime: TUnixMSTime; Expanded: boolean=true;
  FirstTimeChar: AnsiChar='T'; const TZD: RawUTF8=''): RawUTF8;

/// convert some milllisecond-based c-encoded time (from Unix epoch 1/1/1970) to
// a small text layout, trimming to the second resolution, perfect e.g. for
// naming a local file
// - use 'YYMMDDHHMMSS' format so year is truncated to last 2 digits, expecting
// a date > 1999 (a current date would be fine)
function UnixMSTimeToFileShort(const UnixMSTime: TUnixMSTime): TShort16;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert some millisecond-based c-encoded time to the ISO 8601 text layout,
// as time or date elapsed period
// - this function won't add the Unix epoch 1/1/1970 offset to the timestamp
// - returns 'Thh:mm:ss' or 'YYYY-MM-DD' format, depending on the supplied value
function UnixMSTimePeriodToString(const UnixMSTime: TUnixMSTime; FirstTimeChar: AnsiChar='T'): RawUTF8;

/// returns the current UTC system date and time
// - SysUtils.Now returns local time: this function returns the system time
// expressed in Coordinated Universal Time (UTC)
function NowUTC: TDateTime;

type
  {$A-}
  /// used to store Time Zone bias in TSynTimeZone
  // - map how low-level information is stored in the Windows Registry
  TTimeZoneInfo = record
    Bias: integer;
    bias_std: integer;
    bias_dlt: integer;
    change_time_std: TSynSystemTime;
    change_time_dlt: TSynSystemTime;
  end;
  PTimeZoneInfo = ^TTimeZoneInfo;

  /// text identifier of a Time Zone, following Microsoft Windows naming
  TTimeZoneID = type RawUTF8;

  /// used to store Time Zone information for a single area in TSynTimeZone
  {$ifdef FPC_OR_UNICODE}TTimeZoneData = record{$else}TTimeZoneData = object{$endif}
  public
    id: TTimeZoneID;
    display: RawUTF8;
    tzi: TTimeZoneInfo;
    dyn: array of packed record
      year: integer;
      tzi: TTimeZoneInfo;
    end;
    function GetTziFor(year: integer): PTimeZoneInfo;
  end;
  /// used to store the Time Zone information of a TSynTimeZone class
  TTimeZoneDataDynArray = array of TTimeZoneData;
  {$A+}

  /// handle cross-platform time conversions, following Microsoft time zones
  // - is able to retrieve accurate information from the Windows registry,
  // or from a binary compressed file on other platforms (which should have been
  // saved from a Windows system first)
  // - each time zone will be idendified by its TzId string, as defined by
  // Microsoft for its Windows Operating system
  TSynTimeZone = class
  protected
    fZone: TTimeZoneDataDynArray;
    fZones: TDynArrayHashed;
    fLastZone: TTimeZoneID;
    fLastIndex: integer;
    fIds: TStringList;
    fDisplays: TStringList;
  public
    /// will retrieve the default shared TSynTimeZone instance
    // - locally created via the CreateDefault constructor
    // - this is the usual entry point for time zone process, calling e.g.
    // $ aLocalTime := TSynTimeZone.Default.NowToLocal(aTimeZoneID);
    class function Default: TSynTimeZone;
    /// initialize the internal storage
    // - but no data is available, until Load* methods are called
    constructor Create;
    /// retrieve the time zones from Windows registry, or from a local file
    // - under Linux, the file should be located with the executable, renamed
    // with a .tz extension - may have been created via SaveToFile(''), or
    // from a 'TSynTimeZone' bound resource
    // "dummy" parameter exists only to disambiguate constructors for C++
    constructor CreateDefault(dummy: integer=0);
    /// finalize the instance
    destructor Destroy; override;
    {$ifdef MSWINDOWS}
    {$ifndef LVCL}
    /// read time zone information from the Windows registry
    procedure LoadFromRegistry;
    {$endif}
    {$endif MSWINDOWS}
    /// read time zone information from a compressed file
    // - if no file name is supplied, a ExecutableName.tz file would be used
    procedure LoadFromFile(const FileName: TFileName='');
    /// read time zone information from a compressed memory buffer
    procedure LoadFromBuffer(const Buffer: RawByteString);
    /// read time zone information from a 'TSynTimeZone' resource
    // - the resource should contain the SaveToBuffer compressed binary content
    // - is no resource matching the TSynTimeZone class name and ResType=10
    // do exist, nothing would be loaded
    // - the resource could be created as such, from a Windows system:
    // ! TSynTimeZone.Default.SaveToFile('TSynTimeZone.data');
    // then compile the resource as expected, with a brcc32 .rc entry:
    // ! TSynTimeZone 10 "TSynTimeZone.data"
    // - you can specify a library (dll) resource instance handle, if needed
    procedure LoadFromResource(Instance: THandle=0);
    /// write then time zone information into a compressed file
    // - if no file name is supplied, a ExecutableName.tz file would be created
    procedure SaveToFile(const FileName: TFileName);
    /// write then time zone information into a compressed memory buffer
    function SaveToBuffer: RawByteString;
    /// retrieve the time bias (in minutes) for a given date/time on a TzId
    function GetBiasForDateTime(const Value: TDateTime; const TzId: TTimeZoneID;
      out Bias: integer; out HaveDaylight: boolean): boolean;
    /// retrieve the display text corresponding to a TzId
    // - returns '' if the supplied TzId is not recognized
    function GetDisplay(const TzId: TTimeZoneID): RawUTF8;
    /// compute the UTC date/time corrected for a given TzId
    function UtcToLocal(const UtcDateTime: TDateTime; const TzId: TTimeZoneID): TDateTime;
    /// compute the current date/time corrected for a given TzId
    function NowToLocal(const TzId: TTimeZoneID): TDateTime;
    /// compute the UTC date/time for a given local TzId value
    // - by definition, a local time may correspond to two UTC times, during the
    // time biais period, so the returned value is informative only, and any
    // stored value should be following UTC
    function LocalToUtc(const LocalDateTime: TDateTime; const TzID: TTimeZoneID): TDateTime;
    /// direct access to the low-level time zone information
    property Zone: TTimeZoneDataDynArray read fZone;
    /// direct access to the wrapper over the time zone information array
    property Zones: TDynArrayHashed read fZones;
    /// returns a TStringList of all TzID values
    // - could be used to fill any VCL component to select the time zone
    // - order in Ids[] array follows the Zone[].id information
    function Ids: TStrings;
    /// returns a TStringList of all Display text values
    // - could be used to fill any VCL component to select the time zone
    // - order in Displays[] array follows the Zone[].display information
    function Displays: TStrings;
  end;

{$ifndef ENHANCEDRTL}
{$ifndef LVCL} { don't define these twice }

var
  /// these procedure type must be defined if a default system.pas is used
  // - mORMoti18n.pas unit will hack default LoadResString() procedure
  // - already defined in our Extended system.pas unit
  // - needed with FPC, Delphi 2009 and up, i.e. when ENHANCEDRTL is not defined
  // - expect generic "string" type, i.e. UnicodeString for Delphi 2009+
  // - not needed with the LVCL framework (we should be on server side)
  LoadResStringTranslate: procedure(var Text: string) = nil;

  /// current LoadResString() cached entries count
  // - i.e. resourcestring caching for faster use
  // - used only if a default system.pas is used, not our Extended version
  // - defined here, but resourcestring caching itself is implemented in the
  // mORMoti18n.pas unit, if the ENHANCEDRTL conditional is not defined
  CacheResCount: integer = -1;

{$endif}
{$endif}

type
  /// a generic callback, which can be used to translate some text on the fly
  // - maps procedure TLanguageFile.Translate(var English: string) signature
  // as defined in mORMoti18n.pas
  // - can be used e.g. for TSynMustache's {{"English text}} callback
  TOnStringTranslate = procedure (var English: string) of object;


const
  /// Rotate local log file if reached this size (1MB by default)
  // - .log file will be save as .log.bak file
  // - a new .log file is created
  // - used by AppendToTextFile() and LogToTextFile() functions (not TSynLog)
  MAXLOGSIZE = 1024*1024;

/// log a message to a local text file
// - the text file is located in the executable directory, and its name is
// simply the executable file name with the '.log' extension instead of '.exe'
// - format contains the current date and time, then the Msg on one line
// - date and time format used is 'YYYYMMDD hh:mm:ss (i.e. ISO-8601)'
procedure LogToTextFile(Msg: RawUTF8);

/// log a message to a local text file
// - this version expects the filename to be specified
// - format contains the current date and time, then the Msg on one line
// - date and time format used is 'YYYYMMDD hh:mm:ss'
procedure AppendToTextFile(aLine: RawUTF8; const aFileName: TFileName; aMaxSize: Int64=MAXLOGSIZE;
  aUTCTimeStamp: boolean=false);


{ ************ fast low-level lookup types used by internal conversion routines }

{$ifndef ENHANCEDRTL}
{$ifndef LVCL} { don't define these const twice }

const
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their ASCII equivalence
  // - our enhanced SysUtils.pas (normal and LVCL) contains the same array
  TwoDigitLookup: packed array[0..99] of array[1..2] of AnsiChar =
    ('00','01','02','03','04','05','06','07','08','09',
     '10','11','12','13','14','15','16','17','18','19',
     '20','21','22','23','24','25','26','27','28','29',
     '30','31','32','33','34','35','36','37','38','39',
     '40','41','42','43','44','45','46','47','48','49',
     '50','51','52','53','54','55','56','57','58','59',
     '60','61','62','63','64','65','66','67','68','69',
     '70','71','72','73','74','75','76','77','78','79',
     '80','81','82','83','84','85','86','87','88','89',
     '90','91','92','93','94','95','96','97','98','99');

{$endif}
{$endif}

var
  /// fast lookup table for converting any decimal number from
  // 0 to 99 into their ASCII equivalence
  TwoDigitLookupW: packed array[0..99] of word absolute TwoDigitLookup;

const
{$ifdef OPT4AMD} // circumvent Delphi 5 and Delphi 6 compilation issues :(
  ANSICHARNOT01310: TSynAnsicharSet = [#1..#9,#11,#12,#14..#255];
  IsWord: TSynByteSet =
    [ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')];
  IsIdentifier: TSynByteSet =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')];
  IsJsonIdentifierFirstChar: TSynByteSet =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z'),ord('$')];
  IsJsonIdentifier: TSynByteSet =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z'),
     ord('.'),ord('['),ord(']')];
  IsURIUnreserved: TSynByteSet =
    [ord('a')..ord('z'),ord('A')..ord('Z'),ord('0')..ord('9'),
     ord('-'),ord('.'),ord('_'),ord('~')];
{$else}
  /// used e.g. by inlined function GetLineContains()
  ANSICHARNOT01310 = [#1..#9,#11,#12,#14..#255];

  /// used internaly for fast word recognition (32 bytes const)
  IsWord =
    [ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')];

  /// used internaly for fast identifier recognition (32 bytes const)
  // - can be used e.g. for field or table name
  // - this char set matches the classical pascal definition of identifiers
  // - see also PropNameValid() and PropNamesValid()
  IsIdentifier =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')];

  /// used internaly for fast extended JSON property name recognition (32 bytes const)
  // - can be used e.g. for extended JSON object field
  // - follow JsonPropNameValid, GetJSONPropName and GotoNextJSONObjectOrArray
  IsJsonIdentifierFirstChar =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z'),ord('$')];

  /// used internaly for fast extended JSON property name recognition (32 bytes const)
  // - can be used e.g. for extended JSON object field
  // - follow JsonPropNameValid, GetJSONPropName and GotoNextJSONObjectOrArray
  IsJsonIdentifier =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z'),
     ord('.'),ord('['),ord(']')];

  /// used internaly for fast URI "unreserved" characters identifier
  // - defined as unreserved  = ALPHA / DIGIT / "-" / "." / "_" / "~"
  // in @http://tools.ietf.org/html/rfc3986#section-2.3
  IsURIUnreserved =
    [ord('a')..ord('z'),ord('A')..ord('Z'),ord('0')..ord('9'),
     ord('-'),ord('.'),ord('_'),ord('~')];

{$endif OPT4AMD}

{$M+} // to have existing RTTI for published properties
type
  /// used to retrieve version information from any EXE
  // - under Linux, all version numbers are set to 0 by default
  // - you should not have to use this class directly, but via the
  // ExeVersion global variable
  TFileVersion = class
  protected
    fDetailed: string;
    fFileName: TFileName;
    fBuildDateTime: TDateTime;
    /// change the version (not to be used in most cases)
    procedure SetVersion(aMajor,aMinor,aRelease,aBuild: integer);
  public
    /// executable major version number
    Major: Integer;
    /// executable minor version number
    Minor: Integer;
    /// executable release version number
    Release: Integer;
    /// executable release build number
    Build: Integer;
    /// build year of this exe file
    BuildYear: word;
    /// version info of the exe file as '3.1'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    Main: string;
    /// associated CompanyName string version resource
    // - only available on Windows - contains '' under Linux
    CompanyName: RawUTF8;
    /// associated FileDescription string version resource
    // - only available on Windows - contains '' under Linux
    FileDescription: RawUTF8;
    /// associated FileVersion string version resource
    // - only available on Windows - contains '' under Linux
    FileVersion: RawUTF8;
    /// associated InternalName string version resource
    // - only available on Windows - contains '' under Linux
    InternalName: RawUTF8;
    /// associated LegalCopyright string version resource
    // - only available on Windows - contains '' under Linux
    LegalCopyright: RawUTF8;
    /// associated OriginalFileName string version resource
    // - only available on Windows - contains '' under Linux
    OriginalFilename: RawUTF8;
    /// associated ProductName string version resource
    // - only available on Windows - contains '' under Linux
    ProductName: RawUTF8;
    /// associated ProductVersion string version resource
    // - only available on Windows - contains '' under Linux
    ProductVersion: RawUTF8;
    /// associated Comments string version resource
    // - only available on Windows - contains '' under Linux
    Comments: RawUTF8;
    /// retrieve application version from exe file name
    // - DefaultVersion32 is used if no information Version was included into
    // the executable resources (on compilation time)
    // - you should not have to use this constructor, but rather access the
    // ExeVersion global variable
    constructor Create(const aFileName: TFileName; aMajor: integer=0;
      aMinor: integer=0; aRelease: integer=0; aBuild: integer=0);
    /// retrieve the version as a 32-bit integer with Major.Minor.Release
    // - following Major shl 16+Minor shl 8+Release bit pattern
    function Version32: integer;
    /// build date and time of this exe file, as plain text
    function BuildDateTimeString: string;
    /// version info of the exe file as '3.1.0.123' or ''
    // - this method returns '' if Detailed is '0.0.0.0'
    function DetailedOrVoid: string;
    /// returns the version information of this exe file as text
    // - includes FileName (without path), Detailed and BuildDateTime properties
    // - e.g. 'myprogram.exe 3.1.0.123 2016-06-14 19:07:55'
    function VersionInfo: RawUTF8;
    /// returns a ready-to-use User-Agent header with exe name, version and OS
    // - e.g. 'myprogram/3.1.0.123W32'
    // - here OS_INITIAL[] character is used to identify the OS, with '32'
    // appended on 32-bit Windows
    function UserAgent: RawUTF8;
    /// returns the version information of a specified exe file as text
    // - includes FileName (without path), Detailed and BuildDateTime properties
    // - e.g. 'myprogram.exe 3.1.0.123 2016-06-14 19:07:55'
    class function GetVersionInfo(const aFileName: TFileName): RawUTF8;
  published
    /// version info of the exe file as '3.1.0.123'
    // - return "string" type, i.e. UnicodeString for Delphi 2009+
    // - under Linux, always return '0.0.0.0' if no custom version number
    // has been defined
    // - consider using DetailedOrVoid method if '0.0.0.0' is not expected
    property Detailed: string read fDetailed write fDetailed;
    /// build date and time of this exe file
    property BuildDateTime: TDateTime read fBuildDateTime write fBuildDateTime;
  end;
{$M-}


{$ifdef DELPHI6OROLDER}

// define some common constants not available prior to Delphi 7
const
  HoursPerDay   = 24;
  MinsPerHour   = 60;
  SecsPerMin    = 60;
  MSecsPerSec   = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay   = SecsPerDay * MSecsPerSec;
  DateDelta     = 693594;
  UnixDateDelta = 25569;

/// GetFileVersion returns the most significant 32-bit of a file's binary
// version number
// - typically, this includes the major and minor version placed
// together in one 32-bit integer
// - generally does not include the release or build numbers
// - returns Cardinal(-1) in case of failure
function GetFileVersion(const FileName: TFileName): cardinal;

{$endif DELPHI6OROLDER}

type
  /// the recognized operating systems
  // - it will also recognize some Linux distributions
  TOperatingSystem = (osUnknown, osWindows, osLinux, osOSX, osBSD, osPOSIX,
    osArch, osAurox, osDebian, osFedora, osGentoo, osKnoppix, osMint, osMandrake,
    osMandriva, osNovell, osUbuntu, osSlackware, osSolaris, osSuse, osSynology,
    osTrustix, osClear, osUnited, osRedHat, osLFS, osOracle, osMageia, osCentOS,
    osCloud, osXen, osAmazon, osCoreOS, osAlpine);
  /// the recognized Windows versions
  // - defined even outside MSWINDOWS to allow process e.g. from monitoring tools
  TWindowsVersion = (
    wUnknown, w2000, wXP, wXP_64, wServer2003, wServer2003_R2,
    wVista, wVista_64, wServer2008, wServer2008_64,
    wSeven, wSeven_64, wServer2008_R2, wServer2008_R2_64,
    wEight, wEight_64, wServer2012, wServer2012_64,
    wEightOne, wEightOne_64, wServer2012R2, wServer2012R2_64,
    wTen, wTen_64, wServer2016, wServer2016_64, wServer2019_64);
  /// the running Operating System, encoded as a 32-bit integer
  TOperatingSystemVersion = packed record
    case os: TOperatingSystem of
    osUnknown: (b: array[0..2] of byte);
    osWindows: (win: TWindowsVersion);
    osLinux:   (utsrelease: array[0..2] of byte);
  end;

const
  /// the recognized Windows versions, as plain text
  // - defined even outside MSWINDOWS to allow process e.g. from monitoring tools
  WINDOWS_NAME: array[TWindowsVersion] of RawUTF8 = (
    '', '2000', 'XP', 'XP 64bit', 'Server 2003', 'Server 2003 R2',
    'Vista', 'Vista 64bit', 'Server 2008', 'Server 2008 64bit',
    '7', '7 64bit', 'Server 2008 R2', 'Server 2008 R2 64bit',
    '8', '8 64bit', 'Server 2012', 'Server 2012 64bit',
    '8.1', '8.1 64bit', 'Server 2012 R2', 'Server 2012 R2 64bit',
    '10', '10 64bit', 'Server 2016', 'Server 2016 64bit', 'Server 2019 64bit');
  /// the recognized Windows versions which are 32-bit
  WINDOWS_32 = [w2000, wXP, wServer2003, wServer2003_R2, wVista, wServer2008,
    wSeven, wServer2008_R2, wEight, wServer2012, wEightOne, wServer2012R2,
    wTen, wServer2016];
  /// translate one operating system (and distribution) into a single character
  // - may be used internally e.g. for a HTTP User-Agent header
  OS_INITIAL: array[TOperatingSystem] of AnsiChar =
    ('?', 'W', 'L', 'X', 'B', 'P', 'A', 'a', 'D', 'F', 'G', 'K', 'M', 'm',
     'n', 'N', 'U', 'S', 's', 'u', 'Y', 'T', 'C', 't', 'R', 'l', 'O', 'G',
     'c', 'd', 'x', 'Z', 'r', 'p');
  /// the operating systems items which actually are Linux distributions
  OS_LINUX = [osLinux, osArch .. osAlpine];

  /// the compiler family used
  COMP_TEXT = {$ifdef FPC}'Fpc'{$else}'Delphi'{$endif};
  /// the target Operating System used for compilation, as text
  OS_TEXT = {$ifdef MSWINDOWS}'Win'{$else}{$ifdef DARWIN}'OSX'{$else}
  {$ifdef BSD}'BSD'{$else}{$ifdef LINUX}'Linux'{$else}'Posix'
  {$endif}{$endif}{$endif}{$endif};
  /// the CPU architecture used for compilation
  CPU_ARCH_TEXT = {$ifdef CPUX86}'x86'{$else}{$ifdef CPUX64}'x64'{$else}
    {$ifdef CPUARM}'arm'+{$else}
    {$ifdef CPUPOWERPC}'ppc'+{$else}
    {$ifdef CPUSPARC}'sparc'+{$endif}{$endif}{$endif}
    {$ifdef CPU32}'32'{$else}'64'{$endif}{$endif}{$endif};

function ToText(os: TOperatingSystem): PShortString; overload;
function ToText(const osv: TOperatingSystemVersion): ShortString; overload;
function ToTextOS(osint32: integer): RawUTF8;

var
  /// the target Operating System used for compilation, as TOperatingSystem
  OS_KIND: TOperatingSystem = {$ifdef MSWINDOWS}osWindows{$else}{$ifdef DARWIN}osOSX{$else}
  {$ifdef BSD}osBSD{$else}{$ifdef LINUX}osLinux{$else}osPOSIX
  {$endif}{$endif}{$endif}{$endif};
  /// the current Operating System version, as retrieved for the current process
  // - contains e.g. 'Windows Seven 64 SP1 (6.1.7601)' or
  // 'Ubuntu 16.04.5 LTS - Linux 3.13.0 110 generic#157 Ubuntu SMP Mon Feb 20 11:55:25 UTC 2017'
  OSVersionText: RawUTF8;
  /// some textual information about the current CPU
  CpuInfoText: RawUTF8;
  /// some textual information about the current computer hardware, from BIOS
  BiosInfoText: RawUTF8;
  /// the running Operating System
  OSVersion32: TOperatingSystemVersion;
  OSVersionInt32: integer absolute OSVersion32;

{$ifdef MSWINDOWS}
  {$ifndef UNICODE}
  type
  /// low-level API structure, not defined in older Delphi versions
  TOSVersionInfoEx = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of char;
    wServicePackMajor: WORD;
    wServicePackMinor: WORD;
    wSuiteMask: WORD;
    wProductType: BYTE;
    wReserved: BYTE;
  end;
  {$endif UNICODE}

var
  /// is set to TRUE if the current process is a 32-bit image running under WOW64
  // - WOW64 is the x86 emulator that allows 32-bit Windows-based applications
  // to run seamlessly on 64-bit Windows
  // - equals always FALSE if the current executable is a 64-bit image
  IsWow64: boolean;
  /// the current System information, as retrieved for the current process
  // - under a WOW64 process, it will use the GetNativeSystemInfo() new API
  // to retrieve the real top-most system information
  // - note that the lpMinimumApplicationAddress field is replaced by a
  // more optimistic/realistic value ($100000 instead of default $10000)
  // - under BSD/Linux, only contain dwPageSize and dwNumberOfProcessors fields
  SystemInfo: TSystemInfo;
  /// the current Operating System information, as retrieved for the current process
  OSVersionInfo: TOSVersionInfoEx;
  /// the current Operating System version, as retrieved for the current process
  OSVersion: TWindowsVersion;

/// this function can be used to create a GDI compatible window, able to
// receive Windows Messages for fast local communication
// - will return 0 on failure (window name already existing e.g.), or
//  the created HWND handle on success
// - it will call the supplied message handler defined for a given Windows Message:
//  for instance, define such a method in any object definition:
// !  procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;
function CreateInternalWindow(const aWindowName: string; aObject: TObject): HWND;

/// delete the window resources used to receive Windows Messages
// - must be called for each CreateInternalWindow() function
// - both parameter values are then reset to ''/0
function ReleaseInternalWindow(var aWindowName: string; var aWindow: HWND): boolean;

/// under Windows 7 and later, will set an unique application-defined
// Application User Model ID (AppUserModelID) that identifies the current
// process to the taskbar
// - this identifier allows an application to group its associated processes
// and windows under a single taskbar button
// - value can have no more than 128 characters, cannot contain spaces, and
// each section should be camel-cased, as such:
// $ CompanyName.ProductName.SubProduct.VersionInformation
// CompanyName and ProductName should always be used, while the SubProduct and
// VersionInformation portions are optional and depend on the application's requirements
// - if the supplied text does not contain an '.', 'ID.ID' will be used
function SetAppUserModelID(const AppUserModelID: string): boolean;

var
  /// the number of milliseconds that have elapsed since the system was started
  // - compatibility function, to be implemented according to the running OS
  // - will use the corresponding native API function under Vista+, or
  // will emulate it for older Windows versions (XP)
  // - warning: FPC's SysUtils.GetTickCount64 or TThread.GetTickCount64 don't
  // handle properly 49 days wrapping under XP -> always use this safe version
  GetTickCount64: function: Int64; stdcall;

/// similar to Windows sleep() API call, to be truly cross-platform
// - it should have a millisecond resolution, and handle ms=0 as a switch to
// another pending thread, i.e. under Windows will call SwitchToThread API
procedure SleepHiRes(ms: cardinal);

/// low-level wrapper to get the 64-bit value from a TFileTime
// - as recommended by MSDN to avoid dword alignment issue
procedure FileTimeToInt64(const FT: TFileTime; out I64: Int64);
  {$ifdef HASINLINE}inline;{$endif}

/// low-level conversion of a Windows 64-bit TFileTime into a Unix time seconds stamp
function FileTimeToUnixTime(const FT: TFileTime): TUnixTime;

/// low-level conversion of a Windows 64-bit TFileTime into a Unix time ms stamp
function FileTimeToUnixMSTime(const FT: TFileTime): TUnixMSTime;

{$else MSWINDOWS}

var
  /// emulate only some used fields of Windows' TSystemInfo
  SystemInfo: record
    // retrieved from libc's getpagesize()
    dwPageSize: cardinal;
    // retrieved from HW_NCPU (BSD) or /proc/cpuinfo (Linux)
    dwNumberOfProcessors: cardinal;
    // as returned by fpuname()
    uts: UtsName;
    // as from /etc/*-release
    release: RawUTF8;
  end;

{$ifdef KYLIX3}

/// compatibility function for Linux
function GetCurrentThreadID: TThreadID; cdecl;
  external 'libpthread.so.0' name 'pthread_self';

/// overloaded function using open64() to allow 64-bit positions
function FileOpen(const FileName: string; Mode: LongWord): Integer;

{$endif}

/// compatibility function, to be implemented according to the running OS
// - expect more or less the same result as the homonymous Win32 API function,
// but usually with a better resolution (Windows has only around 10-16 ms)
// - will call the corresponding function in SynKylix.pas or SynFPCLinux.pas,
// using the very fast CLOCK_MONOTONIC_COARSE if available on the kernel
function GetTickCount64: Int64;

{$endif MSWINDOWS}

/// overloaded function optimized for one pass file reading
// - will use e.g. the FILE_FLAG_SEQUENTIAL_SCAN flag under Windows, as stated
// by http://blogs.msdn.com/b/oldnewthing/archive/2012/01/20/10258690.aspx
// - is used e.g. by StringFromFile() and TSynMemoryStreamMapped.Create()
function FileOpenSequentialRead(const FileName: string): Integer;
  {$ifdef HASINLINE}inline;{$endif}

/// returns a TFileStream optimized for one pass file reading
// - will use FileOpenSequentialRead(), i.e. FILE_FLAG_SEQUENTIAL_SCAN
function FileStreamSequentialRead(const FileName: string): TFileStream;

/// check if the current timestamp, in ms, matched a given period
// - will compare the current GetTickCount64 to the supplied PreviousTix
// - returns TRUE if the Internal ms period was not elapsed
// - returns TRUE, and set PreviousTix, if the Interval ms period was elapsed
// - possible use case may be:
// !var Last: Int64;
// !...
// !  Last := GetTickCount64;
// !  repeat
// !    ...
// !    if Elapsed(Last,1000) then begin
// !      ... // do something every second
// !    end;
// !  until Terminated;
// !...
function Elapsed(var PreviousTix: Int64; Interval: Integer): Boolean;

/// thread-safe move of a 32-bit value using a simple Read-Copy-Update pattern
procedure RCU32(var src,dst);

/// thread-safe move of a 64-bit value using a simple Read-Copy-Update pattern
procedure RCU64(var src,dst);

/// thread-safe move of a 128-bit value using a simple Read-Copy-Update pattern
procedure RCU128(var src,dst);

/// thread-safe move of a pointer value using a simple Read-Copy-Update pattern
procedure RCUPtr(var src,dst);

/// thread-safe move of a memory buffer using a simple Read-Copy-Update pattern
procedure RCU(var src,dst; len: integer);

{$ifndef FPC} { FPC defines those functions as built-in }

/// compatibility function, to be implemented according to the running CPU
// - expect the same result as the homonymous Win32 API function
function InterlockedIncrement(var I: Integer): Integer;
  {$ifdef PUREPASCAL}{$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}{$endif}

/// compatibility function, to be implemented according to the running CPU
// - expect the same result as the homonymous Win32 API function
function InterlockedDecrement(var I: Integer): Integer;
  {$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}

{$endif FPC}

type
  /// stores some global information about the current executable and computer
  TExeVersion = record
    /// the main executable name, without any path nor extension
    // - e.g. 'Test' for 'c:\pathto\Test.exe'
    ProgramName: RawUTF8;
    /// the main executable details, as used e.g. by TSynLog
    // - e.g. 'C:\Dev\lib\SQLite3\exe\TestSQL3.exe 0.0.0.0 (2011-03-29 11:09:06)'
    ProgramFullSpec: RawUTF8;
    /// the main executable file name (including full path)
    // - same as paramstr(0)
    ProgramFileName: TFileName;
    /// the main executable full path (excluding .exe file name)
    // - same as ExtractFilePath(paramstr(0))
    ProgramFilePath: TFileName;
    /// the full path of the running executable or library
    // - for an executable, same as paramstr(0)
    // - for a library, will contain the whole .dll file name
    InstanceFileName: TFileName;
    /// the current executable version
    Version: TFileVersion;
    /// the current computer host name
    Host: RawUTF8;
    /// the current computer user name
    User: RawUTF8;
    /// some hash representation of this information
    // - the very same executable on the very same computer run by the very
    // same user will always have the same Hash value
    // - is computed from the crc32c of this TExeVersion fields: c0 from
    // Version32, CpuFeatures and Host, c1 from User, c2 from ProgramFullSpec
    // and c3 from InstanceFileName
    // - may be used as an entropy seed, or to identify a process execution
    Hash: THash128Rec;
  end;

var
  /// global information about the current executable and computer
  // - this structure is initialized in this unit's initialization block below
  // - you can call SetExecutableVersion() with a custom version, if needed
  ExeVersion: TExeVersion;

/// initialize ExeVersion global variable, supplying a custom version number
// - by default, the version numbers will be retrieved at startup from the
// executable itself (if it was included at build time)
// - but you can use this function to set any custom version numbers
procedure SetExecutableVersion(aMajor,aMinor,aRelease,aBuild: integer); overload;

/// initialize ExeVersion global variable, supplying the version as text
// - e.g. SetExecutableVersion('7.1.2.512');
procedure SetExecutableVersion(const aVersionText: RawUTF8); overload;

type
  /// identify an operating system folder
  TSystemPath = (
    spCommonData, spUserData, spCommonDocuments, spUserDocuments, spTempFolder, spLog);

/// returns an operating system folder
// - will return the full path of a given kind of private or shared folder,
// depending on the underlying operating system
// - will use SHGetFolderPath and the corresponding CSIDL constant under Windows
// - under POSIX, will return $TMP/$TMPDIR folder for spTempFolder, ~/.cache/appname
// for spUserData, /var/log for spLog, or the $HOME folder
// - returned folder name contains the trailing path delimiter (\ or /)
function GetSystemPath(kind: TSystemPath): TFileName;

/// self-modifying code - change some memory buffer in the code segment
// - if Backup is not nil, it should point to a Size array of bytes, ready
// to contain the overridden code buffer, for further hook disabling
procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);

/// self-modifying code - change one PtrUInt in the code segment
procedure PatchCodePtrUInt(Code: PPtrUInt; Value: PtrUInt;
  LeaveUnprotected: boolean=false);

{$ifdef CPUINTEL}
type
  /// small memory buffer used to backup a RedirectCode() redirection hook
  TPatchCode = array[0..4] of byte;
  /// pointer to a small memory buffer used to backup a RedirectCode() hook
  PPatchCode = ^TPatchCode;

/// self-modifying code - add an asm JUMP to a redirected function
// - if Backup is not nil, it should point to a TPatchCode buffer, ready
// to contain the overridden code buffer, for further hook disabling
procedure RedirectCode(Func, RedirectFunc: Pointer; Backup: PPatchCode=nil);

/// self-modifying code - restore a code from its RedirectCode() backup
procedure RedirectCodeRestore(Func: pointer; const Backup: TPatchCode);
{$endif CPUINTEL}

type
  /// to be used instead of TMemoryStream, for speed
  // - allocates memory from Delphi heap (i.e. FastMM4/SynScaleMM)
  // and not GlobalAlloc(), as was the case for oldest versions of Delphi
  // - uses bigger growing size of the capacity
  // - consider using TRawByteStringStream, as we do in our units
{$ifdef LVCL} // LVCL already use Delphi heap instead of GlobalAlloc()
  THeapMemoryStream = TMemoryStream;
{$else}
  {$ifdef FPC} // FPC already use heap instead of GlobalAlloc()
  THeapMemoryStream = TMemoryStream;
  {$else}
  {$ifdef MSWINDOWS}
  THeapMemoryStream = class(TMemoryStream)
  protected
    function Realloc(var NewCapacity: longint): Pointer; override;
  end;
  {$else}
  THeapMemoryStream = TMemoryStream;
  {$endif}
  {$endif}
{$endif}

var
  /// a global "Garbage collector", for some classes instances which must
  // live during whole main executable process
  // - used to avoid any memory leak with e.g. 'class var RecordProps', i.e.
  // some singleton or static objects
  // - to be used, e.g. as:
  // !  Version := TFileVersion.Create(InstanceFileName,DefaultVersion32);
  // !  GarbageCollector.Add(Version);
  // - see also GarbageCollectorFreeAndNil() as an alternative
  GarbageCollector: TObjectList;

  /// set to TRUE when the global "Garbage collector" are beeing freed
  GarbageCollectorFreeing: boolean;

/// a global "Garbage collector" for some TObject global variables which must
// live during whole main executable process
// - this list expects a pointer to the TObject instance variable to be
// specified, and will be set to nil (like a FreeAndNil)
// - this may be useful when used when targetting Delphi IDE packages,
// to circumvent the bug of duplicated finalization of units, in the scope
// of global variables
// - to be used, e.g. as:
// !  if SynAnsiConvertList=nil then
// !    GarbageCollectorFreeAndNil(SynAnsiConvertList,TObjectList.Create);
procedure GarbageCollectorFreeAndNil(var InstanceVariable; Instance: TObject);

/// force the global "Garbage collector" list to be released immediately
// - this function is called in the finalization section of this unit
// - you should NEVER have to call this function, unless some specific cases
// (e.g. when using Delphi packages, just before releasing the package)
procedure GarbageCollectorFree;

/// enter a giant lock for thread-safe shared process
// - shall be protected as such:
// ! GlobalLock;
// ! try
// !   .... do something thread-safe but as short as possible
// ! finally
// !  GlobalUnLock;
// ! end;
// - you should better not use such a giant-lock, but an instance-dedicated
// critical section - these functions are just here to be convenient, for
// non time critical process
procedure GlobalLock;

/// release the giant lock for thread-safe shared process
// - you should better not use such a giant-lock, but an instance-dedicated
// critical section - these functions are just here to be convenient, for
// non time critical process
procedure GlobalUnLock;


/// JSON compatible representation of a boolean value
// - returns either 'true' or 'false'
procedure JSONBoolean(value: boolean; var result: RawUTF8);
  {$ifdef HASINLINE}inline;{$endif} overload;

const
  /// can be used e.g. in logs
  BOOL_STR: array[boolean] of string[7] = ('false','true');

  /// can be used to append to most English nouns to form a plural
  // - see also the Plural function
  PLURAL_FORM: array[boolean] of RawUTF8 = ('','s');

/// write count number and append 's' (if needed) to form a plural English noun
// - for instance, Plural('row',100) returns '100 rows' with no heap allocation
function Plural(const itemname: shortstring; itemcount: cardinal): shortstring;

/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowID(FieldName: PUTF8Char): boolean;
  {$ifdef HASINLINE}inline;{$endif} overload;

/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowID(FieldName: PUTF8Char; FieldLen: integer): boolean;
  {$ifdef HASINLINE}inline;{$endif} overload;

/// returns TRUE if the specified field name is either 'ID', either 'ROWID'
function IsRowIDShort(const FieldName: shortstring): boolean;
  {$ifdef HASINLINE}inline;{$endif} overload;

/// retrieve the next identifier within the UTF-8 buffer
// - returns true if something was set to Prop
function GetNextFieldProp(var P: PUTF8Char; var Prop: RawUTF8): boolean;


{ ************ variant-based process, including JSON/BSON document content }

const
  /// unsigned 64bit integer variant type
  // - currently called varUInt64 in Delphi (not defined in older versions),
  // and varQWord in FPC
  varWord64 = 21;

  /// this variant type will map the current SynUnicode type
  // - depending on the compiler version
  varSynUnicode = {$ifdef HASVARUSTRING}varUString{$else}varOleStr{$endif};

  /// this variant type will map the current string type
  // - depending on the compiler version
  varNativeString = {$ifdef UNICODE}varUString{$else}varString{$endif};

  /// those TVarData.VType values are un-managed and do not need to be cleared
  // - used mainly in low-level code similar to the folllowing:
  // !  if TVarData(aVariant).VType and VTYPE_STATIC<>0 then
  // !    VarClear(aVariant);
  // - equals private constant varDeepData in Delphi's Variants.pas and
  // varComplexType in FPC's variants.pp - seldom used on FPC
  // - make some false positive to varBoolean and varError
  VTYPE_STATIC = $BFE8;

/// same as Dest := TVarData(Source) for simple values
// - will return TRUE for all simple values after varByRef unreference, and
// copying the unreferenced Source value into Dest raw storage
// - will return FALSE for not varByRef values, or complex values (e.g. string)
function SetVariantUnRefSimpleValue(const Source: variant; var Dest: TVarData): boolean;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef LVCL}

/// convert a raw binary buffer into a variant RawByteString varString
// - you can then use VariantToRawByteString() to retrieve the binary content
procedure RawByteStringToVariant(Data: PByte; DataLen: Integer; var Value: variant); overload;

/// convert a RawByteString content into a variant varString
// - you can then use VariantToRawByteString() to retrieve the binary content
procedure RawByteStringToVariant(const Data: RawByteString; var Value: variant); overload;

/// convert back a RawByteString from a variant
// - the supplied variant should have been created via a RawByteStringToVariant()
// function call
procedure VariantToRawByteString(const Value: variant; var Dest: RawByteString);

/// same as Value := Null, but slightly faster
procedure SetVariantNull(var Value: variant);
  {$ifdef HASINLINE}inline;{$endif}

const
  NullVarData: TVarData = (VType: varNull);
var
  /// a slightly faster alternative to Variants.Null function
  Null: variant absolute NullVarData;

{$endif}

/// same as VarIsEmpty(V) or VarIsEmpty(V), but faster
// - we also discovered some issues with FPC's Variants unit, so this function
// may be used even in end-user cross-compiler code
function VarIsEmptyOrNull(const V: Variant): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// same as VarIsEmpty(PVariant(V)^) or VarIsEmpty(PVariant(V)^), but faster
// - we also discovered some issues with FPC's Variants unit, so this function
// may be used even in end-user cross-compiler code
function VarDataIsEmptyOrNull(VarData: pointer): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// fastcheck if a variant hold a value
// - varEmpty, varNull or a '' string would be considered as void
// - varBoolean=false or varDate=0 would be considered as void
// - a TDocVariantData with Count=0 would be considered as void
// - any other value (e.g. integer) would be considered as not void
function VarIsVoid(const V: Variant): boolean;

type
  TVarDataTypes = set of 0..255;

/// allow to check for a specific set of TVarData.VType
function VarIs(const V: Variant; const VTypes: TVarDataTypes): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

{$ifndef NOVARIANTS}

type
  /// an abstract ancestor for faster access of properties
  // - default GetProperty/SetProperty methods are called via some protected
  // virtual IntGet/IntSet methods, with less overhead
  // - these kind of custom variants will be faster than the default
  // TInvokeableVariantType for properties getter/setter, but you should
  // manually register each type by calling SynRegisterCustomVariantType()
  // - also feature custom JSON parsing, via TryJSONToVariant() protected method
  TSynInvokeableVariantType = class(TInvokeableVariantType)
  protected
    {$ifndef FPC}
    {$ifndef DELPHI6OROLDER}
    /// our custom call backs do not want the function names to be uppercased
    function FixupIdent(const AText: string): string; override;
    {$endif}
    {$endif}
    /// override those two abstract methods for fast getter/setter implementation
    procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); virtual; abstract;
    procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); virtual; abstract;
  public
    /// customization of JSON parsing into variants
    // - will be called by e.g. by VariantLoadJSON() or GetVariantFromJSON()
    // with Options: PDocVariantOptions parameter not nil
    // - this default implementation will always returns FALSE,
    // meaning that the supplied JSON is not to be handled by this custom
    // (abstract) variant type
    // - this method could be overridden to identify any custom JSON content
    // and convert it into a dedicated variant instance, then return TRUE
    // - warning: should NOT modify JSON buffer in-place, unless it returns true
    function TryJSONToVariant(var JSON: PUTF8Char; var Value: variant;
      EndOfObject: PUTF8Char): boolean; virtual;
    /// customization of variant into JSON serialization
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); overload; virtual;
    /// retrieve the field/column value
    // - this method will call protected IntGet abstract method
    function GetProperty(var Dest: TVarData; const V: TVarData;
      const Name: String): Boolean; override;
    /// set the field/column value
    // - this method will call protected IntSet abstract method
    {$ifdef FPC_VARIANTSETVAR} // see http://mantis.freepascal.org/view.php?id=26773
    function SetProperty(var V: TVarData; const Name: string;
      const Value: TVarData): Boolean; override;
    {$else}
    function SetProperty(const V: TVarData; const Name: string;
      const Value: TVarData): Boolean; override;
    {$endif}
    /// clear the content
    // - this default implementation will set VType := varEmpty
    // - override it if your custom type needs to manage its internal memory
    procedure Clear(var V: TVarData); override;
    /// copy two variant content
    // - this default implementation will copy the TVarData memory
    // - override it if your custom type needs to manage its internal structure
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
    /// copy two variant content by value
    // - this default implementation will call the Copy() method
    // - override it if your custom types may use a by reference copy pattern
    procedure CopyByValue(var Dest: TVarData; const Source: TVarData); virtual;
    /// this method will allow to look for dotted name spaces, e.g. 'parent.child'
    // - should return Unassigned if the FullName does not match any value
    // - this default implementation will handle TDocVariant storage, or using
    // generic TSynInvokeableVariantType.IntGet() until nested value match
    // - you can override it with a more optimized version
    procedure Lookup(var Dest: TVarData; const V: TVarData; FullName: PUTF8Char); virtual;
    /// will check if the value is an array, and return the number of items
    // - if the document is an array, will return the items count (0 meaning
    // void array)
    // - this default implementation will return -1 (meaning this is not an array)
    // - overridden method could implement it, e.g. for TDocVariant of kind dvArray
    function IterateCount(const V: TVarData): integer; virtual;
    /// allow to loop over an array value
    // - Index should be in 0..IterateCount-1 range
    // - this default implementation will do nothing
    procedure Iterate(var Dest: TVarData; const V: TVarData; Index: integer); virtual;
    /// returns TRUE if the supplied variant is of the exact custom type
    function IsOfType(const V: variant): boolean;
  end;

  /// class-reference type (metaclass) of custom variant type definition
  // - used by SynRegisterCustomVariantType() function
  TSynInvokeableVariantTypeClass = class of TSynInvokeableVariantType;

/// register a custom variant type to handle properties
// - this will implement an internal mechanism used to bypass the default
// _DispInvoke() implementation in Variant.pas, to use a faster version
// - is called in case of TSynTableVariant, TDocVariant, TBSONVariant or
// TSQLDBRowVariant
function SynRegisterCustomVariantType(aClass: TSynInvokeableVariantTypeClass): TSynInvokeableVariantType;


type
  /// possible options for a TDocVariant JSON/BSON document storage
  // - dvoIsArray and dvoIsObject will store the "Kind: TDocVariantKind" state -
  // you should never have to define these two options directly
  // - dvoNameCaseSensitive will be used for every name lookup - here
  // case-insensitivity is restricted to a-z A-Z 0-9 and _ characters
  // - dvoCheckForDuplicatedNames will be used for method
  // TDocVariantData.AddValue(), but not when setting properties at
  // variant level: for consistency, "aVariant.AB := aValue" will replace
  // any previous value for the name "AB"
  // - dvoReturnNullForUnknownProperty will be used when retrieving any value
  // from its name (for dvObject kind of instance), or index (for dvArray or
  // dvObject kind of instance)
  // - by default, internal values will be copied by-value from one variant
  // instance to another, to ensure proper safety - but it may be too slow:
  // if you set dvoValueCopiedByReference, the internal
  // TDocVariantData.VValue/VName instances will be copied by-reference,
  // to avoid memory allocations, BUT it may break internal process if you change
  // some values in place (since VValue/VName and VCount won't match) - as such,
  // if you set this option, ensure that you use the content as read-only
  // - any registered custom types may have an extended JSON syntax (e.g.
  // TBSONVariant does for MongoDB types), and will be searched during JSON
  // parsing, unless dvoJSONParseDoNotTryCustomVariants is set (slightly faster)
  // - by default, it will only handle direct JSON [array] of {object}: but if
  // you define dvoJSONObjectParseWithinString, it will also try to un-escape
  // a JSON string first, i.e. handle "[array]" or "{object}" content (may be
  // used e.g. when JSON has been retrieved from a database TEXT column) - is
  // used for instance by VariantLoadJSON()
  // - JSON serialization will follow the standard layout, unless
  // dvoSerializeAsExtendedJson is set so that the property names would not
  // be escaped with double quotes, writing '{name:"John",age:123}' instead of
  // '{"name":"John","age":123}': this extended json layout is compatible with
  // http://docs.mongodb.org/manual/reference/mongodb-extended-json and with
  // TDocVariant JSON unserialization, also our SynCrossPlatformJSON unit, but
  // NOT recognized by most JSON clients, like AJAX/JavaScript or C#/Java
  // - by default, only integer/Int64/currency number values are allowed, unless
  // dvoAllowDoubleValue is set and 32-bit floating-point conversion is tried,
  // with potential loss of precision during the conversion
  // - dvoInternNames and dvoInternValues will use shared TRawUTF8Interning
  // instances to maintain a list of RawUTF8 names/values for all TDocVariant,
  // so that redundant text content will be allocated only once on heap
  TDocVariantOption =
    (dvoIsArray, dvoIsObject,
     dvoNameCaseSensitive, dvoCheckForDuplicatedNames,
     dvoReturnNullForUnknownProperty,
     dvoValueCopiedByReference, dvoJSONParseDoNotTryCustomVariants,
     dvoJSONObjectParseWithinString, dvoSerializeAsExtendedJson,
     dvoAllowDoubleValue, dvoInternNames, dvoInternValues);

  /// set of options for a TDocVariant storage
  // - you can use JSON_OPTIONS[true] if you want to create a fast by-reference
  // local document as with _ObjFast/_ArrFast/_JsonFast - i.e.
  // [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]
  // - when specifying the options, you should not include dvoIsArray nor
  // dvoIsObject directly in the set, but explicitly define TDocVariantDataKind
  TDocVariantOptions = set of TDocVariantOption;

  /// pointer to a set of options for a TDocVariant storage
  // - you may use e.g. @JSON_OPTIONS[true], @JSON_OPTIONS[false],
  // @JSON_OPTIONS_FAST_STRICTJSON or @JSON_OPTIONS_FAST_EXTENDED
  PDocVariantOptions = ^TDocVariantOptions;

const
  /// some convenient TDocVariant options, as JSON_OPTIONS[CopiedByReference]
  // - JSON_OPTIONS[false] is e.g. _Json() and _JsonFmt() functions default
  // - JSON_OPTIONS[true] are used e.g. by _JsonFast() and _JsonFastFmt() functions
  JSON_OPTIONS: array[Boolean] of TDocVariantOptions = (
    [dvoReturnNullForUnknownProperty],
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference]);

  /// same as JSON_OPTIONS[true], but can not be used as PDocVariantOptions
  JSON_OPTIONS_FAST =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference];

  /// TDocVariant options which may be used for plain JSON parsing
  // - this won't recognize any extended syntax
  JSON_OPTIONS_FAST_STRICTJSON: TDocVariantOptions =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoJSONParseDoNotTryCustomVariants];

  /// TDocVariant options to be used for case-sensitive TSynNameValue-like
  // storage, with optional extended JSON syntax serialization
  // - consider using JSON_OPTIONS_FAST_EXTENDED for case-insensitive objects
  JSON_OPTIONS_NAMEVALUE: array[boolean] of TDocVariantOptions = (
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive],
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive,dvoSerializeAsExtendedJson]);

  /// TDocVariant options to be used for case-sensitive TSynNameValue-like
  // storage, RawUTF8 interning and optional extended JSON syntax serialization
  // - consider using JSON_OPTIONS_FAST_EXTENDED for case-insensitive objects,
  // or JSON_OPTIONS_NAMEVALUE[] if you don't expect names and values interning
  JSON_OPTIONS_NAMEVALUEINTERN: array[boolean] of TDocVariantOptions = (
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive,dvoInternNames,dvoInternValues],
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoNameCaseSensitive,dvoInternNames,dvoInternValues,
     dvoSerializeAsExtendedJson]);

  /// TDocVariant options to be used so that JSON serialization would
  // use the unquoted JSON syntax for field names
  // - you could use it e.g. on a TSQLRecord variant published field to
  // reduce the JSON escape process during storage in the database, by
  // customizing your TSQLModel instance:
  // !  (aModel.Props[TSQLMyRecord]['VariantProp'] as TSQLPropInfoRTTIVariant).
  // !    DocVariantOptions := JSON_OPTIONS_FAST_EXTENDED;
  // or - in a cleaner way - by overriding TSQLRecord.InternalDefineModel():
  // ! class procedure TSQLMyRecord.InternalDefineModel(Props: TSQLRecordProperties);
  // ! begin
  // !   (Props.Fields.ByName('VariantProp') as TSQLPropInfoRTTIVariant).
  // !     DocVariantOptions := JSON_OPTIONS_FAST_EXTENDED;
  // ! end;
  // or to set all variant fields at once:
  // ! class procedure TSQLMyRecord.InternalDefineModel(Props: TSQLRecordProperties);
  // ! begin
  // !   Props.SetVariantFieldsDocVariantOptions(JSON_OPTIONS_FAST_EXTENDED);
  // ! end;
  // - consider using JSON_OPTIONS_NAMEVALUE[true] for case-sensitive
  // TSynNameValue-like storage, or JSON_OPTIONS_FAST_EXTENDEDINTERN if you
  // expect RawUTF8 names and values interning
  JSON_OPTIONS_FAST_EXTENDED: TDocVariantOptions =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoSerializeAsExtendedJson];

  /// TDocVariant options for JSON serialization with efficient storage
  // - i.e. unquoted JSON syntax for field names and RawUTF8 interning
  // - may be used e.g. for efficient persistence of similar data
  // - consider using JSON_OPTIONS_FAST_EXTENDED if you don't expect
  // RawUTF8 names and values interning, or need BSON variants parsing
  JSON_OPTIONS_FAST_EXTENDEDINTERN: TDocVariantOptions =
    [dvoReturnNullForUnknownProperty,dvoValueCopiedByReference,
     dvoSerializeAsExtendedJson,dvoJSONParseDoNotTryCustomVariants,
     dvoInternNames,dvoInternValues];

/// same as Dest := Source, but copying by reference
// - i.e. VType is defined as varVariant or varByRef
// - for instance, it will be used for late binding of TDocVariant properties,
// to let following statements work as expected:
// ! V := _Json('{arr:[1,2]}');
// ! V.arr.Add(3);   // will work, since V.arr will be returned by reference
// ! writeln(V);     // will write '{"arr":[1,2,3]}'
procedure SetVariantByRef(const Source: Variant; var Dest: Variant);

/// same as Dest := Source, but copying by value
// - will unreference any varByRef content
// - will convert any string value into RawUTF8 (varString) for consistency
procedure SetVariantByValue(const Source: Variant; var Dest: Variant);

/// same as FillChar(Value^,SizeOf(TVarData),0)
// - so can be used for TVarData or Variant
// - it will set V.VType := varEmpty, so Value will be Unassigned
// - it won't call VarClear(variant(Value)): it should have been cleaned before
procedure ZeroFill(Value: PVarData);
  {$ifdef HASINLINE}inline;{$endif}

/// fill all bytes of the value's memory buffer with zeros, i.e. 'toto' -> #0#0#0#0
// - may be used to cleanup stack-allocated content
procedure FillZero(var value: variant); overload;

/// retrieve a variant value from variable-length buffer
// - matches TFileBufferWriter.Write()
// - how custom type variants are created can be defined via CustomVariantOptions
// - is just a wrapper around VariantLoad()
procedure FromVarVariant(var Source: PByte; var Value: variant;
  CustomVariantOptions: PDocVariantOptions=nil);
  {$ifdef HASINLINE}inline;{$endif}

/// compute the number of bytes needed to save a Variant content
// using the VariantSave() function
// - will return 0 in case of an invalid (not handled) Variant type
function VariantSaveLength(const Value: variant): integer;

/// save a Variant content into a destination memory buffer
// - Dest must be at least VariantSaveLength() bytes long
// - will handle standard Variant types and custom types (serialized as JSON)
// - will return nil in case of an invalid (not handled) Variant type
// - will use a proprietary binary format, with some variable-length encoding
// of the string length
// - warning: will encode generic string fields as within the variant type
// itself: using this function between UNICODE and NOT UNICODE
// versions of Delphi, will propably fail - you have been warned!
function VariantSave(const Value: variant; Dest: PAnsiChar): PAnsiChar; overload;

/// save a Variant content into a binary buffer
// - will handle standard Variant types and custom types (serialized as JSON)
// - will return '' in case of an invalid (not handled) Variant type
// - just a wrapper around VariantSaveLength()+VariantSave()
// - warning: will encode generic string fields as within the variant type
// itself: using this function between UNICODE and NOT UNICODE
// versions of Delphi, will propably fail - you have been warned!
function VariantSave(const Value: variant): RawByteString; overload;

/// retrieve a variant value from our optimized binary serialization format
// - follow the data layout as used by RecordLoad() or VariantSave() function
// - return nil if the Source buffer is incorrect
// - in case of success, return the memory buffer pointer just after the
// read content
// - how custom type variants are created can be defined via CustomVariantOptions
function VariantLoad(var Value: variant; Source: PAnsiChar;
  CustomVariantOptions: PDocVariantOptions): PAnsiChar; overload;

/// retrieve a variant value from our optimized binary serialization format
// - follow the data layout as used by RecordLoad() or VariantSave() function
// - return varEmpty if the Source buffer is incorrect
// - just a wrapper around VariantLoad()
// - how custom type variants are created can be defined via CustomVariantOptions
function VariantLoad(const Bin: RawByteString;
  CustomVariantOptions: PDocVariantOptions): variant; overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy or the overloaded functions with RawUTF8 parameter
// if you need to access it later
function VariantLoadJSON(var Value: variant; JSON: PUTF8Char;
  EndOfObject: PUTF8Char=nil; TryCustomVariants: PDocVariantOptions=nil;
  AllowDouble: boolean=false): PUTF8Char; overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - this overloaded procedure will make a temporary copy before JSON parsing
// and return the variant as result
procedure VariantLoadJSON(var Value: Variant; const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false); overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariant() format (calls GetVariantFromJSON)
// - will instantiate either an Integer, Int64, currency, double or string value
// (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except TryCustomVariants points to some options
// (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known object or
// array, either encoded as strict-JSON (i.e. {..} or [..]), or with some
// extended (e.g. BSON) syntax
// - this overloaded procedure will make a temporary copy before JSON parsing
// and return the variant as result
function VariantLoadJSON(const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false): variant; overload;

/// save a variant value into a JSON content
// - follows the TTextWriter.AddVariant() and VariantLoadJSON() format
// - is able to handle simple and custom variant types, for instance:
// !  VariantSaveJSON(1.5)='1.5'
// !  VariantSaveJSON('test')='"test"'
// !  o := _Json('{ BSON: [ "test", 5.05, 1986 ] }');
// !  VariantSaveJSON(o)='{"BSON":["test",5.05,1986]}'
// !  o := _Obj(['name','John','doc',_Obj(['one',1,'two',_Arr(['one',2])])]);
// !  VariantSaveJSON(o)='{"name":"John","doc":{"one":1,"two":["one",2]}}'
// - note that before Delphi 2009, any varString value is expected to be
// a RawUTF8 instance - which does make sense in the mORMot area
function VariantSaveJSON(const Value: variant; Escape: TTextWriterKind=twJSONEscape): RawUTF8; overload;

/// save a variant value into a JSON content
// - follows the TTextWriter.AddVariant() and VariantLoadJSON() format
// - is able to handle simple and custom variant types, for instance:
// !  VariantSaveJSON(1.5)='1.5'
// !  VariantSaveJSON('test')='"test"'
// !  o := _Json('{BSON: ["test", 5.05, 1986]}');
// !  VariantSaveJSON(o)='{"BSON":["test",5.05,1986]}'
// !  o := _Obj(['name','John','doc',_Obj(['one',1,'two',_Arr(['one',2])])]);
// !  VariantSaveJSON(o)='{"name":"John","doc":{"one":1,"two":["one",2]}}'
// - note that before Delphi 2009, any varString value is expected to be
// a RawUTF8 instance - which does make sense in the mORMot area
procedure VariantSaveJSON(const Value: variant; Escape: TTextWriterKind;
  var result: RawUTF8); overload;

/// compute the number of chars needed to save a variant value into a JSON content
// - follows the TTextWriter.AddVariant() and VariantLoadJSON() format
// - this will be much faster than length(VariantSaveJSON()) for huge content
// - note that before Delphi 2009, any varString value is expected to be
// a RawUTF8 instance - which does make sense in the mORMot area
function VariantSaveJSONLength(const Value: variant; Escape: TTextWriterKind=twJSONEscape): integer;

/// low-level function to set a variant from an unescaped JSON number or string
// - expect the JSON input buffer to be already unescaped, e.g. by GetJSONField()
// - is called e.g. by function VariantLoadJSON()
// - will instantiate either a null, boolean, Integer, Int64, currency, double
// (if AllowDouble is true or dvoAllowDoubleValue is in TryCustomVariants^) or
// string value (as RawUTF8), guessing the best numeric type according to the textual content,
// and string in all other cases, except if TryCustomVariants points to some
// options (e.g. @JSON_OPTIONS[true] for fast instance) and input is a known
// object or array, either encoded as strict-JSON (i.e. {..} or [..]),
// or with some extended (e.g. BSON) syntax
procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions=nil; AllowDouble: boolean=false);

/// low-level function to set a variant from an unescaped JSON non string
// - expect the JSON input buffer to be already unescaped, e.g. by GetJSONField(),
// and having returned wasString=TRUE (i.e. not surrounded by double quotes)
// - is called e.g. by function GetVariantFromJSON()
// - will recognize null, boolean, Integer, Int64, currency, double
// (if AllowDouble is true) input, then set Value and return TRUE
// - returns FALSE if the supplied input has no expected JSON format
function GetVariantFromNotStringJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowDouble: boolean): boolean;

/// identify either varInt64, varDouble, varCurrency types following JSON format
// - any non valid number is returned as varString
// - is used e.g. by GetVariantFromJSON() to guess the destination variant type
// - warning: supplied JSON is expected to be not nil
function TextToVariantNumberType(JSON: PUTF8Char): word;

/// identify either varInt64 or varCurrency types following JSON format
// - this version won't return varDouble, i.e. won't handle more than 4 exact
// decimals (as varCurrency), nor scientific notation with exponent (1.314e10)
// - this will ensure that any incoming JSON will converted back with its exact
// textual representation, without digit truncation due to limited precision
// - any non valid number is returned as varString
// - is used e.g. by GetVariantFromJSON() to guess the destination variant type
// - warning: supplied JSON is expected to be not nil
function TextToVariantNumberTypeNoDouble(JSON: PUTF8Char): word;

/// low-level function to set a numerical variant from an unescaped JSON number
// - returns TRUE if TextToVariantNumberType/TextToVariantNumberTypeNoDouble(JSON)
// identified it as a number and set Value to the corresponding content
// - returns FALSE if JSON is a string, or null/true/false
function GetNumericVariantFromJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowVarDouble: boolean): boolean;

/// convert the next CSV item from an UTF-8 encoded text buffer
// into a variant number or RawUTF8 varString
// - first try with GetNumericVariantFromJSON(), then fallback to RawUTF8ToVariant
// - is a wrapper around GetNextItem() + TextToVariant()
function GetNextItemToVariant(var P: PUTF8Char; out Value: Variant;
  Sep: AnsiChar= ','; AllowDouble: boolean=true): boolean;

/// convert an UTF-8 encoded text buffer into a variant number or RawUTF8 varString
// - first try with GetNumericVariantFromJSON(), then fallback to RawUTF8ToVariant
procedure TextToVariant(const aValue: RawUTF8; AllowVarDouble: boolean;
  out aDest: variant);

/// convert an UTF-8 encoded text buffer into a variant RawUTF8 varString
procedure RawUTF8ToVariant(Txt: PUTF8Char; TxtLen: integer; var Value: variant); overload;

/// convert an UTF-8 encoded string into a variant RawUTF8 varString
procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: variant); overload;

/// convert a FormatUTF8() UTF-8 encoded string into a variant RawUTF8 varString
procedure FormatUTF8ToVariant(const Fmt: RawUTF8; const Args: array of const; var Value: variant);

/// convert an UTF-8 encoded string into a variant RawUTF8 varString
function RawUTF8ToVariant(const Txt: RawUTF8): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an UTF-8 encoded text buffer into a variant RawUTF8 varString
// - this overloaded version expects a destination variant type (e.g. varString
// varOleStr / varUString) - if the type is not handled, will raise an
// EVariantTypeCastError
procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: TVarData;
  ExpectedValueType: word); overload;

/// convert an open array (const Args: array of const) argument to a variant
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
procedure VarRecToVariant(const V: TVarRec; var result: variant); overload;

/// convert an open array (const Args: array of const) argument to a variant
// - note that, due to a Delphi compiler limitation, cardinal values should be
// type-casted to Int64() (otherwise the integer mapped value will be converted)
function VarRecToVariant(const V: TVarRec): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a variant to an open array (const Args: array of const) argument
// - will always map to a vtVariant kind of argument
procedure VariantToVarRec(const V: variant; var result: TVarRec);
  {$ifdef HASINLINE}inline;{$endif}

/// convert a dynamic array of variants into its JSON serialization
// - will use a TDocVariantData temporary storage
function VariantDynArrayToJSON(const V: TVariantDynArray): RawUTF8;

/// convert a JSON array into a dynamic array of variants
// - will use a TDocVariantData temporary storage
function JSONToVariantDynArray(const JSON: RawUTF8): TVariantDynArray;

/// convert an open array list into a dynamic array of variants
// - will use a TDocVariantData temporary storage
function ValuesToVariantDynArray(const items: array of const): TVariantDynArray;

type
  /// pointer to a TDocVariant storage
  // - since variants may be stored by reference (i.e. as varByRef), it may
  // be a good idea to use such a pointer via DocVariantData(aVariant)^ or
  // _Safe(aVariant)^ instead of TDocVariantData(aVariant),
  // if you are not sure how aVariant was allocated (may be not _Obj/_Json)
  PDocVariantData = ^TDocVariantData;

  /// a custom variant type used to store any JSON/BSON document-based content
  // - i.e. name/value pairs for objects, or an array of values (including
  // nested documents), stored in a TDocVariantData memory structure
  // - you can use _Obj()/_ObjFast() _Arr()/_ArrFast() _Json()/_JsonFast() or
  // _JsonFmt()/_JsonFastFmt() functions to create instances of such variants
  // - property access may be done via late-binding - with some restrictions
  // for older versions of FPC, e.g. allowing to write:
  // ! TDocVariant.NewFast(aVariant);
  // ! aVariant.Name := 'John';
  // ! aVariant.Age := 35;
  // ! writeln(aVariant.Name,' is ',aVariant.Age,' years old');
  // - it also supports a small set of pseudo-properties or pseudo-methods:
  // ! aVariant._Count = DocVariantData(aVariant).Count
  // ! aVariant._Kind = ord(DocVariantData(aVariant).Kind)
  // ! aVariant._JSON = DocVariantData(aVariant).JSON
  // ! aVariant._(i) = DocVariantData(aVariant).Value[i]
  // ! aVariant.Value(i) = DocVariantData(aVariant).Value[i]
  // ! aVariant.Value(aName) = DocVariantData(aVariant).Value[aName]
  // ! aVariant.Name(i) = DocVariantData(aVariant).Name[i]
  // ! aVariant.Add(aItem) = DocVariantData(aVariant).AddItem(aItem)
  // ! aVariant._ := aItem = DocVariantData(aVariant).AddItem(aItem)
  // ! aVariant.Add(aName,aValue) = DocVariantData(aVariant).AddValue(aName,aValue)
  // ! aVariant.Exists(aName) = DocVariantData(aVariant).GetValueIndex(aName)>=0
  // ! aVariant.Delete(i) = DocVariantData(aVariant).Delete(i)
  // ! aVariant.Delete(aName) = DocVariantData(aVariant).Delete(aName)
  // ! aVariant.NameIndex(aName) = DocVariantData(aVariant).GetValueIndex(aName)
  // - it features direct JSON serialization/unserialization, e.g.:
  // ! assert(_Json('["one",2,3]')._JSON='["one",2,3]');
  // - it features direct trans-typing into a string encoded as JSON, e.g.:
  // ! assert(_Json('["one",2,3]')='["one",2,3]');
  TDocVariant = class(TSynInvokeableVariantType)
  protected
    fInternNames: TRawUTF8Interning;
    fInternValues: TRawUTF8Interning;
    /// fast getter/setter implementation
    procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
    procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
  public
    /// initialize a variant instance to store some document-based content
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set aOptions=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    class procedure New(out aValue: variant;
      aOptions: TDocVariantOptions=[]); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a variant instance to store per-reference document-based content
    // - same as New(aValue,JSON_OPTIONS[true]);
    // - to be used e.g. as
    // !var v: variant;
    // !begin
    // !  TDocVariant.NewFast(v);
    // !  ...
    class procedure NewFast(out aValue: variant); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// ensure a variant is a TDocVariant instance
    // - if aValue is not a TDocVariant, will create a new JSON_OPTIONS[true]
    class procedure IsOfTypeOrNewFast(var aValue: variant);
    /// initialize several variant instances to store document-based content
    // - replace several calls to TDocVariantData.InitFast
    // - to be used e.g. as
    // !var v1,v2,v3: TDocVariantData;
    // !begin
    // !  TDocVariant.NewFast([@v1,@v2,@v3]);
    // !  ...
    class procedure NewFast(const aValues: array of PDocVariantData); overload;
    /// initialize a variant instance to store some document-based content
    // - you can use this function to create a variant, which can be nested into
    // another document, e.g.:
    // ! aVariant := TDocVariant.New;
    // ! aVariant.id := 10;
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set Options=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    // - in practice, you should better use _Obj()/_ObjFast() _Arr()/_ArrFast()
    // functions or TDocVariant.NewFast()
    class function New(Options: TDocVariantOptions=[]): variant; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a variant instance to store some document-based object content
    // - object will be initialized with data supplied two by two, as Name,Value
    // pairs, e.g.
    // ! aVariant := TDocVariant.NewObject(['name','John','year',1972]);
    // which is the same as:
    // ! TDocVariant.New(aVariant);
    // ! TDocVariantData(aVariant).AddValue('name','John');
    // ! TDocVariantData(aVariant).AddValue('year',1972);
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set Options=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    // - in practice, you should better use the function _Obj() which is a
    // wrapper around this class method
    class function NewObject(const NameValuePairs: array of const;
      Options: TDocVariantOptions=[]): variant;
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied as parameters, e.g.
    // ! aVariant := TDocVariant.NewArray(['one',2,3.0]);
    // which is the same as:
    // ! TDocVariant.New(aVariant);
    // ! TDocVariantData(aVariant).AddItem('one');
    // ! TDocVariantData(aVariant).AddItem(2);
    // ! TDocVariantData(aVariant).AddItem(3.0);
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, set aOptions=[dvoValueCopiedByReference]
    // will increase the process speed a lot
    // - in practice, you should better use the function _Arr() which is a
    // wrapper around this class method
    class function NewArray(const Items: array of const;
      Options: TDocVariantOptions=[]): variant; overload;
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied dynamic array of variants
    class function NewArray(const Items: TVariantDynArray;
      Options: TDocVariantOptions=[]): variant; overload;
    /// initialize a variant instance to store some document-based object content
    // from a supplied (extended) JSON content
    // - in addition to the JSON RFC specification strict mode, this method will
    // handle some BSON-like extensions, e.g. unquoted field names
    // - a private copy of the incoming JSON buffer will be used, then
    // it will call the TDocVariantData.InitJSONInPlace() method
    // - to be used e.g. as:
    // ! var V: variant;
    // ! begin
    // !   V := TDocVariant.NewJSON('{"id":10,"doc":{"name":"John","birthyear":1972}}');
    // !   assert(V.id=10);
    // !   assert(V.doc.name='John');
    // !   assert(V.doc.birthYear=1972);
    // !   // and also some pseudo-properties:
    // !   assert(V._count=2);
    // !   assert(V.doc._kind=ord(dvObject));
    // - or with a JSON array:
    // !   V := TDocVariant.NewJSON('["one",2,3]');
    // !   assert(V._kind=ord(dvArray));
    // !   for i := 0 to V._count-1 do
    // !     writeln(V._(i));
    // - by default, every internal value will be copied, so access of nested
    // properties can be slow - if you expect the data to be read-only or not
    // propagated into another place, add dvoValueCopiedByReference in Options
    // will increase the process speed a lot
    // - in practice, you should better use the function _Json()/_JsonFast()
    // which are handy wrappers around this class method
    class function NewJSON(const JSON: RawUTF8;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize a variant instance to store some document-based object content
    // from a supplied existing TDocVariant instance
    // - use it on a value returned as varByRef (e.g. by _() pseudo-method),
    // to ensure the returned variant will behave as a stand-alone value
    // - for instance, the following:
    // !  oSeasons := TDocVariant.NewUnique(o.Seasons);
    // is the same as:
    // ! 	oSeasons := o.Seasons;
    // !  _Unique(oSeasons);
    // or even:
    // !  oSeasons := _Copy(o.Seasons);
    class function NewUnique(const SourceDocVariant: variant;
      Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant;
      {$ifdef HASINLINE}inline;{$endif}
    /// will return the unique element of a TDocVariant array or a default
    // - if the value is a dvArray with one single item, it will this value
    // - if the value is not a TDocVariant nor a dvArray with one single item,
    // it wil return the default value
    class procedure GetSingleOrDefault(const docVariantArray, default: variant;
      var result: variant);

    /// finalize the stored information
    destructor Destroy; override;
    /// used by dvoInternNames for string interning of all Names[] values
    function InternNames: TRawUTF8Interning;
      {$ifdef HASINLINE}inline;{$endif}
    /// used by dvoInternValues for string interning of all RawUTF8 Values[]
    function InternValues: TRawUTF8Interning;
      {$ifdef HASINLINE}inline;{$endif}
    // this implementation will write the content as JSON object or array
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;
    /// will check if the value is an array, and return the number of items
    // - if the document is an array, will return the items count (0 meaning
    // void array)
    // - this overridden method will implement it for dvArray instance kind
    function IterateCount(const V: TVarData): integer; override;
    /// allow to loop over an array value
    // - Index should be in 0..IterateCount-1 range
    // - this default implementation will do handle dvArray instance kind
    procedure Iterate(var Dest: TVarData; const V: TVarData; Index: integer); override;
    /// low-level callback to access internal pseudo-methods
    // - mainly the _(Index: integer): variant method to retrieve an item
    // if the document is an array
    function DoFunction(var Dest: TVarData; const V: TVarData;
      const Name: string; const Arguments: TVarDataArray): Boolean; override;
    /// low-level callback to clear the content
    procedure Clear(var V: TVarData); override;
    /// low-level callback to copy two variant content
    // - such copy will by default be done by-value, for safety
    // - if you are sure you will use the variants as read-only, you can set
    // the dvoValueCopiedByReference Option to use faster by-reference copy
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
    /// copy two variant content by value
    // - overridden method since instance may use a by-reference copy pattern
    procedure CopyByValue(var Dest: TVarData; const Source: TVarData); override;
    /// handle type conversion
    // - only types processed by now are string/OleStr/UnicodeString/date
    procedure Cast(var Dest: TVarData; const Source: TVarData); override;
    /// handle type conversion
    // - only types processed by now are string/OleStr/UnicodeString/date
    procedure CastTo(var Dest: TVarData; const Source: TVarData;
      const AVarType: TVarType); override;
    /// compare two variant values
    // - it uses case-sensitive text comparison of the JSON representation
    // of each variant (including TDocVariant instances)
    procedure Compare(const Left, Right: TVarData;
      var Relationship: TVarCompareResult); override;
  end;

  /// define the TDocVariant storage layout
  // - if it has one or more named properties, it is a dvObject
  // - if it has no name property, it is a dvArray
  TDocVariantKind = (dvUndefined, dvObject, dvArray);

  /// method used by TDocVariantData.ReduceAsArray to filter each object
  // - should return TRUE if the item match the expectations
  TOnReducePerItem = function(Item: PDocVariantData): boolean of object;

  /// method used by TDocVariantData.ReduceAsArray to filter each object
  // - should return TRUE if the item match the expectations
  TOnReducePerValue = function(const Value: variant): boolean of object;

  {$A-} { packet object not allowed since Delphi 2009 :( }
  /// memory structure used for TDocVariant storage of any JSON/BSON
  // document-based content as variant
  // - i.e. name/value pairs for objects, or an array of values (including
  // nested documents)
  // - you can use _Obj()/_ObjFast() _Arr()/_ArrFast() _Json()/_JsonFast() or
  // _JsonFmt()/_JsonFastFmt() functions to create instances of such variants
  // - you can transtype such an allocated variant into TDocVariantData
  // to access directly its internals (like Count or Values[]/Names[]):
  // ! aVariantObject := TDocVariant.NewObject(['name','John','year',1972]);
  // ! aVariantObject := _ObjFast(['name','John','year',1972]);
  // ! with TDocVariantData(aVariantObject) do
  // !   for i := 0 to Count-1 do
  // !     writeln(Names[i],'=',Values[i]); // for an object
  // ! aVariantArray := TDocVariant.NewArray(['one',2,3.0]);
  // ! aVariantArray := _JsonFast('["one",2,3.0]');
  // ! with TDocVariantData(aVariantArray) do
  // !   for i := 0 to Count-1 do
  // !     writeln(Values[i]); // for an array
  // here, using "with TDocVariantData(...) do" syntax can be very convenient
  // - since variants may be stored by reference (i.e. as varByRef), it may
  // be a good idea to use DocVariantData(aVariant)^ or _Safe(aVariant)^ instead
  // of TDocVariantData(aVariant), if you are not sure how aVariant was allocated
  // (may be not _Obj/_Json, but retrieved as varByRef e.g. from late binding)
  {$ifdef FPC_OR_UNICODE}TDocVariantData = record private
  {$else}TDocVariantData = object protected{$endif}
    VType: TVarType;
    VOptions: TDocVariantOptions;
    (* this structure uses all TVarData available space: no filler needed!
    {$HINTS OFF} // does not complain if Filler is declared but never used
    Filler: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(TDocVariantOptions)-
      SizeOf(TDocVariantKind)-SizeOf(TRawUTF8DynArray)-SizeOf(TVariantDynArray)-
      SizeOf(integer)] of byte;
    {$HINTS ON} *)
    VName: TRawUTF8DynArray;
    VValue: TVariantDynArray;
    VCount: integer;
    // retrieve the value as varByRef
    function GetValueOrItem(const aNameOrIndex: variant): variant;
    procedure SetValueOrItem(const aNameOrIndex, aValue: variant);
    function GetKind: TDocVariantKind;
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetOptions(const opt: TDocVariantOptions); // keep dvoIsObject/Array
      {$ifdef HASINLINE}inline;{$endif}
    procedure SetCapacity(aValue: integer);
    function GetCapacity: integer;
      {$ifdef HASINLINE}inline;{$endif}
    // implement U[] I[] B[] D[] O[] O_[] A[] A_[] _[] properties
    function GetOrAddIndexByName(const aName: RawUTF8): integer;
      {$ifdef HASINLINE}inline;{$endif}
    function GetOrAddPVariantByName(const aName: RawUTF8): PVariant;
      {$ifdef HASINLINE}inline;{$endif}
    function GetPVariantByName(const aName: RawUTF8): PVariant;
    function GetRawUTF8ByName(const aName: RawUTF8): RawUTF8;
    procedure SetRawUTF8ByName(const aName, aValue: RawUTF8);
    function GetStringByName(const aName: RawUTF8): string;
    procedure SetStringByName(const aName: RawUTF8; const aValue: string);
    function GetInt64ByName(const aName: RawUTF8): Int64;
    procedure SetInt64ByName(const aName: RawUTF8; const aValue: Int64);
    function GetBooleanByName(const aName: RawUTF8): Boolean;
    procedure SetBooleanByName(const aName: RawUTF8; aValue: Boolean);
    function GetDoubleByName(const aName: RawUTF8): Double;
    procedure SetDoubleByName(const aName: RawUTF8; const aValue: Double);
    function GetDocVariantExistingByName(const aName: RawUTF8;
      aNotMatchingKind: TDocVariantKind): PDocVariantData;
    function GetObjectExistingByName(const aName: RawUTF8): PDocVariantData;
    function GetDocVariantOrAddByName(const aName: RawUTF8;
      aKind: TDocVariantKind): PDocVariantData;
    function GetObjectOrAddByName(const aName: RawUTF8): PDocVariantData;
    function GetArrayExistingByName(const aName: RawUTF8): PDocVariantData;
    function GetArrayOrAddByName(const aName: RawUTF8): PDocVariantData;
    function GetAsDocVariantByIndex(aIndex: integer): PDocVariantData;
  public
    /// initialize a TDocVariantData to store some document-based content
    // - can be used with a stack-allocated TDocVariantData variable:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.Init;
    // !  Doc.AddValue('name','John');
    // !  assert(Doc.Value['name']='John');
    // !  assert(variant(Doc).name='John');
    // !end;
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure Init(aOptions: TDocVariantOptions=[]; aKind: TDocVariantKind=dvUndefined);
    /// initialize a TDocVariantData to store per-reference document-based content
    // - same as Doc.Init(JSON_OPTIONS[true]);
    // - can be used with a stack-allocated TDocVariantData variable:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitFast;
    // !  Doc.AddValue('name','John');
    // !  assert(Doc.Value['name']='John');
    // !  assert(variant(Doc).name='John');
    // !end;
    // - see also TDocVariant.NewFast() if you want to initialize several
    // TDocVariantData variable instances at once
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitFast; overload;
    /// initialize a TDocVariantData to store per-reference document-based content
    // - this overloaded method allows to specify an estimation of how many
    // properties or items this aKind document would contain
    procedure InitFast(InitialCapacity: integer; aKind: TDocVariantKind); overload;
    /// initialize a TDocVariantData to store document-based object content
    // - object will be initialized with data supplied two by two, as Name,Value
    // pairs, e.g.
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitObject(['name','John','year',1972]);
    // which is the same as:
    // ! var Doc: TDocVariantData;
    // !begin
    // !  Doc.Init;
    // !  Doc.AddValue('name','John');
    // !  Doc.AddValue('year',1972);
    // - this method is called e.g. by _Obj() and _ObjFast() global functions
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitObject(const NameValuePairs: array of const;
      aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied as parameters, e.g.
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitArray(['one',2,3.0]);
    // !  assert(Doc.Count=3);
    // !end;
    // which is the same as:
    // ! var Doc: TDocVariantData;
    // !     i: integer;
    // !begin
    // !  Doc.Init;
    // !  Doc.AddItem('one');
    // !  Doc.AddItem(2);
    // !  Doc.AddItem(3.0);
    // !  assert(Doc.Count=3);
    // !  for i := 0 to Doc.Count-1 do
    // !    writeln(Doc.Value[i]);
    // !end;
    // - this method is called e.g. by _Arr() and _ArrFast() global functions
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitArray(const Items: array of const;
      aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store some document-based array content
    // - array will be initialized with data supplied as variant dynamic array
    // - if Items is [], the variant will be set as null
    // - will be almost immediate, since TVariantDynArray is reference-counted,
    // unless ItemsCopiedByReference is set to FALSE
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitArrayFromVariants(const Items: TVariantDynArray;
      aOptions: TDocVariantOptions=[]; ItemsCopiedByReference: boolean=true);
    /// initialize a variant instance to store some RawUTF8 array content
    procedure InitArrayFrom(const Items: TRawUTF8DynArray; aOptions: TDocVariantOptions); overload;
    /// initialize a variant instance to store some 32-bit integer array content
    procedure InitArrayFrom(const Items: TIntegerDynArray; aOptions: TDocVariantOptions); overload;
    /// initialize a variant instance to store some 64-bit integer array content
    procedure InitArrayFrom(const Items: TInt64DynArray; aOptions: TDocVariantOptions); overload;
    /// initialize a variant instance to store a T*ObjArray content
    // - will call internally ObjectToVariant() to make the conversion
    procedure InitArrayFromObjArray(const ObjArray; aOptions: TDocVariantOptions;
      aWriterOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]);
    /// initialize a variant instance to store document-based array content
    // - array will be initialized from the supplied variable (which would be
    // e.g. a T*ObjArray or a dynamic array), using RTTI
    // - will use a temporary JSON serialization via SaveJSON()
    procedure InitFromTypeInfo(const aValue; aTypeInfo: pointer;
      aEnumSetsAsText: boolean; aOptions: TDocVariantOptions);
    /// initialize a variant instance to store some document-based object content
    // - object will be initialized with names and values supplied as dynamic arrays
    // - if aNames and aValues are [] or do have matching sizes, the variant
    // will be set as null
    // - will be almost immediate, since Names and Values are reference-counted
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitObjectFromVariants(const aNames: TRawUTF8DynArray;
       const aValues: TVariantDynArray; aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store a document-based object with a
    // single property
    // - the supplied path could be 'Main.Second.Third', to create nested
    // objects, e.g. {"Main":{"Second":{"Third":value}}}
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitObjectFromPath(const aPath: RawUTF8; const aValue: variant;
      aOptions: TDocVariantOptions=[]);
    /// initialize a variant instance to store some document-based object content
    // from a supplied JSON array or JSON object content
    // - warning: the incoming JSON buffer will be modified in-place: so you should
    // make a private copy before running this method, e.g. using TSynTempBuffer
    // - this method is called e.g. by _JsonFmt() _JsonFastFmt() global functions
    // with a temporary JSON buffer content created from a set of parameters
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    function InitJSONInPlace(JSON: PUTF8Char;
      aOptions: TDocVariantOptions=[]; aEndOfObject: PUTF8Char=nil): PUTF8Char;
    /// initialize a variant instance to store some document-based object content
    // from a supplied JSON array of JSON object content
    // - a private copy of the incoming JSON buffer will be used, then
    // it will call the other overloaded InitJSONInPlace() method
    // - this method is called e.g. by _Json() and _JsonFast() global functions
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    function InitJSON(const JSON: RawUTF8; aOptions: TDocVariantOptions=[]): boolean;
    /// initialize a variant instance to store some document-based object content
    // from a JSON array of JSON object content, stored in a file
    // - any kind of file encoding will be handled, via AnyTextFileToRawUTF8()
    // - you can optionally remove any comment from the file content
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    function InitJSONFromFile(const JsonFile: TFileName; aOptions: TDocVariantOptions=[];
      RemoveComments: boolean=false): boolean;
    /// ensure a document-based variant instance will have one unique options set
    // - this will create a copy of the supplied TDocVariant instance, forcing
    // all nested events to have the same set of Options
    // - you can use this function to ensure that all internal properties of this
    // variant will be copied e.g. per-reference (if you set JSON_OPTIONS[false])
    // or per-value (if you set JSON_OPTIONS[false]) whatever options the nested
    // objects or arrays were created with
    // - will raise an EDocVariant if the supplied variant is not a TDocVariant
    // - you may rather use _Unique() or _UniqueFast() wrappers if you want to
    // ensure that a TDocVariant instance is unique
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCopy(const SourceDocVariant: variant; aOptions: TDocVariantOptions);
    /// initialize a variant instance to store some document-based object content
    // from a supplied CSV UTF-8 encoded text
    // - the supplied content may have been generated by ToTextPairs() method
    // - if ItemSep=#10, then any kind of line feed (CRLF or LF) will be handled
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCSV(CSV: PUTF8Char; aOptions: TDocVariantOptions;
      NameValueSep: AnsiChar='='; ItemSep: AnsiChar=#10; DoTrim: boolean=true); overload;
    /// initialize a variant instance to store some document-based object content
    // from a supplied CSV UTF-8 encoded text
    // - the supplied content may have been generated by ToTextPairs() method
    // - if ItemSep=#10, then any kind of line feed (CRLF or LF) will be handled
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCSV(const CSV: RawUTF8; aOptions: TDocVariantOptions;
      NameValueSep: AnsiChar='='; ItemSep: AnsiChar=#10; DoTrim: boolean=true); overload;
      {$ifdef HASINLINE}inline;{$endif}

    /// to be called before any Init*() method call, when a previous Init*()
    // has already be performed on the same instance, to avoid memory leaks
    // - for instance:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitArray(['one',2,3.0]); // no need of any Doc.Clear here
    // !  assert(Doc.Count=3);
    // !  Doc.Clear; // to release memory before following InitObject()
    // !  Doc.InitObject(['name','John','year',1972]);
    // !end;
    // - implemented as just a wrapper around DocVariantType.Clear()
    procedure Clear;
    /// delete all internal stored values
    // - like Clear + Init() with the same options
    // - will reset Kind to dvUndefined
    procedure Reset;
    /// fill all Values[] with #0, then delete all values
    // - could be used to specifically remove sensitive information from memory
    procedure FillZero;
    /// low-level method to force a number of items
    // - could be used to fast add items to the internal Values[]/Names[] arrays
    // - just set protected VCount field, do not resize the arrays: caller
    // should ensure that Capacity is big enough
    procedure SetCount(aCount: integer); {$ifdef HASINLINE}inline;{$endif}
    /// low-level method called internally to reserve place for new values
    // - returns the index of the newly created item in Values[]/Names[] arrays
    // - you should not have to use it, unless you want to add some items
    // directly within the Values[]/Names[] arrays, using e.g.
    // InitFast(InitialCapacity) to initialize the document
    // - if aName='', append a dvArray item, otherwise append a dvObject field
    function InternalAdd(const aName: RawUTF8): integer;

    /// save a document as UTF-8 encoded JSON
    // - will write either a JSON object or array, depending of the internal
    // layout of this instance (i.e. Kind property value)
    // - will write  'null'  if Kind is dvUndefined
    // - implemented as just a wrapper around VariantSaveJSON()
    function ToJSON(const Prefix: RawUTF8=''; const Suffix: RawUTF8='';
      Format: TTextWriterJSONFormat=jsonCompact): RawUTF8;
    /// save an array of objects as UTF-8 encoded non expanded layout JSON
    // - returned content would be a JSON object in mORMot's TSQLTable non
    // expanded format, with reduced JSON size, i.e.
    // $ {"fieldCount":3,"values":["ID","FirstName","LastName",...']}
    // - will write '' if Kind is dvUndefined or dvObject
    // - will raise an exception if the array document is not an array of
    // objects with identical field names
    function ToNonExpandedJSON: RawUTF8;
    /// save a document as an array of UTF-8 encoded JSON
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - will use VariantToUTF8() to populate the result array: as a consequence,
    // any nested custom variant types (e.g. TDocVariant) will be stored as JSON
    procedure ToRawUTF8DynArray(out Result: TRawUTF8DynArray); overload;
    /// save a document as an array of UTF-8 encoded JSON
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - will use VariantToUTF8() to populate the result array: as a consequence,
    // any nested custom variant types (e.g. TDocVariant) will be stored as JSON
    function ToRawUTF8DynArray: TRawUTF8DynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// save a document as an CSV of UTF-8 encoded JSON
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - will use VariantToUTF8() to populate the result array: as a consequence,
    // any nested custom variant types (e.g. TDocVariant) will be stored as JSON
    function ToCSV(const Separator: RawUTF8=','): RawUTF8;
    /// save a document as UTF-8 encoded Name=Value pairs
    // - will follow by default the .INI format, but you can specify your
    // own expected layout
    procedure ToTextPairsVar(out result: RawUTF8; const NameValueSep: RawUTF8='=';
      const ItemSep: RawUTF8=#13#10; Escape: TTextWriterKind=twJSONEscape);
    /// save a document as UTF-8 encoded Name=Value pairs
    // - will follow by default the .INI format, but you can specify your
    // own expected layout
    function ToTextPairs(const NameValueSep: RawUTF8='=';
      const ItemSep: RawUTF8=#13#10; Escape: TTextWriterKind=twJSONEscape): RawUTF8;
      {$ifdef HASINLINE}inline;{$endif}
    /// save an array document as an array of TVarRec, i.e. an array of const
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - would allow to write code as such:
    // !  Doc.InitArray(['one',2,3]);
    // !  Doc.ToArrayOfConst(vr);
    // !  s := FormatUTF8('[%,%,%]',vr,[],true);
    // !  // here s='[one,2,3]') since % would be replaced by Args[] parameters
    // !  s := FormatUTF8('[?,?,?]',[],vr,true);
    // !  // here s='["one",2,3]') since ? would be escaped by Params[] parameters
    procedure ToArrayOfConst(out Result: TTVarRecDynArray); overload;
    /// save an array document as an array of TVarRec, i.e. an array of const
    // - will expect the document to be a dvArray - otherwise, will raise a
    // EDocVariant exception
    // - would allow to write code as such:
    // !  Doc.InitArray(['one',2,3]);
    // !  s := FormatUTF8('[%,%,%]',Doc.ToArrayOfConst,[],true);
    // !  // here s='[one,2,3]') since % would be replaced by Args[] parameters
    // !  s := FormatUTF8('[?,?,?]',[],Doc.ToArrayOfConst,true);
    // !  // here s='["one",2,3]') since ? would be escaped by Params[] parameters
    function ToArrayOfConst: TTVarRecDynArray; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// save an object document as an URI-encoded list of parameters
    // - object field names should be plain ASCII-7 RFC compatible identifiers
    // (0..9a..zA..Z_.~), otherwise their values are skipped
    function ToUrlEncode(const UriRoot: RawUTF8): RawUTF8;

    /// find an item index in this document from its name
    // - search will follow dvoNameCaseSensitive option of this document
    // - returns -1 if not found
    function GetValueIndex(const aName: RawUTF8): integer; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item index in this document from its name
    // - returns -1 if not found
    function GetValueIndex(aName: PUTF8Char; aNameLen: PtrInt; aCaseSensitive: boolean): integer; overload;
    /// find an item in this document, and returns its value
    // - raise an EDocVariant if not found and dvoReturnNullForUnknownProperty
    // is not set in Options (in this case, it will return Null)
    function GetValueOrRaiseException(const aName: RawUTF8): variant;
    /// find an item in this document, and returns its value
    // - return the supplied default if aName is not found, or if the instance
    // is not a TDocVariant
    function GetValueOrDefault(const aName: RawUTF8; const aDefault: variant): variant;
    /// find an item in this document, and returns its value
    // - return null if aName is not found, or if the instance is not a TDocVariant
    function GetValueOrNull(const aName: RawUTF8): variant;
    /// find an item in this document, and returns its value
    // - return a cleared variant if aName is not found, or if the instance is
    // not a TDocVariant
    function GetValueOrEmpty(const aName: RawUTF8): variant;
    /// find an item in this document, and returns its value as enumerate
    // - return false if aName is not found, if the instance is not a TDocVariant,
    // or if the value is not a string corresponding to the supplied enumerate
    // - return true if the name has been found, and aValue stores the value
    // - will call Delete() on the found entry, if aDeleteFoundEntry is true
    function GetValueEnumerate(const aName: RawUTF8; aTypeInfo: pointer;
      out aValue; aDeleteFoundEntry: boolean=false): Boolean;
    /// returns a TDocVariant object containing all properties matching the
    // first characters of the supplied property name
    // - returns null if the document is not a dvObject
    // - will use IdemPChar(), so search would be case-insensitive
    function GetValuesByStartName(const aStartName: RawUTF8;
      TrimLeftStartName: boolean=false): variant;
    /// returns a JSON object containing all properties matching the
    // first characters of the supplied property name
    // - returns null if the document is not a dvObject
    // - will use IdemPChar(), so search would be case-insensitive
    function GetJsonByStartName(const aStartName: RawUTF8): RawUTF8;
    /// find an item in this document, and returns its value as TVarData
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - will use simple loop lookup to identify the name, unless aSortedCompare is
    // set, and would let use a faster O(log(n)) binary search after a SortByName()
    function GetVarData(const aName: RawUTF8; var aValue: TVarData;
      aSortedCompare: TUTF8Compare=nil): boolean; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// find an item in this document, and returns its value as TVarData pointer
    // - return nil if aName is not found, or if the instance is not a TDocVariant
    // - return a pointer to the value if the name has been found
    // - after a SortByName(aSortedCompare), would use faster binary search
    function GetVarData(const aName: RawUTF8;
      aSortedCompare: TUTF8Compare=nil): PVarData; overload;
    /// find an item in this document, and returns its value as boolean
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    // - consider using B[] property if you want simple read/write typed access
    function GetAsBoolean(const aName: RawUTF8; out aValue: boolean;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as integer
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    // - consider using I[] property if you want simple read/write typed access
    function GetAsInteger(const aName: RawUTF8; out aValue: integer;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as integer
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    // - consider using I[] property if you want simple read/write typed access
    function GetAsInt64(const aName: RawUTF8; out aValue: Int64;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as floating point
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    // - consider using D[] property if you want simple read/write typed access
    function GetAsDouble(const aName: RawUTF8; out aValue: double;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as RawUTF8
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found, and aValue stores the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    // - consider using U[] property if you want simple read/write typed access
    function GetAsRawUTF8(const aName: RawUTF8; out aValue: RawUTF8;
      aSortedCompare: TUTF8Compare=nil): Boolean;
    /// find an item in this document, and returns its value as a TDocVariantData
    // - return false if aName is not found, or if the instance is not a TDocVariant
    // - return true if the name has been found and points to a TDocVariant:
    // then aValue stores a pointer to the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    function GetAsDocVariant(const aName: RawUTF8; out aValue: PDocVariantData;
      aSortedCompare: TUTF8Compare=nil): boolean; overload;
    /// find an item in this document, and returns its value as a TDocVariantData
    // - returns a void TDocVariant if aName is not a document
    // - after a SortByName(aSortedCompare), would use faster binary search
    // - consider using O[] or A[] properties if you want simple read-only
    // access, or O_[] or A_[] properties if you want the ability to add
    // a missing object or array in the document
    function GetAsDocVariantSafe(const aName: RawUTF8;
      aSortedCompare: TUTF8Compare=nil): PDocVariantData;
    /// find an item in this document, and returns pointer to its value
    // - return false if aName is not found
    // - return true if the name has been found: then aValue stores a pointer
    // to the value
    // - after a SortByName(aSortedCompare), would use faster binary search
    function GetAsPVariant(const aName: RawUTF8; out aValue: PVariant;
      aSortedCompare: TUTF8Compare=nil): boolean;
    /// retrieve a value, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - it will return Unassigned if the path does match the supplied aPath
    function GetValueByPath(const aPath: RawUTF8): variant; overload;
    /// retrieve a value, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - it will return FALSE if the path does not match the supplied aPath
    // - returns TRUE and set the found value in aValue
    function GetValueByPath(const aPath: RawUTF8; out aValue: variant): boolean; overload;
    /// retrieve a value, given its path
    // - path is defined as a list of names, e.g. ['doc','glossary','title']
    // - it will return Unassigned if the path does not match the data
    // - this method will only handle nested TDocVariant values: use the
    // slightly slower GetValueByPath() overloaded method, if any nested object
    // may be of another type (e.g. a TBSONVariant)
    function GetValueByPath(const aDocVariantPath: array of RawUTF8): variant; overload;
    /// retrieve a reference to a value, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - if the supplied aPath does not match any object, it will return nil
    // - if aPath is found, returns a pointer to the corresponding value
    function GetPVariantByPath(const aPath: RawUTF8): PVariant;
    /// retrieve a reference to a TDocVariant, given its path
    // - path is defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - if the supplied aPath does not match any object, it will return false
    // - if aPath stores a valid TDocVariant, returns true and a pointer to it
    function GetDocVariantByPath(const aPath: RawUTF8; out aValue: PDocVariantData): boolean;
    /// retrieve a dvObject in the dvArray, from a property value
    // - {aPropName:aPropValue} will be searched within the stored array,
    // and the corresponding item will be copied into Dest, on match
    // - returns FALSE if no match is found, TRUE if found and copied
    // - create a copy of the variant by default, unless DestByRef is TRUE
    // - will call VariantEquals() for value comparison
    function GetItemByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean; var Dest: variant; DestByRef: boolean=false): boolean;
    /// retrieve a reference to a dvObject in the dvArray, from a property value
    // - {aPropName:aPropValue} will be searched within the stored array,
    // and the corresponding item will be copied into Dest, on match
    // - returns FALSE if no match is found, TRUE if found and copied by reference
    function GetDocVariantByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean; out Dest: PDocVariantData): boolean;
    /// find an item in this document, and returns its value
    // - raise an EDocVariant if not found and dvoReturnNullForUnknownProperty
    // is not set in Options (in this case, it will return Null)
    // - create a copy of the variant by default, unless DestByRef is TRUE
    procedure RetrieveValueOrRaiseException(aName: PUTF8Char; aNameLen: integer;
      aCaseSensitive: boolean; var Dest: variant; DestByRef: boolean); overload;
    /// retrieve an item in this document from its index, and returns its value
    // - raise an EDocVariant if the supplied Index is not in the 0..Count-1
    // range and dvoReturnNullForUnknownProperty is set in Options
    // - create a copy of the variant by default, unless DestByRef is TRUE
    procedure RetrieveValueOrRaiseException(Index: integer;
     var Dest: variant; DestByRef: boolean); overload;
    /// retrieve an item in this document from its index, and returns its Name
    // - raise an EDocVariant if the supplied Index is not in the 0..Count-1
    // range and dvoReturnNullForUnknownProperty is set in Options
    procedure RetrieveNameOrRaiseException(Index: integer; var Dest: RawUTF8);
    /// set an item in this document from its index
    // - raise an EDocVariant if the supplied Index is not in 0..Count-1 range
    procedure SetValueOrRaiseException(Index: integer; const NewValue: variant);

    /// add a value in this document
    // - if aName is set, if dvoCheckForDuplicatedNames option is set, any
    // existing duplicated aName will raise an EDocVariant; if instance's
    // kind is dvArray and aName is defined, it will raise an EDocVariant
    // - aName may be '' e.g. if you want to store an array: in this case,
    // dvoCheckForDuplicatedNames option should not be set; if instance's Kind
    // is dvObject, it will raise an EDocVariant exception
    // - you can therefore write e.g.:
    // ! TDocVariant.New(aVariant);
    // ! Assert(TDocVariantData(aVariant).Kind=dvUndefined);
    // ! TDocVariantData(aVariant).AddValue('name','John');
    // ! Assert(TDocVariantData(aVariant).Kind=dvObject);
    // - returns the index of the corresponding newly added value
    function AddValue(const aName: RawUTF8; const aValue: variant): integer; overload;
    /// add a value in this document
    // - overloaded function accepting a UTF-8 encoded buffer for the name
    function AddValue(aName: PUTF8Char; aNameLen: integer; const aValue: variant): integer; overload;
    /// add a value in this document, or update an existing entry
    // - if instance's Kind is dvArray, it will raise an EDocVariant exception
    // - any existing Name would be updated with the new Value, unless
    // OnlyAddMissing is set to TRUE, in which case existing values would remain
    // - returns the index of the corresponding value, which may be just added
    function AddOrUpdateValue(const aName: RawUTF8; const aValue: variant;
      wasAdded: PBoolean=nil; OnlyAddMissing: boolean=false): integer;
    /// add a value in this document, from its text representation
    // - this function expects a UTF-8 text for the value, which would be
    // converted to a variant number, if possible (as varInt/varInt64/varCurrency
    // and/or as varDouble is AllowVarDouble is set)
    // - if Update=TRUE, will set the property, even if it is existing
    function AddValueFromText(const aName,aValue: RawUTF8; Update: boolean=false;
      AllowVarDouble: boolean=false): integer;
    /// add some properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that Kind=dvObject, otherwise it won't do anything
    // - any existing Name would be duplicated
    procedure AddNameValuesToObject(const NameValuePairs: array of const);
    /// merge some properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that Kind=dvObject, otherwise it won't do anything
    // - any existing Name would be updated with the new Value
    procedure AddOrUpdateNameValuesToObject(const NameValuePairs: array of const);
    /// merge some TDocVariantData dvObject properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that both variants have Kind=dvObject, otherwise
    // it won't do anything
    // - any existing Name would be updated with the new Value, unless
    // OnlyAddMissing is set to TRUE, in which case existing values would remain
    procedure AddOrUpdateObject(const NewValues: variant; OnlyAddMissing: boolean=false;
      RecursiveUpdate: boolean=false);
    /// add a value to this document, handled as array
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    // - you can therefore write e.g.:
    // ! TDocVariant.New(aVariant);
    // ! Assert(TDocVariantData(aVariant).Kind=dvUndefined);
    // ! TDocVariantData(aVariant).AddItem('one');
    // ! Assert(TDocVariantData(aVariant).Kind=dvArray);
    // - returns the index of the corresponding newly added item
    function AddItem(const aValue: variant): integer;
    /// add a value to this document, handled as array, from its text representation
    // - this function expects a UTF-8 text for the value, which would be
    // converted to a variant number, if possible (as varInt/varInt64/varCurrency
    // unless AllowVarDouble is set)
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    // - returns the index of the corresponding newly added item
    function AddItemFromText(const aValue: RawUTF8;
      AllowVarDouble: boolean=false): integer;
    /// add a RawUTF8 value to this document, handled as array
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    // - returns the index of the corresponding newly added item
    function AddItemText(const aValue: RawUTF8): integer;
    /// add one or several values to this document, handled as array
    // - if instance's Kind is dvObject, it will raise an EDocVariant exception
    procedure AddItems(const aValue: array of const);
    /// add one or several values from another document
    // - supplied document should be of the same kind than the current one,
    // otherwise nothing is added
    procedure AddFrom(const aDocVariant: Variant);
    /// add or update or on several valeus from another object
    // - current document should be an object
    procedure AddOrUpdateFrom(const aDocVariant: Variant; aOnlyAddMissing: boolean=false);
    /// add one or several properties, specified by path, from another object
    // - path are defined as a dotted name-space, e.g. 'doc.glossary.title'
    // - matching values would be added as root values, with the path as name
    // - instance and supplied aSource should be a dvObject
    procedure AddByPath(const aSource: TDocVariantData; const aPaths: array of RawUTF8);
    /// delete a value/item in this document, from its index
    // - return TRUE on success, FALSE if the supplied index is not correct
    function Delete(Index: integer): boolean; overload;
    /// delete a value/item in this document, from its name
    // - return TRUE on success, FALSE if the supplied name does not exist
    function Delete(const aName: RawUTF8): boolean; overload;
    /// delete a value in this document, by property name match
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item will be deleted, on match
    // - returns FALSE if no match is found, TRUE if found and deleted
    // - will call VariantEquals() for value comparison
    function DeleteByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean): boolean;
    /// delete one or several value/item in this document, from its value
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - if the value exists several times, all occurences would be removed
    // - is optimized for DeleteByValue(null) call
    function DeleteByValue(const aValue: Variant; CaseInsensitive: boolean=false): integer;
    /// delete all values matching the first characters of a property name
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - will use IdemPChar(), so search would be case-insensitive
    function DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
    /// search a property match in this document, handled as array or object
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    // - will call VariantEquals() for value comparison
    function SearchItemByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean): integer; overload;
    /// search a property match in this document, handled as array or object
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    // - will call VariantEquals() for value comparison
    function SearchItemByProp(const aPropNameFmt: RawUTF8; const aPropNameArgs: array of const;
      const aPropValue: RawUTF8; aPropValueCaseSensitive: boolean): integer; overload;
    /// search a value in this document, handled as array
    // - aValue will be searched within the stored array
    // and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    // - you could make several searches, using the StartIndex optional parameter
    function SearchItemByValue(const aValue: Variant;
      CaseInsensitive: boolean=false; StartIndex: integer=0): integer;
    /// sort the document object values by name
    // - do nothing if the document is not a dvObject
    // - will follow case-insensitive order (@StrIComp) by default, but you
    // can specify @StrComp as comparer function for case-sensitive ordering
    // - once sorted, you can use GetVarData(..,Compare) or GetAs*(..,Compare)
    // methods for much faster O(log(n)) binary search
    procedure SortByName(Compare: TUTF8Compare=nil);
    /// sort the document object values by value
    // - work for both dvObject and dvArray documents
    // - will sort by UTF-8 text (VariantCompare) if no custom aCompare is supplied
    procedure SortByValue(Compare: TVariantCompare = nil);
    /// sort the document array values by a field of some stored objet values
    // - do nothing if the document is not a dvArray, or if the items are no dvObject
    // - will sort by UTF-8 text (VariantCompare) if no custom aValueCompare is supplied
    procedure SortArrayByField(const aItemPropName: RawUTF8;
      aValueCompare: TVariantCompare=nil; aValueCompareReverse: boolean=false;
      aNameSortedCompare: TUTF8Compare=nil);
    /// reverse the order of the document object or array items
    procedure Reverse;
    /// create a TDocVariant object, from a selection of properties of this
    // document, by property name
    // - if the document is a dvObject, to reduction will be applied to all
    // its properties
    // - if the document is a dvArray, the reduction will be applied to each
    // stored item, if it is a document
    procedure Reduce(const aPropNames: array of RawUTF8; aCaseSensitive: boolean;
      out result: TDocVariantData; aDoNotAddVoidProp: boolean=false); overload;
    /// create a TDocVariant object, from a selection of properties of this
    // document, by property name
    // - always returns a TDocVariantData, even if no property name did match
    // (in this case, it is dvUndefined)
    function Reduce(const aPropNames: array of RawUTF8; aCaseSensitive: boolean;
      aDoNotAddVoidProp: boolean=false): variant; overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - you can optionally apply an additional filter to each reduced item
    procedure ReduceAsArray(const aPropName: RawUTF8; out result: TDocVariantData;
      OnReduce: TOnReducePerItem=nil); overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - always returns a TDocVariantData, even if no property name did match
    // (in this case, it is dvUndefined)
    // - you can optionally apply an additional filter to each reduced item
    function ReduceAsArray(const aPropName: RawUTF8; OnReduce: TOnReducePerItem=nil): variant; overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - this overloaded method accepts an additional filter to each reduced item
    procedure ReduceAsArray(const aPropName: RawUTF8; out result: TDocVariantData;
      OnReduce: TOnReducePerValue); overload;
    /// create a TDocVariant array, from the values of a single properties of
    // this document, specified by name
    // - always returns a TDocVariantData, even if no property name did match
    // (in this case, it is dvUndefined)
    // - this overloaded method accepts an additional filter to each reduced item
    function ReduceAsArray(const aPropName: RawUTF8; OnReduce: TOnReducePerValue): variant; overload;
    /// rename some properties of a TDocVariant object
    // - returns the number of property names modified
    function Rename(const aFromPropName, aToPropName: TRawUTF8DynArray): integer;
    /// map {"obj.prop1"..,"obj.prop2":..} into {"obj":{"prop1":..,"prop2":...}}
    // - the supplied aObjectPropName should match the incoming dotted value
    // of all properties (e.g. 'obj' for "obj.prop1")
    // - if any of the incoming property is not of "obj.prop#" form, the
    // whole process would be ignored
    // - return FALSE if the TDocVariant did not change
    // - return TRUE if the TDocVariant has been flattened
    function FlattenAsNestedObject(const aObjectPropName: RawUTF8): boolean;

    /// how this document will behave
    // - those options are set when creating the instance
    // - dvoArray and dvoObject are not options, but define the document Kind,
    // so those items are ignored when assigned to this property
    property Options: TDocVariantOptions read VOptions write SetOptions;
    /// returns the document internal layout
    // - just after initialization, it will return dvUndefined
    // - most of the time, you will add named values with AddValue() or by
    // setting the variant properties: it will return dvObject
    // - but is you use AddItem(), values will have no associated names: the
    // document will be a dvArray
    // - value computed from the dvoArray and dvoObject presence in Options
    property Kind: TDocVariantKind read GetKind;
    /// return the custom variant type identifier, i.e. DocVariantType.VarType
    property VarType: word read VType;
    /// number of items stored in this document
    // - is 0 if Kind=dvUndefined
    // - is the number of name/value pairs for Kind=dvObject
    // - is the number of items for Kind=dvArray
    property Count: integer read VCount;
    /// the current capacity of this document
    // - allow direct access to VValue[] length
    property Capacity: integer read GetCapacity write SetCapacity;
    /// direct acces to the low-level internal array of values
    // - transtyping a variant and direct access to TDocVariantData is the
    // fastest way of accessing all properties of a given dvObject:
    // ! with TDocVariantData(aVariantObject) do
    // !   for i := 0 to Count-1 do
    // !     writeln(Names[i],'=',Values[i]);
    // - or to access a dvArray items (e.g. a MongoDB collection):
    // ! with TDocVariantData(aVariantArray) do
    // !   for i := 0 to Count-1 do
    // !     writeln(Values[i]);
    property Values: TVariantDynArray read VValue;
    /// direct acces to the low-level internal array of names
    // - is void (nil) if Kind is not dvObject
    // - transtyping a variant and direct access to TDocVariantData is the
    // fastest way of accessing all properties of a given dvObject:
    // ! with TDocVariantData(aVariantObject) do
    // !   for i := 0 to Count-1 do
    // !     writeln(Names[i],'=',Values[i]);
    property Names: TRawUTF8DynArray read VName;
    /// find an item in this document, and returns its value
    // - raise an EDocVariant if aNameOrIndex is neither an integer nor a string
    // - raise an EDocVariant if Kind is dvArray and aNameOrIndex is a string
    // or if Kind is dvObject and aNameOrIndex is an integer
    // - raise an EDocVariant if Kind is dvObject and if aNameOrIndex is a
    // string, which is not found within the object property names and
    // dvoReturnNullForUnknownProperty is set in Options
    // - raise an EDocVariant if Kind is dvArray and if aNameOrIndex is a
    // integer, which is not within 0..Count-1 and dvoReturnNullForUnknownProperty
    // is set in Options
    // - so you can use directly:
    // ! // for an array document:
    // ! aVariant := TDocVariant.NewArray(['one',2,3.0]);
    // ! for i := 0 to TDocVariantData(aVariant).Count-1 do
    // !   aValue := TDocVariantData(aVariant).Value[i];
    // ! // for an object document:
    // ! aVariant := TDocVariant.NewObject(['name','John','year',1972]);
    // ! assert(aVariant.Name=TDocVariantData(aVariant)['name']);
    // ! assert(aVariant.year=TDocVariantData(aVariant)['year']);
    // - due to the internal implementation of variant execution (somewhat
    // slow _DispInvoke() function), it is a bit faster to execute:
    // ! aValue := TDocVariantData(aVariant).Value['name'];
    // instead of
    // ! aValue := aVariant.name;
    // but of course, if want to want to access the content by index (typically
    // for a dvArray), using Values[] - and Names[] - properties is much faster
    // than this variant-indexed pseudo-property:
    // ! with TDocVariantData(aVariant) do
    // !   for i := 0 to Count-1 do
    // !     Writeln(Values[i]);
    // is faster than:
    // ! with TDocVariantData(aVariant) do
    // !   for i := 0 to Count-1 do
    // !     Writeln(Value[i]);
    // which is faster than:
    // ! for i := 0 to aVariant.Count-1 do
    // !   Writeln(aVariant._(i));
    // - this property will return the value as varByRef (just like with
    // variant late binding of any TDocVariant instance), so you can write:
    // !var Doc: TDocVariantData; // stack-allocated variable
    // !begin
    // !  Doc.InitJSON('{arr:[1,2]}');
    // !  assert(Doc.Count=2);
    // !  Doc.Value['arr'].Add(3);  // works since Doc.Value['arr'] is varByRef
    // !  writeln(Doc.ToJSON);      // will write '{"arr":[1,2,3]}'
    // !end;
    // - if you want to access a property as a copy, i.e. to assign it to a
    // variant variable which will stay alive after this TDocVariant instance
    // is release, you should not use Value[] but rather
    // GetValueOrRaiseException or GetValueOrNull/GetValueOrEmpty
    // - see U[] I[] B[] D[] O[] O_[] A[] A_[] _[] properties for direct access
    // of strong typed values
    property Value[const aNameOrIndex: Variant]: Variant read GetValueOrItem
      write SetValueOrItem; default;

    /// direct access to a dvObject UTF-8 stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsRawUTF8() if you want to check the availability of the field
    // - U['prop'] := 'value' would add a new property, or overwrite an existing
    property U[const aName: RawUTF8]: RawUTF8 read GetRawUTF8ByName write SetRawUTF8ByName;
    /// direct string access to a dvObject UTF-8 stored property value from its name
    // - just a wrapper around U[] property, to avoid a compilation warning when
    // using plain string variables (internaly, RawUTF8 will be used for storage)
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsRawUTF8() if you want to check the availability of the field
    // - S['prop'] := 'value' would add a new property, or overwrite an existing
    property S[const aName: RawUTF8]: string read GetStringByName write SetStringByName;
    /// direct access to a dvObject Integer stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsInt/GetAsInt64 if you want to check the availability of the field
    // - I['prop'] := 123 would add a new property, or overwrite an existing
    property I[const aName: RawUTF8]: Int64 read GetInt64ByName write SetInt64ByName;
    /// direct access to a dvObject Boolean stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsBoolean if you want to check the availability of the field
    // - B['prop'] := true would add a new property, or overwrite an existing
    property B[const aName: RawUTF8]: Boolean read GetBooleanByName write SetBooleanByName;
    /// direct access to a dvObject floating-point stored property value from its name
    // - slightly faster than the variant-based Value[] default property
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - use GetAsDouble if you want to check the availability of the field
    // - D['prop'] := 1.23 would add a new property, or overwrite an existing
    property D[const aName: RawUTF8]: Double read GetDoubleByName write SetDoubleByName;
    /// direct access to a dvObject existing dvObject property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - O['prop'] would return a fake void TDocVariant if the property is not
    // existing or not a dvObject, just like GetAsDocVariantSafe()
    // - use O_['prop'] to force adding any missing property
    property O[const aName: RawUTF8]: PDocVariantData read GetObjectExistingByName;
    /// direct access or add a dvObject's dvObject property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - O_['prop'] would add a new property if there is none existing, or
    // overwrite an existing property which is not a dvObject
    property O_[const aName: RawUTF8]: PDocVariantData read GetObjectOrAddByName;
    /// direct access to a dvObject existing dvArray property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - A['prop'] would return a fake void TDocVariant if the property is not
    // existing or not a dvArray, just like GetAsDocVariantSafe()
    // - use A_['prop'] to force adding any missing property
    property A[const aName: RawUTF8]: PDocVariantData read GetArrayExistingByName;
    /// direct access or add a dvObject's dvArray property from its name
    // - follows dvoNameCaseSensitive and dvoReturnNullForUnknownProperty options
    // - A_['prop'] would add a new property if there is none existing, or
    // overwrite an existing property which is not a dvArray
    property A_[const aName: RawUTF8]: PDocVariantData read GetArrayOrAddByName;
    /// direct access to a dvArray's TDocVariant property from its index
    // - simple values may directly use Values[] dynamic array, but to access
    // a TDocVariantData members, this property is safer
    // - follows dvoReturnNullForUnknownProperty option to raise an exception
    // - _[ndx] would return a fake void TDocVariant if aIndex is out of range,
    // if the property is not existing or not a TDocVariantData (just like
    // GetAsDocVariantSafe)
    property _[aIndex: integer]: PDocVariantData read GetAsDocVariantByIndex;
  end;
  {$A+} { packet object not allowed since Delphi 2009 :( }

var
  /// the internal custom variant type used to register TDocVariant
  DocVariantType: TDocVariant = nil;
  /// copy of DocVariantType.VarType
  // - as used by inlined functions of TDocVariantData
  DocVariantVType: integer = -1;

/// retrieve the text representation of a TDocVairnatKind
function ToText(kind: TDocVariantKind): PShortString; overload;

/// direct access to a TDocVariantData from a given variant instance
// - return a pointer to the TDocVariantData corresponding to the variant
// instance, which may be of kind varByRef (e.g. when retrieved by late binding)
// - raise an EDocVariant exception if the instance is not a TDocVariant
// - the following direct trans-typing may fail, e.g. for varByRef value:
// ! TDocVariantData(aVarDoc.ArrayProp).Add('new item');
// - so you can write the following:
// ! DocVariantData(aVarDoc.ArrayProp).AddItem('new item');
function DocVariantData(const DocVariant: variant): PDocVariantData;

const
  /// constant used e.g. by _Safe() overloaded functions
  // - will be in code section of the exe, so will be read-only by design
  // - would have Kind=dvUndefined and Count=0, so _Safe() would return
  // a valid, but void document
  // - its VType is varNull, so would be viewed as a null variant
  // - dvoReturnNullForUnknownProperty is defined, so that U[]/I[]... methods
  // won't raise any exception about unexpected field name
  DocVariantDataFake: TDocVariantData = (
    VType:1; VOptions:[dvoReturnNullForUnknownProperty]);

/// direct access to a TDocVariantData from a given variant instance
// - return a pointer to the TDocVariantData corresponding to the variant
// instance, which may be of kind varByRef (e.g. when retrieved by late binding)
// - will return a read-only fake TDocVariantData with Kind=dvUndefined if the
// supplied variant is not a TDocVariant instance, so could be safely used
// in a with block (use "with" moderation, of course):
// ! with _Safe(aDocVariant)^ do
// !   for ndx := 0 to Count-1 do // here Count=0 for the "fake" result
// !     writeln(Names[ndx]);
function _Safe(const DocVariant: variant): PDocVariantData; overload;
  {$ifdef FPC}inline;{$endif} // Delphi has problems inlining this :(

/// direct access to a TDocVariantData from a given variant instance
// - return a pointer to the TDocVariantData corresponding to the variant
// instance, which may be of kind varByRef (e.g. when retrieved by late binding)
// - will check the supplied document kind, i.e. either dvObject or dvArray and
// raise a EDocVariant exception if it does not match
function _Safe(const DocVariant: variant; ExpectedKind: TDocVariantKind): PDocVariantData; overload;

/// initialize a variant instance to store some document-based object content
// - object will be initialized with data supplied two by two, as Name,Value
// pairs, e.g.
// ! aVariant := _Obj(['name','John','year',1972]);
// or even with nested objects:
// ! aVariant := _Obj(['name','John','doc',_Obj(['one',1,'two',2.0])]);
// - this global function is an alias to TDocVariant.NewObject()
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, set Options=[dvoValueCopiedByReference]
// or using _ObjFast() will increase the process speed a lot
function _Obj(const NameValuePairs: array of const;
  Options: TDocVariantOptions=[]): variant;

/// add some property values to a document-based object content
// - if Obj is a TDocVariant object, will add the Name/Value pairs
// - if Obj is not a TDocVariant, will create a new fast document,
// initialized with supplied the Name/Value pairs
// - this function will also ensure that ensure Obj is not stored by reference,
// but as a true TDocVariantData
procedure _ObjAddProps(const NameValuePairs: array of const; var Obj: variant); overload;

/// add the property values of a document to a document-based object content
// - if Document is not a TDocVariant object, will do nothing
// - if Obj is a TDocVariant object, will add Document fields to its content
// - if Obj is not a TDocVariant object, Document will be copied to Obj
procedure _ObjAddProps(const Document: variant; var Obj: variant); overload;

/// initialize a variant instance to store some document-based array content
// - array will be initialized with data supplied as parameters, e.g.
// ! aVariant := _Arr(['one',2,3.0]);
// - this global function is an alias to TDocVariant.NewArray()
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, set Options=[dvoValueCopiedByReference]
// or using _ArrFast() will increase the process speed a lot
function _Arr(const Items: array of const;
  Options: TDocVariantOptions=[]): variant;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content
// - this global function is an alias to TDocVariant.NewJSON(), and
// will return an Unassigned variant if JSON content was not correctly converted
// - object or array will be initialized from the supplied JSON content, e.g.
// ! aVariant := _Json('{"id":10,"doc":{"name":"John","birthyear":1972}}');
// ! // now you can access to the properties via late binding
// ! assert(aVariant.id=10);
// ! assert(aVariant.doc.name='John');
// ! assert(aVariant.doc.birthYear=1972);
// ! // and also some pseudo-properties:
// ! assert(aVariant._count=2);
// ! assert(aVariant.doc._kind=ord(dvObject));
// ! // or with a JSON array:
// ! aVariant := _Json('["one",2,3]');
// ! assert(aVariant._kind=ord(dvArray));
// ! for i := 0 to aVariant._count-1 do
// !   writeln(aVariant._(i));
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names:
// ! aVariant := _Json('{id:10,doc:{name:"John",birthyear:1972}}');
// - if the SynMongoDB unit is used in the application, the MongoDB Shell
// syntax will also be recognized to create TBSONVariant, like
// ! new Date()   ObjectId()   MinKey   MaxKey  /<jRegex>/<jOptions>
// see @http://docs.mongodb.org/manual/reference/mongodb-extended-json
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, add dvoValueCopiedByReference in Options
// will increase the process speed a lot, or use _JsonFast()
function _Json(const JSON: RawUTF8;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content, with parameters formating
// - wrapper around the _Json(FormatUTF8(...,JSONFormat=true)) function,
// i.e. every Args[] will be inserted for each % and Params[] for each ?,
// with proper JSON escaping of string values, and writing nested _Obj() /
// _Arr() instances as expected JSON objects / arrays
// - typical use (in the context of SynMongoDB unit) could be:
// ! aVariant := _JSONFmt('{%:{$in:[?,?]}}',['type'],['food','snack']);
// ! aVariant := _JSONFmt('{type:{$in:?}}',[],[_Arr(['food','snack'])]);
// ! // which are the same as:
// ! aVariant := _JSONFmt('{type:{$in:["food","snack"]}}');
// ! // in this context:
// ! u := VariantSaveJSON(aVariant);
// ! assert(u='{"type":{"$in":["food","snack"]}}');
// ! u := VariantSaveMongoJSON(aVariant,modMongoShell);
// ! assert(u='{type:{$in:["food","snack"]}}');
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, add dvoValueCopiedByReference in Options
// will increase the process speed a lot, or use _JsonFast()
function _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant; overload;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content, with parameters formating
// - this overload function will set directly a local variant variable,
// and would be used by inlined _JsonFmt/_JsonFastFmt functions
procedure _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions; out result: variant); overload;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content
// - this global function is an alias to TDocVariant.NewJSON(), and
// will return TRUE if JSON content was correctly converted into a variant
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names or ObjectID()
// - by default, every internal value will be copied, so access of nested
// properties can be slow - if you expect the data to be read-only or not
// propagated into another place, add dvoValueCopiedByReference in Options
// will increase the process speed a lot, or use _JsonFast()
function _Json(const JSON: RawUTF8; var Value: variant;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some document-based object content
// - this global function is an handy alias to:
// ! Obj(NameValuePairs,JSON_OPTIONS[true]);
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
function _ObjFast(const NameValuePairs: array of const): variant; overload;

/// initialize a variant instance to store any object as a TDocVariant
// - is a wrapper around _JsonFast(ObjectToJson(aObject,aOptions))
function _ObjFast(aObject: TObject;
   aOptions: TTextWriterWriteObjectOptions=[woDontStoreDefault]): variant; overload;

/// initialize a variant instance to store some document-based array content
// - this global function is an handy alias to:
// ! _Array(Items,JSON_OPTIONS[true]);
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
function _ArrFast(const Items: array of const): variant; overload;

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content
// - this global function is an handy alias to:
// ! _Json(JSON,JSON_OPTIONS[true]);
// so it will return an Unassigned variant if JSON content was not correct
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names or ObjectID()
function _JsonFast(const JSON: RawUTF8): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some extended document-based content
// - this global function is an handy alias to:
// ! _Json(JSON,JSON_OPTIONS_FAST_EXTENDED);
function _JsonFastExt(const JSON: RawUTF8): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// initialize a variant instance to store some document-based content
// from a supplied (extended) JSON content, with parameters formating
// - this global function is an handy alias e.g. to:
// ! aVariant := _JSONFmt('{%:{$in:[?,?]}}',['type'],['food','snack'],JSON_OPTIONS[true]);
// - so all created objects and arrays will be handled by reference, for best
// speed - but you should better write on the resulting variant tree with caution
// - in addition to the JSON RFC specification strict mode, this method will
// handle some BSON-like extensions, e.g. unquoted field names or ObjectID():
function _JsonFastFmt(const Format: RawUTF8; const Args,Params: array of const): variant;

/// ensure a document-based variant instance will have only per-value nested
// objects or array documents
// - is just a wrapper around:
// ! TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[false])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-value whatever options the nested objects or
// arrays were created with
// - for huge document with a big depth of nested objects or arrays, a full
// per-value copy may be time and resource consuming, but will be also safe
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
procedure _Unique(var DocVariant: variant);

/// ensure a document-based variant instance will have only per-value nested
// objects or array documents
// - is just a wrapper around:
// ! TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[true])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-reference whatever options the nested objects or
// arrays were created with
// - for huge document with a big depth of nested objects or arrays, it will
// first create a whole copy of the document nodes, but further assignments
// of the resulting value will be per-reference, so will be almost instant
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
procedure _UniqueFast(var DocVariant: variant);

/// return a full nested copy of a document-based variant instance
// - is just a wrapper around:
// ! TDocVariant.NewUnique(DocVariant,JSON_OPTIONS[false])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-value whatever options the nested objects or
// arrays were created with: to be used on a value returned as varByRef
// (e.g. by _() pseudo-method)
// - for huge document with a big depth of nested objects or arrays, a full
// per-value copy may be time and resource consuming, but will be also safe -
// consider using _ByRef() instead if a fast copy-by-reference is enough
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
function _Copy(const DocVariant: variant): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// return a full nested copy of a document-based variant instance
// - is just a wrapper around:
// ! TDocVariant.NewUnique(DocVariant,JSON_OPTIONS[true])
// - you can use this function to ensure that all internal properties of this
// variant will be copied per-value whatever options the nested objects or
// arrays were created with: to be used on a value returned as varByRef
// (e.g. by _() pseudo-method)
// - for huge document with a big depth of nested objects or arrays, a full
// per-value copy may be time and resource consuming, but will be also safe -
// consider using _ByRef() instead if a fast copy-by-reference is enough
// - will raise an EDocVariant if the supplied variant is not a TDocVariant or
// a varByRef pointing to a TDocVariant
function _CopyFast(const DocVariant: variant): variant;
  {$ifdef HASINLINE}inline;{$endif}

/// copy a TDocVariant to another variable, changing the options on the fly
// - note that the content (items or properties) is copied by reference,
// so consider using _Copy() instead if you expect to safely modify its content
// - will return null if the supplied variant is not a TDocVariant
function _ByRef(const DocVariant: variant; Options: TDocVariantOptions): variant; overload;

/// copy a TDocVariant to another variable, changing the options on the fly
// - note that the content (items or properties) is copied by reference,
// so consider using _Copy() instead if you expect to safely modify its content
// - will return null if the supplied variant is not a TDocVariant
procedure _ByRef(const DocVariant: variant; out Dest: variant;
  Options: TDocVariantOptions); overload;

/// convert a TDocVariantData array or a string value into a CSV
// - will call either TDocVariantData.ToCSV, or return the string
// - returns '' if the supplied value is neither a TDocVariant or a string
// - could be used e.g. to store either a JSON CSV string or a JSON array of
// strings in a settings property
function _CSV(const DocVariantOrString: variant): RawUTF8;

/// will convert any TObject into a TDocVariant document instance
// - a slightly faster alternative to Dest := _JsonFast(ObjectToJSON(Value))
// - this would convert the TObject by representation, using only serializable
// published properties: do not use this function to store temporary a class
// instance, but e.g. to store an object values in a NoSQL database
// - if you expect lazy-loading of a TObject, see TObjectVariant.New()
procedure ObjectToVariant(Value: TObject; out Dest: variant); overload;
  {$ifdef HASINLINE}inline;{$endif}

/// will convert any TObject into a TDocVariant document instance
// - a faster alternative to _JsonFast(ObjectToJSON(Value))
// - if you expect lazy-loading of a TObject, see TObjectVariant.New()
function ObjectToVariant(Value: TObject; EnumSetsAsText: boolean=false): variant; overload;

/// will convert any TObject into a TDocVariant document instance
// - a faster alternative to _Json(ObjectToJSON(Value),Options)
// - note that the result variable should already be cleared: no VarClear()
// is done by this function
// - would be used e.g. by VarRecToVariant() function
// - if you expect lazy-loading of a TObject, see TObjectVariant.New()
procedure ObjectToVariant(Value: TObject; var result: variant;
  Options: TTextWriterWriteObjectOptions); overload;

{$endif NOVARIANTS}

{ ************ some console functions ************************************** }

type
  /// available console colors (under Windows at least)
  TConsoleColor = (
    ccBlack, ccBlue, ccGreen, ccCyan, ccRed, ccMagenta, ccBrown, ccLightGray,
    ccDarkGray, ccLightBlue, ccLightGreen, ccLightCyan, ccLightRed, ccLightMagenta,
    ccYellow, ccWhite);

{$ifdef FPC}{$ifdef Linux}
var
  stdoutIsTTY: boolean;
{$endif}{$endif}

/// change the Windows console text writing color
// - you should call this procedure to initialize StdOut global variable, if
// you manually initialized the Windows console, e.g. via the following code:
// ! AllocConsole;
// ! TextColor(ccLightGray); // initialize internal console context
procedure TextColor(Color: TConsoleColor);

/// change the Windows console text background color
procedure TextBackground(Color: TConsoleColor);

/// will wait for the ENTER key to be pressed, processing the internal
// Windows Message loop and any Synchronize() pending notification
// - to be used e.g. for proper work of console applications with interface-based
// service implemented as optExecInMainThread
procedure ConsoleWaitForEnterKey;

{$ifdef MSWINDOWS}
/// low-level access to the keyboard state of a given key
function ConsoleKeyPressed(ExpectedKey: Word): Boolean;
{$endif}

/// direct conversion of a UTF-8 encoded string into a console OEM-encoded String
// - under Windows, will use the CP_OEMCP encoding
// - under Linux, will expect the console to be defined with UTF-8 encoding
function Utf8ToConsole(const S: RawUTF8): RawByteString;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// direct conversion of a VCL string into a console OEM-encoded String
// - under Windows, will use the CP_OEMCP encoding
// - under Linux, will expect the console to be defined with UTF-8 encoding
function StringToConsole(const S: string): RawByteString;
  {$ifndef MSWINDOWS}{$ifdef HASINLINE}inline;{$endif}{$endif}

/// could be used in the main program block of a console application to
// handle unexpected fatal exceptions
// - typical use may be:
// !begin
// !  try
// !    ... // main console process
// !  except
// !    on E: Exception do
// !      ConsoleShowFatalException(E);
// !  end;
// !end.
procedure ConsoleShowFatalException(E: Exception; WaitForEnterKey: boolean=true);

var
  /// low-level handle used for console writing
  // - may be overriden when console is redirected
  // - is initialized when TextColor() is called
  StdOut: THandle;

{$ifndef NOVARIANTS}
type
  /// an interface to process the command line switches over a console
  // - as implemented e.g. by TCommandLine class
  // - can implement any process, optionally with console interactivity
  ICommandLine = interface
    ['{77AB427C-1025-488B-8E04-3E62C8100E62}']
    /// returns a command line switch value as UTF-8 text
    // - you can specify a prompt text, when asking for any missing switch
    function AsUTF8(const Switch, Default: RawUTF8; const Prompt: string): RawUTF8;
    /// returns a command line switch value as VCL string text
    // - you can specify a prompt text, when asking for any missing switch
    function AsString(const Switch: RawUTF8; const Default, Prompt: string): string;
    /// returns a command line switch value as integer
    // - you can specify a prompt text, when asking for any missing switch
    function AsInt(const Switch: RawUTF8; Default: Int64; const Prompt: string): Int64;
    /// returns a command line switch ISO-8601 value as date value
    // - here dates are expected to be encoded with ISO-8601, i.e. YYYY-MM-DD
    // - you can specify a prompt text, when asking for any missing switch
    function AsDate(const Switch: RawUTF8; Default: TDateTime; const Prompt: string): TDateTime;
    /// returns a command line switch value as enumeration ordinal
    // - RTTI will be used to check for the enumeration text, or plain integer
    // value will be returned as ordinal value
    // - you can specify a prompt text, when asking for any missing switch
    function AsEnum(const Switch, Default: RawUTF8; TypeInfo: pointer;
      const Prompt: string): integer;
    /// returns all command line values as an array of UTF-8 text
    // - i.e. won't interpret the various switches in the input parameters
    // - as created e.g. by TCommandLine.CreateAsArray constructor
    function AsArray: TRawUTF8DynArray;
    /// serialize all recognized switches as UTF-8 JSON text
    function AsJSON(Format: TTextWriterJSONFormat): RawUTF8;
    /// equals TRUE if the -noprompt switch has been supplied
    // - may be used to force pure execution without console interaction,
    // e.g. when run from another process
    function NoPrompt: boolean;
    /// change the console text color
    // - do nothing if NoPrompt is TRUE
    procedure TextColor(Color: TConsoleColor);
    /// write some console text, with an optional color
    // - will output the text even if NoPrompt is TRUE
    procedure Text(const Fmt: RawUTF8; const Args: array of const;
      Color: TConsoleColor=ccLightGray);
  end;

  /// a class to process the command line switches, with console interactivity
  // - is able to redirect all Text() output to an internal UTF-8 storage,
  // in addition or instead of the console (to be used e.g. from a GUI)
  // - implements ICommandLine interface
  TCommandLine = class(TInterfacedObjectWithCustomCreate, ICommandLine)
  private
    fValues: TDocVariantData;
    fNoPrompt: boolean;
    fNoConsole: boolean;
    fLines: TRawUTF8DynArray;
    procedure SetNoConsole(value: boolean);
  public
    /// initialize the internal storage from the command line
    // - will parse "-switch1 value1 -switch2 value2" layout
    // - stand-alone "-switch1 -switch2 value2" will a create switch1=true value
    constructor Create; overload; override;
    /// initialize the internal storage from the command line
    // - will set paramstr(firstParam)..paramstr(paramcount) in fValues as array
    // - may be used e.g. for "val1 val2 val3" command line layout
    constructor CreateAsArray(firstParam: integer);
    /// initialize the internal storage with some ready-to-use switches
    // - will also set the NoPrompt option, and set the supplied NoConsole value
    // - may be used e.g. from a graphical interface instead of console mode
    constructor Create(const switches: variant;
      aNoConsole: boolean=true); reintroduce; overload;
    /// initialize the internal storage with some ready-to-use name/value pairs
    // - will also set the NoPrompt option, and set the supplied NoConsole value
    // - may be used e.g. from a graphical interface instead of console mode
    constructor Create(const NameValuePairs: array of const;
      aNoConsole: boolean=true); reintroduce; overload;
    /// returns a command line switch value as UTF-8 text
    // - you can specify a prompt text, when asking for any missing switch
    function AsUTF8(const Switch, Default: RawUTF8; const Prompt: string): RawUTF8;
    /// returns a command line switch value as VCL string text
    // - you can specify a prompt text, when asking for any missing switch
    function AsString(const Switch: RawUTF8; const Default, Prompt: string): string;
    /// returns a command line switch value as integer
    // - you can specify a prompt text, when asking for any missing switch
    function AsInt(const Switch: RawUTF8; Default: Int64; const Prompt: string): Int64;
    /// returns a command line switch ISO-8601 value as date value
    // - here dates are expected to be encoded with ISO-8601, i.e. YYYY-MM-DD
    // - you can specify a prompt text, when asking for any missing switch
    function AsDate(const Switch: RawUTF8; Default: TDateTime; const Prompt: string): TDateTime;
    /// returns a command line switch value as enumeration ordinal
    // - RTTI will be used to check for the enumeration text, or plain integer
    // value will be returned as ordinal value
    // - you can specify a prompt text, when asking for any missing switch
    function AsEnum(const Switch, Default: RawUTF8; TypeInfo: pointer;
      const Prompt: string): integer;
    /// returns all command line values as an array of UTF-8 text
    // - i.e. won't interpret the various switches in the input parameters
    // - as created e.g. by TCommandLine.CreateAsArray constructor
    function AsArray: TRawUTF8DynArray;
    /// serialize all recognized switches as UTF-8 JSON text
    function AsJSON(Format: TTextWriterJSONFormat): RawUTF8;
    /// equals TRUE if the -noprompt switch has been supplied
    // - may be used to force pure execution without console interaction,
    // e.g. when run from another process
    function NoPrompt: boolean;
    /// change the console text color
    // - do nothing if NoPrompt is TRUE
    procedure TextColor(Color: TConsoleColor);
    /// write some console text, with an optional color
    // - will output the text even if NoPrompt=TRUE, but not if NoConsole=TRUE
    // - will append the text to the internal storage, available from ConsoleText
    procedure Text(const Fmt: RawUTF8; const Args: array of const;
      Color: TConsoleColor=ccLightGray);
    /// low-level access to the internal switches storage
    property Values: TDocVariantData read fValues;
    /// if Text() should be redirected to ConsoleText internal storage
    // - and don't write anything to the console
    // - should be associated with NoProperty = TRUE property
    property NoConsole: boolean read fNoConsole write SetNoConsole;
    /// low-level access to the internal UTF-8 console lines storage
    property ConsoleLines: TRawUTF8DynArray read fLines;
    /// returns the UTF-8 text as inserted by Text() calls
    // - line feeds will be included to the ConsoleLines[] values
    function ConsoleText(const LineFeed: RawUTF8=sLineBreak): RawUTF8;
  end;
{$endif NOVARIANTS}



{ ******************* process monitoring / statistics ********************** }

type
  /// the kind of value stored in a TSynMonitor / TSynMonitorUsage property
  // - i.e. match TSynMonitorTotalMicroSec, TSynMonitorOneMicroSec,
  // TSynMonitorOneCount, TSynMonitorOneBytes, TSynMonitorBytesPerSec,
  // TSynMonitorTotalBytes, TSynMonitorCount and TSynMonitorCount64 types as
  // used to store statistic information
  // - "cumulative" values would sum each process values, e.g. total elapsed
  // time for SOA execution, task count or total I/O bytes
  // - "immediate" (e.g. svOneBytes or smvBytesPerSec) values would be an evolving
  // single value, e.g. an average value or current disk free size
  // - use SYNMONITORVALUE_CUMULATIVE = [smvMicroSec,smvBytes,smvCount,smvCount64]
  // constant to identify the kind of value
  // - TSynMonitorUsage.Track() would use MonitorPropUsageValue() to guess
  // the tracked properties type from class RTTI
  TSynMonitorType = (
    smvUndefined, smvOneMicroSec, smvOneBytes, smvOneCount, smvBytesPerSec,
    smvMicroSec, smvBytes, smvCount, smvCount64);
  /// value types as stored in TSynMonitor / TSynMonitorUsage
  TSynMonitorTypes = set of TSynMonitorType;

  /// would identify a cumulative time process information in micro seconds, during monitoring
  // - "cumulative" time would add each process timing, e.g. for statistics about
  // SOA computation of a given service
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorTotalMicroSec = type QWord;

  /// would identify an immediate time count information, during monitoring
  // - "immediate" counts won't accumulate, e.g. may store the current number
  // of thread used by a process
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorOneCount = type cardinal;

  /// would identify an immediate time process information in micro seconds, during monitoring
  // - "immediate" time won't accumulate, i.e. may store the duration of the
  // latest execution of a SOA computation
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorOneMicroSec = type QWord;

  /// would identify a process information as cumulative bytes count, during monitoring
  // - "cumulative" size would add some byte for each process, e.g. input/output
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorTotalBytes = type QWord;

  /// would identify an immediate process information as bytes count, during monitoring
  // - "immediate" size won't accumulate, i.e. may be e.g. computer free memory
  // at a given time
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorOneBytes = type QWord;

  /// would identify the process throughput, during monitoring
  // - it indicates e.g. "immediate" bandwith usage
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorBytesPerSec = type QWord;

  /// would identify a cumulative number of processes, during monitoring
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorCount = type cardinal;

  /// would identify a cumulative number of processes, during monitoring
  // - any property defined with this type would be identified by TSynMonitorUsage
  TSynMonitorCount64 = type QWord;

  /// pointer to a high resolution timer object/record
  PPrecisionTimer = ^TPrecisionTimer;

  /// indirect reference to a pointer to a high resolution timer object/record
  PPPrecisionTimer = ^PPrecisionTimer;

  /// high resolution timer (for accurate speed statistics)
  // - WARNING: under Windows, this record MUST be aligned to 32-bit, otherwise
  // iFreq=0 - so you can use TLocalPrecisionTimer/ILocalPrecisionTimer if you
  // want to alllocate a local timer instance on the stack
  {$ifdef FPC_OR_UNICODE}TPrecisionTimer = record private
  {$else}TPrecisionTimer = object protected{$endif}
    fStart,fStop,fResume,fLast: Int64;
    {$ifndef LINUX} // use QueryPerformanceMicroSeconds() fast API
    fWinFreq: Int64;
    {$endif}
    /// contains the time elapsed in micro seconds between Start and Stop
    fTime: TSynMonitorTotalMicroSec;
    /// contains the time elapsed in micro seconds between Resume and Pause
    fLastTime: TSynMonitorOneMicroSec;
    fPauseCount: TSynMonitorCount;
  public
    /// initialize the timer
    // - not necessary if created on the heap (e.g. as class member)
    // - will set all fields to 0
    procedure Init;
    /// initialize and start the high resolution timer
    procedure Start;
    /// returns TRUE if fStart is not 0
    function Started: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// stop the timer, setting the Time elapsed since last Start
    procedure ComputeTime; {$ifdef LINUX}{$ifdef HASINLINE}inline;{$endif}{$endif}
    /// stop the timer, returning the time elapsed as text with time resolution
    // (us,ms,s)
    // - is just a wrapper around ComputeTime + Time
    function Stop: TShort16;
    /// stop the timer, ready to continue its time measurement via Resume
    procedure Pause;
    /// resume a paused timer
    // - if the previous method called was Pause, it will ignore all the
    // time elapsed since then
    // - if the previous method called was Start, it will start as if it was
    // in pause mode
    procedure Resume;
    /// resume a paused timer until the method ends
    // - will internaly create a TInterfaceObject class to let the compiler
    // generate a try..finally block as expected to call Pause at method ending
    // - is therefore very convenient to have consistent Resume/Pause calls
    // - for proper use, expect TPrecisionTimer to be initialized to 0 before
    // execution (e.g. define it as a protected member of a class)
    // - typical use is to declare a fTimeElapsed: TPrecisionTimer protected
    // member, then call fTimeElapsed.ProfileCurrentMethod at the beginning of
    // all process expecting some timing, then log/save fTimeElapsed.Stop content
    // - FPC TIP: result should be assigned to a local variable of IUnknown type
    function ProfileCurrentMethod: IUnknown;
    /// low-level method to force values settings to allow thread safe timing
    // - by default, this timer is not thread safe: you can use this method to
    // set the timing values from manually computed performance counters
    // - the caller should also use a mutex to prevent from race conditions:
    // see e.g. TSynMonitor.FromExternalQueryPerformanceCounters implementation
    // - returns the time elapsed, in micro seconds (i.e. LastTime value)
    // - warning: Start, Stop, Pause and Resume methods are then disallowed
    function FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
    /// low-level method to force values settings to allow thread safe timing
    // - by default, this timer is not thread safe: you can use this method to
    // set the timing values from manually computed performance counters
    // - the caller should also use a mutex to prevent from race conditions:
    // see e.g. TSynMonitor.FromExternalMicroSeconds implementation
    // - warning: Start, Stop, Pause and Resume methods are then disallowed
    procedure FromExternalMicroSeconds(const MicroSeconds: QWord);
      {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell
    /// compute the per second count
    function PerSec(const Count: QWord): QWord;
    /// compute the time elapsed by count, with appened time resolution (us,ms,s)
    function ByCount(Count: QWord): TShort16;
    /// returns e.g. '16.9 MB in 102.20ms i.e. 165.5 MB/s'
    function SizePerSec(Size: QWord): shortstring;
    /// textual representation of time after counter stopped
    // - with appened time resolution (us,ms,s)
    // - not to be used in normal code, but e.g. for custom performance analysis
    function Time: TShort16;
    /// time elapsed in micro seconds after counter stopped
    // - not to be used in normal code, but e.g. for custom performance analysis
    property TimeInMicroSec: TSynMonitorTotalMicroSec read fTime write fTime;
    /// textual representation of last process timing after counter stopped
    // - with appened time resolution (us,ms,s)
    // - not to be used in normal code, but e.g. for custom performance analysis
    function LastTime: TShort16;
    /// timing in micro seconds of the last process
    // - not to be used in normal code, but e.g. for custom performance analysis
    property LastTimeInMicroSec: TSynMonitorOneMicroSec read fLastTime write fLastTime;
    /// how many times the Pause method was called, i.e. the number of tasks
    // processeed
    property PauseCount: TSynMonitorCount read fPauseCount;
  end;

  /// interface to a reference counted high resolution timer instance
  // - implemented by TLocalPrecisionTimer
  ILocalPrecisionTimer = interface
    /// start the high resolution timer
    procedure Start;
    /// stop the timer, returning the time elapsed, with appened time resolution (us,ms,s)
    function Stop: TShort16;
    /// stop the timer, ready to continue its time measure
    procedure Pause;
    /// resume a paused timer
    procedure Resume;
    /// compute the per second count
    function PerSec(Count: cardinal): cardinal;
    /// compute the time elapsed by count, with appened time resolution (us,ms,s)
    function ByCount(Count: cardinal): RawUTF8;
  end;

  /// reference counted high resolution timer (for accurate speed statistics)
  // - since TPrecisionTimer shall be 32-bit aligned, you can use this class
  // to initialize a local auto-freeing ILocalPrecisionTimer variable on stack
  // - to be used as such:
  // ! var Timer: ILocalPrecisionTimer;
  // !  (...)
  // !   Timer := TLocalPrecisionTimer.Create;
  // !   Timer.Start;
  // !  (...)
  TLocalPrecisionTimer = class(TInterfacedObject,ILocalPrecisionTimer)
  protected
    fTimer: TPrecisionTimer;
  public
    /// initialize the instance, and start the high resolution timer
    constructor CreateAndStart;
    /// start the high resolution timer
    procedure Start;
    /// stop the timer, returning the time elapsed, with appened time resolution (us,ms,s)
    function Stop: TShort16;
    /// stop the timer, ready to continue its time measure
    procedure Pause;
    /// resume a paused timer
    procedure Resume;
    /// compute the per second count
    function PerSec(Count: cardinal): cardinal;
    /// compute the time elapsed by count, with appened time resolution (us,ms,s)
    function ByCount(Count: cardinal): RawUTF8;
  end;

  /// able to serialize any cumulative timing as raw micro-seconds number or text
  // - "cumulative" time would add each process value, e.g. SOA methods execution
  TSynMonitorTime = class(TSynPersistent)
  protected
    fMicroSeconds: TSynMonitorTotalMicroSec;
    function GetAsText: TShort16;
  public
    /// compute a number per second, of the current value
    function PerSecond(const Count: QWord): QWord;
      {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell
  published
    /// micro seconds time elapsed, as raw number
    property MicroSec: TSynMonitorTotalMicroSec read fMicroSeconds write fMicroSeconds;
    /// micro seconds time elapsed, as '... us-ns-ms-s' text
    property Text: TShort16 read GetAsText;
  end;

  /// able to serialize any immediate timing as raw micro-seconds number or text
  // - "immediate" size won't accumulate, i.e. may be e.g. last process time
  TSynMonitorOneTime = class(TSynPersistent)
  protected
    fMicroSeconds: TSynMonitorOneMicroSec;
    function GetAsText: TShort16;
  public
    /// compute a number per second, of the current value
    function PerSecond(const Count: QWord): QWord;
      {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell
  published
    /// micro seconds time elapsed, as raw number
    property MicroSec: TSynMonitorOneMicroSec read fMicroSeconds write fMicroSeconds;
    /// micro seconds time elapsed, as '... us-ns-ms-s' text
    property Text: TShort16 read GetAsText;
  end;

  TSynMonitorSizeParent = class(TSynPersistent)
  protected
    fTextNoSpace: boolean;
  public
    /// initialize the instance
    constructor Create(aTextNoSpace: boolean); reintroduce;
  end;

  /// able to serialize any cumulative size as bytes number
  // - "cumulative" time would add each process value, e.g. global IO consumption
  TSynMonitorSize = class(TSynMonitorSizeParent)
  protected
    fBytes: TSynMonitorTotalBytes;
    function GetAsText: TShort16;
  published
    /// number of bytes, as raw number
    property Bytes: TSynMonitorTotalBytes read fBytes write fBytes;
    /// number of bytes, as '... B-KB-MB-GB' text
    property Text: TShort16 read GetAsText;
  end;

  /// able to serialize any immediate size as bytes number
  // - "immediate" size won't accumulate, i.e. may be e.g. computer free memory
  // at a given time
  TSynMonitorOneSize = class(TSynMonitorSizeParent)
  protected
    fBytes: TSynMonitorOneBytes;
    function GetAsText: TShort16;
  published
    /// number of bytes, as raw number
    property Bytes: TSynMonitorOneBytes read fBytes write fBytes;
    /// number of bytes, as '... B-KB-MB-GB' text
    property Text: TShort16 read GetAsText;
  end;

  /// able to serialize any bandwith as bytes count per second
  // - is usually associated with TSynMonitorOneSize properties,
  // e.g. to monitor IO activity
  TSynMonitorThroughput = class(TSynMonitorSizeParent)
  protected
    fBytesPerSec: QWord;
    function GetAsText: TShort16;
  published
    /// number of bytes per second, as raw number
    property BytesPerSec: QWord read fBytesPerSec write fBytesPerSec;
    /// number of bytes per second, as '... B-KB-MB-GB/s' text
    property Text: TShort16 read GetAsText;
  end;

  /// a generic value object able to handle any task / process statistic
  // - base class shared e.g. for ORM, SOA or DDD, when a repeatable data
  // process is to be monitored
  // - this class is thread-safe for its methods, but you should call explicitly
  // Lock/UnLock to access its individual properties
  TSynMonitor = class(TSynPersistentLock)
  protected
    fName: RawUTF8;
    fTaskCount: TSynMonitorCount64;
    fTotalTime: TSynMonitorTime;
    fLastTime: TSynMonitorOneTime;
    fMinimalTime: TSynMonitorOneTime;
    fAverageTime: TSynMonitorOneTime;
    fMaximalTime: TSynMonitorOneTime;
    fPerSec: QWord;
    fInternalErrors: TSynMonitorCount;
    fProcessing: boolean;
    fTaskStatus: (taskNotStarted,taskStarted);
    fLastInternalError: variant;
    procedure LockedPerSecProperties; virtual;
    procedure LockedFromProcessTimer; virtual;
    procedure LockedSum(another: TSynMonitor); virtual;
    procedure WriteDetailsTo(W: TTextWriter); virtual;
    procedure Changed; virtual;
  public
    /// low-level high-precision timer instance
    InternalTimer: TPrecisionTimer;
    /// initialize the instance nested class properties
    // - you can specify identifier associated to this monitored resource
    // which would be used for TSynMonitorUsage persistence
    constructor Create(const aName: RawUTF8); reintroduce; overload; virtual;
    /// initialize the instance nested class properties
    constructor Create; overload; override;
    /// finalize the instance
    destructor Destroy; override;
    /// lock the instance for exclusive access
    // - needed only if you access directly the instance properties
    procedure Lock; {$ifdef HASINLINE}inline;{$endif}
    /// release the instance for exclusive access
    // - needed only if you access directly the instance properties
    procedure UnLock; {$ifdef HASINLINE}inline;{$endif}
    /// create Count instances of this actual class in the supplied ObjArr[]
    class procedure InitializeObjArray(var ObjArr; Count: integer); virtual;
    /// should be called when the process starts, to resume the internal timer
    // - thread-safe method
    procedure ProcessStart; virtual;
    /// should be called each time a pending task is processed
    // - will increase the TaskCount property
    // - thread-safe method
    procedure ProcessDoTask; virtual;
    /// should be called when the process starts, and a task is processed
    // - similar to ProcessStart + ProcessDoTask
    // - thread-safe method
    procedure ProcessStartTask; virtual;
    /// should be called when an error occurred
    // - typical use is with ObjectToVariantDebug(E,...) kind of information
    // - thread-safe method
    procedure ProcessError(const info: variant); virtual;
    /// should be called when an error occurred
    // - typical use is with a HTTP status, e.g. as ProcessError(Call.OutStatus)
    // - just a wraper around overloaded ProcessError(), so a thread-safe method
    procedure ProcessErrorNumber(info: integer);
    /// should be called when an error occurred
    // - just a wraper around overloaded ProcessError(), so a thread-safe method
    procedure ProcessErrorFmt(const Fmt: RawUTF8; const Args: array of const);
    /// should be called when an Exception occurred
    // - just a wraper around overloaded ProcessError(), so a thread-safe method
    procedure ProcessErrorRaised(E: Exception);
    /// should be called when the process stops, to pause the internal timer
    // - thread-safe method
    procedure ProcessEnd; virtual;
    /// could be used to manage information average or sums
    // - thread-safe method calling LockedSum protected virtual method
    procedure Sum(another: TSynMonitor);
    /// returns a JSON content with all published properties information
    // - thread-safe method
    function ComputeDetailsJSON: RawUTF8;
    /// appends a JSON content with all published properties information
    // - thread-safe method
    procedure ComputeDetailsTo(W: TTextWriter); virtual;
    {$ifndef NOVARIANTS}
    /// returns a TDocVariant with all published properties information
    // - thread-safe method
    function ComputeDetails: variant;
    {$endif NOVARIANTS}
    /// used to allow thread safe timing
    // - by default, the internal TPrecisionTimer is not thread safe: you can
    // use this method to update the timing from many threads
    // - if you use this method, ProcessStart, ProcessDoTask and ProcessEnd
    // methods are disallowed, and the global fTimer won't be used any more
    // - will return the processing time, converted into micro seconds, ready
    // to be logged if needed
    // - thread-safe method
    function FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
    /// used to allow thread safe timing
    // - by default, the internal TPrecisionTimer is not thread safe: you can
    // use this method to update the timing from many threads
    // - if you use this method, ProcessStart, ProcessDoTask and ProcessEnd
    // methods are disallowed, and the global fTimer won't be used any more
    // - thread-safe method
    procedure FromExternalMicroSeconds(const MicroSecondsElapsed: QWord);
    /// an identifier associated to this monitored resource
    // - is used e.g. for TSynMonitorUsage persistence/tracking
    property Name: RawUTF8 read fName write fName;
  published
    /// indicates if this thread is currently working on some process
    property Processing: boolean read fProcessing write fProcessing;
    /// how many times the task was performed
    property TaskCount: TSynMonitorCount64 read fTaskCount write fTaskCount;
    /// the whole time spend during all working process
    property TotalTime: TSynMonitorTime read fTotalTime;
    /// the time spend during the last task processing
    property LastTime: TSynMonitorOneTime read fLastTime;
    /// the lowest time spent during any working process
    property MinimalTime: TSynMonitorOneTime read fMinimalTime;
    /// the time spent in average during any working process
    property AverageTime: TSynMonitorOneTime read fAverageTime;
    /// the highest time spent during any working process
    property MaximalTime: TSynMonitorOneTime read fMaximalTime;
    /// average of how many tasks did occur per second
    property PerSec: QWord read fPerSec;
    /// how many errors did occur during the processing
    property Errors: TSynMonitorCount read fInternalErrors;
    /// information about the last error which occured during the processing
    property LastError: variant read fLastInternalError;
  end;
  /// references a TSynMonitor instance
  PSynMonitor = ^TSynMonitor;

  /// handle generic process statistic with a processing data size and bandwitdh
  TSynMonitorWithSize = class(TSynMonitor)
  protected
    fSize: TSynMonitorSize;
    fThroughput: TSynMonitorThroughput;
    procedure LockedPerSecProperties; override;
    procedure LockedSum(another: TSynMonitor); override;
  public
    /// initialize the instance nested class properties
    constructor Create; override;
    /// finalize the instance
    destructor Destroy; override;
    /// increase the internal size counter
    // - thread-safe method
    procedure AddSize(const Bytes: QWord);
  published
    /// how many total data has been hanlded during all working process
    property Size: TSynMonitorSize read fSize;
    /// data processing bandwith, returned as B/KB/MB per second
    property Throughput: TSynMonitorThroughput read fThroughput;
  end;

  /// handle generic process statistic with a incoming and outgoing processing
  // data size and bandwitdh
  TSynMonitorInputOutput = class(TSynMonitor)
  protected
    fInput: TSynMonitorSize;
    fOutput: TSynMonitorSize;
    fInputThroughput: TSynMonitorThroughput;
    fOutputThroughput: TSynMonitorThroughput;
    procedure LockedPerSecProperties; override;
    procedure LockedSum(another: TSynMonitor); override;
  public
    /// initialize the instance nested class properties
    constructor Create; override;
    /// finalize the instance
    destructor Destroy; override;
    /// increase the internal size counters
    // - thread-safe method
    procedure AddSize(const Incoming, Outgoing: QWord);
  published
    /// how many data has been received
    property Input: TSynMonitorSize read fInput;
    /// how many data has been sent back
    property Output: TSynMonitorSize read fOutput;
    /// incoming data processing bandwith, returned as B/KB/MB per second
    property InputThroughput: TSynMonitorThroughput read fInputThroughput;
    /// outgoing data processing bandwith, returned as B/KB/MB per second
    property OutputThroughput: TSynMonitorThroughput read fOutputThroughput;
  end;

  /// could monitor a standard Server
  // - including Input/Output statistics and connected Clients count
  TSynMonitorServer = class(TSynMonitorInputOutput)
  protected
    fCurrentRequestCount: integer;
    fClientsCurrent: TSynMonitorOneCount;
    fClientsMax: TSynMonitorOneCount;
  public
    /// update ClientsCurrent and ClientsMax
    // - thread-safe method
    procedure ClientConnect;
    /// update ClientsCurrent and ClientsMax
    // - thread-safe method
    procedure ClientDisconnect;
    /// update ClientsCurrent to 0
    // - thread-safe method
    procedure ClientDisconnectAll;
    /// retrieve the number of connected clients
    // - thread-safe method
    function GetClientsCurrent: TSynMonitorOneCount;
    /// how many concurrent requests are currently processed
    // - returns the updated number of requests
    // - thread-safe method
    function AddCurrentRequestCount(diff: integer): integer;
  published
    /// current count of connected clients
    property ClientsCurrent: TSynMonitorOneCount read fClientsCurrent;
    /// max count of connected clients
    property ClientsMax: TSynMonitorOneCount read fClientsMax;
    /// how many concurrent requests are currently processed
    // - modified via AddCurrentRequestCount() in TSQLRestServer.URI()
    property CurrentRequestCount: integer read fCurrentRequestCount;
  end;

  /// a list of simple process statistics
  TSynMonitorObjArray = array of TSynMonitor;

  /// a list of data process statistics
  TSynMonitorWithSizeObjArray = array of TSynMonitorWithSize;

  /// a list of incoming/outgoing data process statistics
  TSynMonitorInputOutputObjArray = array of TSynMonitorInputOutput;

  /// class-reference type (metaclass) of a process statistic information
  TSynMonitorClass = class of TSynMonitor;


{ ******************* cross-cutting classes and functions ***************** }

type
  /// an abstract ancestor, for implementing a custom TInterfacedObject like class
  // - by default, will do nothing: no instance would be retrieved by
  // QueryInterface unless the VirtualQueryInterface protected method is
  // overriden, and _AddRef/_Release methods would call VirtualAddRef and
  // VirtualRelease pure abstract methods
  // - using this class will leverage the signature difference between Delphi
  // and FPC, among all supported platforms
  // - the class includes a RefCount integer field
  TSynInterfacedObject = class(TObject,IUnknown)
  protected
    fRefCount: integer;
    // returns E_NOINTERFACE
    function VirtualQueryInterface(const IID: TGUID; out Obj): HResult; virtual;
    // always return 1 for a "non allocated" instance (0 triggers release)
    function VirtualAddRef: Integer; virtual; abstract;
    function VirtualRelease: Integer; virtual; abstract;
    {$ifdef FPC}
    function QueryInterface(
      {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID;
      out Obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    {$else}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    {$endif}
  public
    /// the associated reference count
    property RefCount: integer read fRefCount write fRefCount;
  end;

{$ifdef CPUINTEL}
{$ifndef DELPHI5OROLDER}
  /// a simple class which will set FPU exception flags for a code block
  // - using an IUnknown interface to let the compiler auto-generate a
  // try..finally block statement to reset the FPU exception register
  // - to be used e.g. as such:
  // !begin
  // !  TSynFPUException.ForLibrayCode;
  // !  ... now FPU exceptions will be ignored
  // !  ... so here it is safe to call external libray code
  // !end; // now FPU exception will be reset as with standard Delphi
  // - it will avoid any unexpected invalid floating point operation in Delphi
  // code, whereas it was in fact triggerred in some external library code
  TSynFPUException = class(TSynInterfacedObject)
  protected
    {$ifndef CPU64}
    fExpected8087, fSaved8087: word;
    {$else}
    fExpectedMXCSR, fSavedMXCSR: word;
    {$endif}
    function VirtualAddRef: Integer; override;
    function VirtualRelease: Integer; override;
  public
    /// internal constructor
    // - do not call this constructor directly, but rather use
    // ForLibraryCode/ForDelphiCode class methods
    // - for cpu32 flags are $1372 for Delphi, or $137F for library (mask all exceptions)
    // - for cpu64 flags are $1920 for Delphi, or $1FA0 for library (mask all exceptions)
    {$ifndef CPU64}
    constructor Create(Expected8087Flag: word); reintroduce;
    {$else}
    constructor Create(ExpectedMXCSR: word); reintroduce;
    {$endif}
    /// after this method call, all FPU exceptions will be ignored
    // - until the method finishes (a try..finally block is generated by
    // the compiler), then FPU exceptions will be reset into "Delphi" mode
    // - you have to put this e.g. before calling an external libray
    // - this method is thread-safe and re-entrant (by reference-counting)
    class function ForLibraryCode: IUnknown;
    /// after this method call, all FPU exceptions will be enabled
    // - this is the Delphi normal behavior
    // - until the method finishes (a try..finally block is generated by
    // the compiler), then FPU execptions will be disabled again
    // - you have to put this e.g. before running an Delphi code from
    // a callback executed in an external libray
    // - this method is thread-safe and re-entrant (by reference-counting)
    class function ForDelphiCode: IUnknown;
  end;
{$endif DELPHI5OROLDER}
{$endif CPUINTEL}

  /// interface for TAutoFree to register another TObject instance
  // to an existing IAutoFree local variable
  IAutoFree = interface
    procedure Another(var objVar; obj: TObject);
  end;

  /// simple reference-counted storage for local objects
  // - be aware that it won't implement a full ARC memory model, but may be
  // just used to avoid writing some try ... finally blocks on local variables
  // - use with caution, only on well defined local scope
  TAutoFree = class(TInterfacedObject,IAutoFree)
  protected
    fObject: TObject;
    fObjectList: array of TObject;
  public
    /// initialize the TAutoFree class for one local variable
    // - do not call this constructor, but class function One() instead
    constructor Create(var localVariable; obj: TObject); reintroduce; overload;
    /// initialize the TAutoFree class for several local variables
    // - do not call this constructor, but class function Several() instead
    constructor Create(const varObjPairs: array of pointer); reintroduce; overload;
    /// protect one local TObject variable instance life time
    // - for instance, instead of writing:
    // !var myVar: TMyClass;
    // !begin
    // !  myVar := TMyClass.Create;
    // !  try
    // !    ... use myVar
    // !  finally
    // !    myVar.Free;
    // !  end;
    // !end;
    // - you may write:
    // !var myVar: TMyClass;
    // !begin
    // !  TAutoFree.One(myVar,TMyClass.Create);
    // !  ... use myVar
    // !end; // here myVar will be released
    // - warning: under FPC, you should assign the result of this method to a local
    // IAutoFree variable - see bug http://bugs.freepascal.org/view.php?id=26602
    class function One(var localVariable; obj: TObject): IAutoFree;
    /// protect several local TObject variable instances life time
    // - specified as localVariable/objectInstance pairs
    // - you may write:
    // !var var1,var2: TMyClass;
    // !begin
    // !  TAutoFree.Several([
    // !    @var1,TMyClass.Create,
    // !    @var2,TMyClass.Create]);
    // !  ... use var1 and var2
    // !end; // here var1 and var2 will be released
    // - warning: under FPC, you should assign the result of this method to a local
    // IAutoFree variable - see bug http://bugs.freepascal.org/view.php?id=26602
     class function Several(const varObjPairs: array of pointer): IAutoFree;
    /// protect another TObject variable to an existing IAutoFree instance life time
    // - you may write:
    // !var var1,var2: TMyClass;
    // !    auto: IAutoFree;
    // !begin
    // !  auto := TAutoFree.One(var1,TMyClass.Create);,
    // !  .... do something
    // !  auto.Another(var2,TMyClass.Create);
    // !  ... use var1 and var2
    // !end; // here var1 and var2 will be released
    procedure Another(var localVariable; obj: TObject);
    /// will finalize the associated TObject instances
    // - note that releasing the TObject instances won't be protected, so
    // any exception here may induce a memory leak: use only with "safe"
    // simple objects, e.g. mORMot's TSQLRecord
    destructor Destroy; override;
  end;

{$ifdef DELPHI5OROLDER} // IAutoLocker -> internal error C3517 under Delphi 5 :(
  TAutoLocker = class
  protected
    fSafe: TSynLocker;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enter; virtual;
    procedure Leave; virtual;
    function ProtectMethod: IUnknown;
    /// gives an access to the internal low-level TSynLocker instance used
    function Safe: PSynLocker;
    property Locker: TSynLocker read fSafe;
  end;
  IAutoLocker = TAutoLocker;
{$else DELPHI5OROLDER}
  /// an interface used by TAutoLocker to protect multi-thread execution
  IAutoLocker = interface
    ['{97559643-6474-4AD3-AF72-B9BB84B4955D}']
    /// enter the mutex
    // - any call to Enter should be ended with a call to Leave, and
    // protected by a try..finally block, as such:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.Enter;
    // !  try
    // !    ... // thread-safe code
    // !  finally
    // !    fSharedAutoLocker.Leave;
    // !  end;
    // !end;
    procedure Enter;
    /// leave the mutex
    // - any call to Leave should be preceded with a call to Enter
    procedure Leave;
    /// will enter the mutex until the IUnknown reference is released
    // - using an IUnknown interface to let the compiler auto-generate a
    // try..finally block statement to release the lock for the code block
    // - could be used as such under Delphi:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // local hidden IUnknown will release the lock for the method
    // - warning: under FPC, you should assign its result to a local variable -
    // see bug http://bugs.freepascal.org/view.php?id=26602
    // !var LockFPC: IUnknown;
    // !begin
    // !  ... // unsafe code
    // !  LockFPC := fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // LockFPC will release the lock for the method
    // or
    // !begin
    // !  ... // unsafe code
    // !  with fSharedAutoLocker.ProtectMethod do begin
    // !    ... // thread-safe code
    // !  end; // local hidden IUnknown will release the lock for the method
    // !end;
    function ProtectMethod: IUnknown;
    /// gives an access to the internal low-level TSynLocker instance used
    function Safe: PSynLocker;
  end;

  /// reference-counted block code critical section
  // - you can use one instance of this to protect multi-threaded execution
  // - the main class may initialize a IAutoLocker property in Create, then call
  // IAutoLocker.ProtectMethod in any method to make its execution thread safe
  // - this class inherits from TInterfacedObjectWithCustomCreate so you
  // could define one published property of a mORMot.pas' TInjectableObject
  // as IAutoLocker so that this class may be automatically injected
  // - you may use the inherited TAutoLockerDebug class, as defined in SynLog.pas,
  // to debug unexpected race conditions due to such critical sections
  // - consider inherit from high-level TSynPersistentLock or call low-level
  // fSafe := NewSynLocker / fSafe^.DoneAndFreemem instead
  TAutoLocker = class(TInterfacedObjectWithCustomCreate,IAutoLocker)
  protected
    fSafe: TSynLocker;
  public
    /// initialize the mutex
    constructor Create; override;
    /// finalize the mutex
    destructor Destroy; override;
    /// will enter the mutex until the IUnknown reference is released
    // - as expected by IAutoLocker interface
    // - could be used as such under Delphi:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // local hidden IUnknown will release the lock for the method
    // - warning: under FPC, you should assign its result to a local variable -
    // see bug http://bugs.freepascal.org/view.php?id=26602
    // !var LockFPC: IUnknown;
    // !begin
    // !  ... // unsafe code
    // !  LockFPC := fSharedAutoLocker.ProtectMethod;
    // !  ... // thread-safe code
    // !end; // LockFPC will release the lock for the method
    // or
    // !begin
    // !  ... // unsafe code
    // !  with fSharedAutoLocker.ProtectMethod do begin
    // !    ... // thread-safe code
    // !  end; // local hidden IUnknown will release the lock for the method
    // !end;
    function ProtectMethod: IUnknown;
    /// enter the mutex
    // - as expected by IAutoLocker interface
    // - any call to Enter should be ended with a call to Leave, and
    // protected by a try..finally block, as such:
    // !begin
    // !  ... // unsafe code
    // !  fSharedAutoLocker.Enter;
    // !  try
    // !    ... // thread-safe code
    // !  finally
    // !    fSharedAutoLocker.Leave;
    // !  end;
    // !end;
    procedure Enter; virtual;
    /// leave the mutex
    // - as expected by IAutoLocker interface
    procedure Leave; virtual;
    /// access to the locking methods of this instance
    // - as expected by IAutoLocker interface
    function Safe: PSynLocker;
    /// direct access to the locking methods of this instance
    // - faster than IAutoLocker.Safe function
    property Locker: TSynLocker read fSafe;
  end;
{$endif DELPHI5OROLDER}


{$ifndef DELPHI5OROLDER} // internal error C3517 under Delphi 5 :(
{$ifndef NOVARIANTS}
  /// ref-counted interface for thread-safe access to a TDocVariant document
  // - is implemented e.g. by TLockedDocVariant, for IoC/DI resolution
  // - fast and safe storage of any JSON-like object, as property/value pairs,
  // or a JSON-like array, as values
  ILockedDocVariant = interface
    ['{CADC2C20-3F5D-4539-9D23-275E833A86F3}']
    function GetValue(const Name: RawUTF8): Variant;
    procedure SetValue(const Name: RawUTF8; const Value: Variant);
    /// check and return a given property by name
    // - returns TRUE and fill Value with the value associated with the supplied
    // Name, using an internal lock for thread-safety
    // - returns FALSE if the Name was not found, releasing the internal lock:
    // use ExistsOrLock() if you want to add the missing value
    function Exists(const Name: RawUTF8; out Value: Variant): boolean;
    /// check and return a given property by name
    // - returns TRUE and fill Value with the value associated with the supplied
    // Name, using an internal lock for thread-safety
    // - returns FALSE and set the internal lock if Name does not exist:
    // caller should then release the lock via ReplaceAndUnlock()
    function ExistsOrLock(const Name: RawUTF8; out Value: Variant): boolean;
    /// set a value by property name, and set a local copy
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.ExistsOrLock('prop',local) then
    // !   cache.ReplaceAndUnlock('prop',newValue,local);
    // - call of this method should have been precedeed by ExistsOrLock()
    // returning false, i.e. be executed on a locked instance
    procedure ReplaceAndUnlock(const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing,
    // using an internal lock for thread-safety
    // - returns FALSE if Name is not existing in the stored document, and
    // lock the internal storage: caller should eventually release the lock
    // via AddNewPropAndUnlock()
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.AddExistingPropOrLock('Articles',Scope) then
    // !   cache.AddNewPropAndUnlock('Articles',GetArticlesFromDB,Scope);
    // here GetArticlesFromDB would occur inside the main lock
    function AddExistingPropOrLock(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object and
    // to the internal stored document, then release a previous lock
    // - call of this method should have been precedeed by AddExistingPropOrLock()
    // returning false, i.e. be executed on a locked instance
    procedure AddNewPropAndUnlock(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing
    // - returns FALSE if Name is not existing in the stored document
    // - this method would use a lock during the Name lookup, but would always
    // release the lock, even if returning FALSE (see AddExistingPropOrLock)
    function AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object
    // - this method would not expect the resource to be locked when called,
    // as with AddNewPropAndUnlock
    // - will use the internal lock for thread-safety
    // - if the Name is already existing, would update/change the existing value
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.AddExistingProp('Articles',Scope) then
    // !   cache.AddNewProp('Articles',GetArticlesFromDB,Scope);
    // here GetArticlesFromDB would occur outside the main lock
    procedure AddNewProp(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// append a value to the internal TDocVariant document array
    // - you should not use this method in conjunction with other document-based
    // alternatives, like Exists/AddExistingPropOrLock or AddExistingProp
    procedure AddItem(const Value: variant);
    /// makes a thread-safe copy of the internal TDocVariant document object or array
    function Copy: variant;
    /// delete all stored properties
    procedure Clear;
    /// save the stored values as UTF-8 encoded JSON Object
    function ToJSON(HumanReadable: boolean=false): RawUTF8;
    /// the document fields would be safely accessed via this property
    // - this is the main entry point of this storage
    // - will raise an EDocVariant exception if Name does not exist at reading
    // - implementation class would make a thread-safe copy of the variant value
    property Value[const Name: RawUTF8]: Variant read GetValue write SetValue; default;
  end;

  /// allows thread-safe access to a TDocVariant document
  // - this class inherits from TInterfacedObjectWithCustomCreate so you
  // could define one published property of a mORMot.pas' TInjectableObject
  // as ILockedDocVariant so that this class may be automatically injected
  TLockedDocVariant = class(TInterfacedObjectWithCustomCreate,ILockedDocVariant)
  protected
    fValue: TDocVariantData;
    fLock: TAutoLocker;
    function GetValue(const Name: RawUTF8): Variant;
    procedure SetValue(const Name: RawUTF8; const Value: Variant);
  public
    /// initialize the thread-safe document with a fast TDocVariant
    // - i.e. call Create(true) aka Create(JSON_OPTIONS[true])
    // - will be the TInterfacedObjectWithCustomCreate default constructor,
    // called e.g. during IoC/DI resolution
    constructor Create; overload; override;
    /// initialize the thread-safe document storage
    constructor Create(FastStorage: boolean); reintroduce; overload;
    /// initialize the thread-safe document storage with the corresponding options
    constructor Create(options: TDocVariantOptions); reintroduce; overload;
    /// finalize the storage
    destructor Destroy; override;
    /// check and return a given property by name
    function Exists(const Name: RawUTF8; out Value: Variant): boolean;
    /// check and return a given property by name
    // - this version
    function ExistsOrLock(const Name: RawUTF8; out Value: Variant): boolean;
    /// set a value by property name, and set a local copy
    procedure ReplaceAndUnlock(const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing
    // - returns FALSE if Name is not existing in the stored document
    function AddExistingPropOrLock(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object and
    // to the internal stored document
    procedure AddNewPropAndUnlock(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// add an existing property value to the given TDocVariant document object
    // - returns TRUE and add the Name/Value pair to Obj if Name is existing
    // - returns FALSE if Name is not existing in the stored document
    // - this method would use a lock during the Name lookup, but would always
    // release the lock, even if returning FALSE (see AddExistingPropOrLock)
    function AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object
    // - this method would not expect the resource to be locked when called,
    // as with AddNewPropAndUnlock
    // - will use the internal lock for thread-safety
    // - if the Name is already existing, would update/change the existing value
    procedure AddNewProp(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// append a value to the internal TDocVariant document array
    procedure AddItem(const Value: variant);
    /// makes a thread-safe copy of the internal TDocVariant document object or array
    function Copy: variant;
    /// delete all stored properties
    procedure Clear;
    /// save the stored value as UTF-8 encoded JSON Object
    // - implemented as just a wrapper around VariantSaveJSON()
    function ToJSON(HumanReadable: boolean=false): RawUTF8;
    /// the document fields would be safely accessed via this property
    // - will raise an EDocVariant exception if Name does not exist
    // - result variant is returned as a copy, not as varByRef, since a copy
    // will definitively be more thread safe
    property Value[const Name: RawUTF8]: Variant read GetValue write SetValue; default;
  end;
{$endif}
{$endif}

type
  /// class-reference type (metaclass) of an TSynPersistentLock class
  TSynPersistentLockClass = class of TSynPersistentLock;

  /// abstract dynamic array of TSynPersistentLock instance
  // - note defined as T*ObjArray, since it won't
  TSynPersistentLockDynArray = array of TSynPersistentLock;

  /// maintain a thread-safe sorted list of TSynPersistentLock objects
  // - will use fast O(log(n)) binary search for efficient search - it is
  // a lighter alternative to TObjectListHashedAbstract/TObjectListPropertyHashed
  // if hashing has a performance cost (e.g. if there are a few items, or
  // deletion occurs regularly)
  // - in practice, insertion becomes slower after around 100,000 items stored
  // - expect to store only TSynPersistentLock inherited items, so that
  // the process is explicitly thread-safe
  // - inherited classes should override the Compare and NewItem abstract methods
  TObjectListSorted = class(TSynPersistentLock)
  protected
    fCount: integer;
    fObjArray: TSynPersistentLockDynArray;
    function FastLocate(const Value; out Index: Integer): boolean;
    procedure InsertNew(Item: TSynPersistentLock; Index: integer);
    // override those methods for actual implementation
    function Compare(Item: TSynPersistentLock; const Value): integer; virtual; abstract;
    function NewItem(const Value): TSynPersistentLock; virtual; abstract;
  public
    /// finalize the list
    destructor Destroy; override;
    /// search a given TSynPersistentLock instance from a value
    // - if returns not nil, caller should make result.Safe.UnLock once finished
    // - will use the TObjectListSortedCompare function for the search
    function FindLocked(const Value): pointer;
    /// search or add a given TSynPersistentLock instance from a value
    // - if returns not nil, caller should make result.Safe.UnLock once finished
    // - added is TRUE if a new void item has just been created
    // - will use the TObjectListSortedCompare function for the search
    function FindOrAddLocked(const Value; out added: boolean): pointer;
    /// remove a given TSynPersistentLock instance from a value
    function Delete(const Value): boolean;
    /// how many items are actually stored
    property Count: Integer read fCount;
    /// low-level access to the stored items
    // - warning: use should be protected by Lock.Enter/Lock.Leave
    property ObjArray: TSynPersistentLockDynArray read fObjArray;
  end;


/// convert a size to a human readable value power-of-two metric value
// - append EB, PB, TB, GB, MB, KB or B symbol with or without preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
procedure KB(bytes: Int64; out result: TShort16; nospace: boolean); overload;

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol with preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KB(bytes: Int64): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol without preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KBNoSpace(bytes: Int64): TShort16;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol with or without preceding space
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KB(bytes: Int64; nospace: boolean): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a string size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
function KB(const buffer: RawByteString): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif}

/// convert a size to a human readable value
// - append EB, PB, TB, GB, MB, KB or B symbol
// - for EB, PB, TB, GB, MB and KB, add one fractional digit
procedure KBU(bytes: Int64; var result: RawUTF8);

/// convert a micro seconds elapsed time into a human readable value
// - append 'us', 'ms', 's', 'm', 'h' and 'd' symbol for the given value range,
// with two fractional digits
function MicroSecToString(Micro: QWord): TShort16; overload;
  {$ifdef FPC_OR_UNICODE}inline;{$endif} // Delphi 2007 is buggy as hell

/// convert a micro seconds elapsed time into a human readable value
// - append 'us', 'ms', 's', 'm', 'h' and 'd' symbol for the given value range,
// with two fractional digits
procedure MicroSecToString(Micro: QWord; out result: TShort16); overload;

/// convert an integer value into its textual representation with thousands marked
// - ThousandSep is the character used to separate thousands in numbers with
// more than three digits to the left of the decimal separator
function IntToThousandString(Value: integer; const ThousandSep: TShort4=','): shortstring;

/// return the Delphi/FPC Compiler Version
// - returns 'Delphi 2007', 'Delphi 2010' or 'Free Pascal 3.3.1' e.g.
function GetDelphiCompilerVersion: RawUTF8;

/// returns TRUE if the supplied mutex has been initialized
// - will check if the supplied mutex is void (i.e. all filled with 0 bytes)
function IsInitializedCriticalSection(const CS: TRTLCriticalSection): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// on need initialization of a mutex, then enter the lock
// - if the supplied mutex has been initialized, do nothing
// - if the supplied mutex is void (i.e. all filled with 0), initialize it
procedure InitializeCriticalSectionIfNeededAndEnter(var CS: TRTLCriticalSection);
  {$ifdef HASINLINE}inline;{$endif}

/// on need finalization of a mutex
// - if the supplied mutex has been initialized, delete it
// - if the supplied mutex is void (i.e. all filled with 0), do nothing
procedure DeleteCriticalSectionIfNeeded(var CS: TRTLCriticalSection);

/// compress a data content using the SynLZ algorithm
// - as expected by THttpSocket.RegisterCompress
// - will return 'synlz' as ACCEPT-ENCODING: header parameter
// - will store a hash of both compressed and uncompressed stream: if the
// data is corrupted during transmission, will instantly return ''
function CompressSynLZ(var DataRawByteString; Compress: boolean): AnsiString;

/// compress a data content using the SynLZ algorithm from one stream into another
// - returns the number of bytes written to Dest
// - you should specify a Magic number to be used to identify the block
function StreamSynLZ(Source: TCustomMemoryStream; Dest: TStream;
  Magic: cardinal): integer; overload;

/// compress a data content using the SynLZ algorithm from one stream into a file
// - returns the number of bytes written to the destination file
// - you should specify a Magic number to be used to identify the block
function StreamSynLZ(Source: TCustomMemoryStream; const DestFile: TFileName;
  Magic: cardinal): integer; overload;

/// uncompress using the SynLZ algorithm from one stream into another
// - returns a newly create memory stream containing the uncompressed data
// - returns nil if source data is invalid
// - you should specify a Magic number to be used to identify the block
// - this function will also recognize the block at the end of the source stream
// (if was appended to an existing data - e.g. a .mab at the end of a .exe)
// - on success, Source will point after all read data (so that you can e.g.
// append several data blocks to the same stream)
function StreamUnSynLZ(Source: TStream; Magic: cardinal): TMemoryStream; overload;

/// compute the real length of a given StreamSynLZ-compressed buffer
// - allows to replace an existing appended content, for instance
function StreamSynLZComputeLen(P: PAnsiChar; Len, aMagic: cardinal): integer;

/// uncompress using the SynLZ algorithm from one file into another
// - returns a newly create memory stream containing the uncompressed data
// - returns nil if source file is invalid (e.g. invalid name or invalid content)
// - you should specify a Magic number to be used to identify the block
// - this function will also recognize the block at the end of the source file
// (if was appended to an existing data - e.g. a .mab at the end of a .exe)
function StreamUnSynLZ(const Source: TFileName; Magic: cardinal): TMemoryStream; overload;

/// compress a file content using the SynLZ algorithm a file content
// - source file is split into 128 MB blocks for fast in-memory compression of
// any file size
// - you should specify a Magic number to be used to identify the compressed
// file format
function FileSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;

/// compress a file content using the SynLZ algorithm a file content
// - you should specify a Magic number to be used to identify the compressed
// file format
function FileUnSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;

/// returns TRUE if the supplied file name is a SynLZ compressed file,
// matching the Magic number as supplied to FileSynLZ() function
function FileIsSynLZ(const Name: TFileName; Magic: Cardinal): boolean;

var
  /// acccess to our fast SynLZ compression as a TAlgoCompress class
  // - please use this global variable methods instead of the deprecated
  // SynLZCompress/SynLZDecompress wrapper functions
  AlgoSynLZ: TAlgoCompress;

const
  /// CompressionSizeTrigger parameter SYNLZTRIG[true] will disable then
  // SynLZCompress() compression
  SYNLZTRIG: array[boolean] of integer = (100, maxInt);
  /// used e.g. as when ALGO_SAFE[SafeDecompression] for TAlgoCompress.Decompress
  ALGO_SAFE: array[boolean] of TAlgoCompressLoad = (aclNormal, aclSafeSlow);


/// deprecated function - please call AlgoSynLZ.Compress() method
function SynLZCompress(const Data: RawByteString; CompressionSizeTrigger: integer=100;
  CheckMagicForCompressed: boolean=false): RawByteString; overload;

/// deprecated function - please call AlgoSynLZ.Compress() method
procedure SynLZCompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  CompressionSizeTrigger: integer=100; CheckMagicForCompressed: boolean=false); overload;

/// deprecated function - please call AlgoSynLZ.Compress() method
function SynLZCompress(P, Dest: PAnsiChar; PLen, DestLen: integer;
  CompressionSizeTrigger: integer=100; CheckMagicForCompressed: boolean=false): integer; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(const Data: RawByteString): RawByteString; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
procedure SynLZDecompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  SafeDecompression: boolean=false); overload;

/// deprecated function - please call AlgoSynLZ.DecompressToBytes() method
function SynLZCompressToBytes(const Data: RawByteString;
  CompressionSizeTrigger: integer=100): TByteDynArray; overload;

/// deprecated function - please call AlgoSynLZ.CompressToBytes() method
function SynLZCompressToBytes(P: PAnsiChar; PLen: integer;
  CompressionSizeTrigger: integer=100): TByteDynArray; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(const Data: TByteDynArray): RawByteString; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(const Data: RawByteString; out Len: integer;
  var tmp: RawByteString): pointer; overload;

/// deprecated function - please call AlgoSynLZ.Decompress() method
function SynLZDecompress(P: PAnsiChar; PLen: integer; out Len: integer;
  var tmp: RawByteString): pointer; overload;

/// deprecated function - please call AlgoSynLZ.DecompressHeader() method
function SynLZDecompressHeader(P: PAnsiChar; PLen: integer): integer;

/// deprecated function - please call AlgoSynLZ.DecompressBody() method
function SynLZDecompressBody(P,Body: PAnsiChar; PLen,BodyLen: integer;
  SafeDecompression: boolean=false): boolean;

/// deprecated function - please call AlgoSynLZ.DecompressPartial() method
function SynLZDecompressPartial(P,Partial: PAnsiChar; PLen,PartialLen: integer): integer;


resourcestring
  sInvalidIPAddress = '"%s" is an invalid IP v4 address';
  sInvalidEmailAddress = '"%s" is an invalid email address';
  sInvalidPattern = '"%s" does not match the expected pattern';
  sCharacter01n = 'character,character,characters';
  sInvalidTextLengthMin = 'Expect at least %d %s';
  sInvalidTextLengthMax = 'Expect up to %d %s';
  sInvalidTextChar = 'Expect at least %d %s %s,Expect up to %d %s %s,'+
    'alphabetical,digital,punctuation,lowercase,uppercase,space,'+
    'Too much spaces on the left,Too much spaces on the right';
  sValidationFailed = '"%s" rule failed';
  sValidationFieldVoid = 'An unique key field must not be void';
  sValidationFieldDuplicate = 'Value already used for this unique key field';


implementation

{$ifdef FPC}
uses
  {$ifdef LINUX}
  Unix,
  dynlibs,
  termio,
  {$ifdef BSD}
  sysctl,
  {$else}
  Linux,
  SysCall,
  {$endif BSD}
  {$ifdef FPCUSEVERSIONINFO} // to be enabled in Synopse.inc
    fileinfo, // FPC 3.0 and up
    {$ifdef DARWIN}
      machoreader, // MACH-O executables
    {$else}
      elfreader, // ELF executables
    {$endif DARWIN}
  {$endif FPCUSEVERSIONINFO}
  {$ifdef ISFPC271}
    unixcp, // for GetSystemCodePage
  {$endif}
  SynFPCLinux,
  {$endif LINUX}
  SynFPCTypInfo; // small wrapper unit around FPC's TypInfo.pp
{$endif FPC}


{ ************ some fast UTF-8 / Unicode / Ansi conversion routines }

var
  // internal list of TSynAnsiConvert instances
  SynAnsiConvertList: TObjectList = nil;

// some constants used for UTF-8 conversion, including surrogates
const
  UTF16_HISURROGATE_MIN = $d800;
  UTF16_HISURROGATE_MAX = $dbff;
  UTF16_LOSURROGATE_MIN = $dc00;
  UTF16_LOSURROGATE_MAX = $dfff;
  UTF8_EXTRABYTES: array[$80..$ff] of byte = (
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,0,0);
  UTF8_EXTRA: array[0..6] of record
    offset, minimum: cardinal;
  end = ( // http://floodyberry.wordpress.com/2007/04/14/utf-8-conversion-tricks
    (offset: $00000000;  minimum: $00010000),
    (offset: $00003080;  minimum: $00000080),
    (offset: $000e2080;  minimum: $00000800),
    (offset: $03c82080;  minimum: $00010000),
    (offset: $fa082080;  minimum: $00200000),
    (offset: $82082080;  minimum: $04000000),
    (offset: $00000000;  minimum: $04000000));
  UTF8_EXTRA_SURROGATE = 3;
  UTF8_FIRSTBYTE: array[2..6] of byte = ($c0,$e0,$f0,$f8,$fc);

{$ifdef FPC}
function _LStrLen(const s: RawByteString): SizeInt; inline;
begin // here caller ensured s<>''
  result := PSizeInt(PAnsiChar(pointer(s))-SizeOf(SizeInt))^;
end;

function _LStrLenP(s: pointer): SizeInt; inline;
begin // here caller ensured s<>''
  result := PSizeInt(PAnsiChar(s)-SizeOf(SizeInt))^;
end;
{$endif FPC}


{ TSynAnsiConvert }

{$ifdef MSWINDOWS}
const
  DefaultCharVar: AnsiChar = '?';
{$endif}

function TSynAnsiConvert.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
var c: cardinal;
{$ifndef MSWINDOWS}
{$ifdef FPC}
    tmp: UnicodeString;
{$endif}
{$ifdef KYLIX3}
    ic: iconv_t;
    DestBegin: PAnsiChar;
    SourceCharsBegin: integer;
{$endif}
{$endif}
begin
  {$ifdef KYLIX3}
  SourceCharsBegin := SourceChars;
  DestBegin := pointer(Dest);
  {$endif}
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars>=4 then
  repeat
    c := PCardinal(Source)^;
    if c and $80808080<>0 then
      break; // break on first non ASCII quad
    dec(SourceChars,4);
    inc(Source,4);
    PCardinal(Dest)^ := (c shl 8 or (c and $FF)) and $00ff00ff;
    c := c shr 16;
    PCardinal(Dest+2)^ := (c shl 8 or c) and $00ff00ff;
    inc(Dest,4);
  until SourceChars<4;
  if (SourceChars>0) and (ord(Source^)<128) then
  repeat
    dec(SourceChars);
    PWord(Dest)^ := ord(Source^); // much faster than dest^ := WideChar(c) for FPC
    inc(Source);
    inc(Dest);
  until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else begin
    {$ifdef MSWINDOWS}
    result := Dest+MultiByteToWideChar(
      fCodePage,MB_PRECOMPOSED,Source,SourceChars,Dest,SourceChars);
    {$else}
    {$ifdef ISDELPHIXE} // use cross-platform wrapper for MultiByteToWideChar()
    result := Dest+UnicodeFromLocaleChars(
      fCodePage,MB_PRECOMPOSED,Source,SourceChars,Dest,SourceChars);
    {$else}
    {$ifdef FPC}
    widestringmanager.Ansi2UnicodeMoveProc(Source,
      {$ifdef ISFPC27}fCodePage,{$endif}tmp,SourceChars);
    MoveFast(Pointer(tmp)^,Dest^,length(tmp)*2);
    result := Dest+length(tmp);
    {$else}
    {$ifdef KYLIX3}
    result := Dest; // makes compiler happy
    ic := LibC.iconv_open('UTF-16LE',Pointer(fIConvCodeName));
    if PtrInt(ic)>=0 then
    try
      result := IconvBufConvert(ic,Source,SourceChars,1,
        Dest,SourceCharsBegin*2-(PAnsiChar(Dest)-DestBegin),2);
    finally
      LibC.iconv_close(ic);
    end else
    {$else}
    raise ESynException.CreateUTF8('%.AnsiBufferToUnicode() not supported yet for CP=%',
      [self,CodePage]);
    {$endif KYLIX3}
    {$endif FPC}
    {$endif ISDELPHIXE}
    {$endif MSWINDOWS}
  end;
  if not NoTrailingZero then
    result^ := #0;
end;

function TSynAnsiConvert.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
var tmp: array[0..256*6] of WideChar;
    c: cardinal;
    U: PWideChar;
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars>=4 then
    repeat
      c := PCardinal(Source)^;
      if c and $80808080<>0 then
        break; // break on first non ASCII quad
      PCardinal(Dest)^ := c;
      dec(SourceChars,4);
      inc(Source,4);
      inc(Dest,4);
    until SourceChars<4;
  if (SourceChars>0) and (ord(Source^)<128) then
    repeat
      Dest^ := Source^;
      dec(SourceChars);
      inc(Source);
      inc(Dest);
    until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else
    if SourceChars<SizeOf(tmp)div 3 then
      result := Dest+RawUnicodeToUTF8(Dest,SourceChars*3,tmp,
        (PtrUInt(AnsiBufferToUnicode(tmp,Source,SourceChars))-PtrUInt(@tmp))shr 1,
        [ccfNoTrailingZero]) else begin
      GetMem(U,SourceChars*3+2);
      result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,U,
        AnsiBufferToUnicode(U,Source,SourceChars)-U,[ccfNoTrailingZero]);
      FreeMem(U);
    end;
  if not NoTrailingZero then
    result^ := #0;
end;

// UTF-8 is AT MOST 50% bigger than UTF-16 in bytes in range U+0800..U+FFFF
// see http://stackoverflow.com/a/7008095 -> WideCharCount*3 below

procedure TSynAnsiConvert.InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
  DestTextWriter: TObject; Escape: TTextWriterKind);
var W: TTextWriter absolute DestTextWriter;
    tmp: TSynTempBuffer;
begin // rely on explicit conversion
  SourceChars := AnsiBufferToUTF8(tmp.Init(SourceChars*3+1),Source,SourceChars)-tmp.buf;
  W.Add(tmp.buf,SourceChars,Escape);
  tmp.Done;
end;

function TSynAnsiConvert.AnsiToRawUnicode(const AnsiText: RawByteString): RawUnicode;
begin
  result := AnsiToRawUnicode(pointer(AnsiText),length(AnsiText));
end;

function TSynAnsiConvert.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
var U: PWideChar;
begin
  if SourceChars=0 then
    result := '' else begin
    SetString(result,nil,SourceChars*2+1);
    U := AnsiBufferToUnicode(pointer(result),Source,SourceChars);
    U^ := #0;
    SetLength(result,PtrUInt(U)-PtrUInt(result)+1);
  end;
end;

function TSynAnsiConvert.AnsiToUnicodeString(Source: PAnsiChar; SourceChars: Cardinal): SynUnicode;
var tmp: TSynTempBuffer;
    U: PWideChar;
begin
  if SourceChars=0 then
    result := '' else begin
    tmp.Init(SourceChars*2+1); // max dest size in bytes (including trailing #0 widechar)
    U := AnsiBufferToUnicode(tmp.buf,Source,SourceChars);
    SetString(result,PWideChar(tmp.buf),(PtrUInt(U)-PtrUInt(tmp.buf))shr 1);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.AnsiToUnicodeString(const Source: RawByteString): SynUnicode;
var tmp: TSynTempBuffer;
    U: PWideChar;
begin
  if Source='' then
    result := '' else begin
    tmp.Init(length(Source)*2+1); // max dest size in bytes
    U := AnsiBufferToUnicode(tmp.buf,pointer(Source),length(Source));
    SetString(result,PWideChar(tmp.buf),(PtrUInt(U)-PtrUInt(tmp.buf))shr 1);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
begin
  result := AnsiBufferToRawUTF8(pointer(AnsiText),length(AnsiText));
end;

function TSynAnsiConvert.AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8;
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else
    tmp.Done(AnsiBufferToUTF8(tmp.Init(SourceChars*3+1),Source,SourceChars),result);
end;

constructor TSynAnsiConvert.Create(aCodePage: cardinal);
begin
  fCodePage := aCodePage;
  fAnsiCharShift := 1; // default is safe
  {$ifdef KYLIX3}
  fIConvCodeName := 'CP'+UInt32ToUTF8(aCodePage);
  {$endif}
end;

function IsFixedWidthCodePage(aCodePage: cardinal): boolean;
begin
  result := ((aCodePage>=1250) and (aCodePage<=1258)) or
             (aCodePage=CODEPAGE_LATIN1) or (aCodePage=CP_RAWBYTESTRING);
end;

class function TSynAnsiConvert.Engine(aCodePage: cardinal): TSynAnsiConvert;
var i: integer;
begin
  if SynAnsiConvertList=nil then begin
    GarbageCollectorFreeAndNil(SynAnsiConvertList,TObjectList.Create);
    CurrentAnsiConvert := TSynAnsiConvert.Engine(GetACP);
    WinAnsiConvert := TSynAnsiConvert.Engine(CODEPAGE_US) as TSynAnsiFixedWidth;
    UTF8AnsiConvert := TSynAnsiConvert.Engine(CP_UTF8) as TSynAnsiUTF8;
  end;
  if aCodePage<=0 then begin
    result := CurrentAnsiConvert;
    exit;
  end;
  with SynAnsiConvertList do
    for i := 0 to Count-1 do begin
      result := List[i];
      if result.CodePage=aCodePage then
        exit;
    end;
  if aCodePage=CP_UTF8 then
    result := TSynAnsiUTF8.Create(CP_UTF8) else
  if aCodePage=CP_UTF16 then
    result := TSynAnsiUTF16.Create(CP_UTF16) else
  if IsFixedWidthCodePage(aCodePage) then
    result := TSynAnsiFixedWidth.Create(aCodePage) else
    result := TSynAnsiConvert.Create(aCodePage);
  SynAnsiConvertList.Add(result);
end;

function TSynAnsiConvert.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
{$ifndef MSWINDOWS}
{$ifdef FPC}
    tmp: RawByteString;
{$endif}
{$ifdef KYLIX3}
    ic: iconv_t;
    DestBegin: PAnsiChar;
    SourceCharsBegin: integer;
{$endif}
{$endif MSWINDOWS}
begin
  {$ifdef KYLIX3}
  SourceCharsBegin := SourceChars;
  DestBegin := Dest;
  {$endif}
  // first handle trailing 7 bit ASCII chars, by pairs (Sha optimization)
  if SourceChars>=2 then
    repeat
      c := PCardinal(Source)^;
      if c and $ff80ff80<>0 then
        break; // break on first non ASCII pair
      dec(SourceChars,2);
      inc(Source,2);
      c := c shr 8 or c;
      PWord(Dest)^ := c;
      inc(Dest,2);
    until SourceChars<2;
  if (SourceChars>0) and (ord(Source^)<128) then
    repeat
      Dest^ := AnsiChar(ord(Source^));
      dec(SourceChars);
      inc(Source);
      inc(Dest);
    until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else begin
    {$ifdef MSWINDOWS}
    result := Dest+WideCharToMultiByte(
      fCodePage,0,Source,SourceChars,Dest,SourceChars*3,@DefaultCharVar,nil);
    {$else}
    {$ifdef ISDELPHIXE} // use cross-platform wrapper for WideCharToMultiByte()
    result := Dest+System.LocaleCharsFromUnicode(
      fCodePage,0,Source,SourceChars,Dest,SourceChars*3,@DefaultCharVar,nil);
    {$else}
    {$ifdef FPC}
    widestringmanager.Unicode2AnsiMoveProc(Source,tmp,
      {$ifdef ISFPC27}fCodePage,{$endif}SourceChars);
    MoveFast(Pointer(tmp)^,Dest^,length(tmp));
    result := Dest+length(tmp);
    {$else}
    {$ifdef KYLIX3}
    result := Dest; // makes compiler happy
    ic := LibC.iconv_open(Pointer(fIConvCodeName),'UTF-16LE');
    if PtrInt(ic)>=0 then
    try
      result := IconvBufConvert(ic,Source,SourceChars,2,
        Dest,SourceCharsBegin*3-(PAnsiChar(Dest)-DestBegin),1);
    finally
      LibC.iconv_close(ic);
    end else
    {$else}
    raise ESynException.CreateUTF8('%.UnicodeBufferToAnsi() not supported yet for CP=%',
      [self,CodePage]);    {$endif KYLIX3}
    {$endif FPC}
    {$endif ISDELPHIXE}
    {$endif MSWINDOWS}
  end;
end;

function TSynAnsiConvert.UTF8BufferToAnsi(Dest: PAnsiChar;
  Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar;
var tmp: array[0..256*6] of WideChar;
    U: PWideChar;
begin
  if SourceChars<SizeOf(tmp)div 3 then
    result := UnicodeBufferToAnsi(Dest,tmp,UTF8ToWideChar(tmp,Source,SourceChars) shr 1) else begin
    Getmem(U,SourceChars*3+2);
    result := UnicodeBufferToAnsi(Dest,U,UTF8ToWideChar(U,Source,SourceChars) shr 1);
    Freemem(U);
  end;
end;

function TSynAnsiConvert.UTF8BufferToAnsi(Source: PUTF8Char;
  SourceChars: Cardinal): RawByteString;
begin
  UTF8BufferToAnsi(Source,SourceChars,result);
end;

procedure TSynAnsiConvert.UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
  var result: RawByteString);
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    tmp.Init((SourceChars+1) shl fAnsiCharShift);
    FastSetStringCP(result,tmp.buf,
      Utf8BufferToAnsi(tmp.buf,Source,SourceChars)-tmp.buf,fCodePage);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
begin
  UTF8BufferToAnsi(pointer(UTF8),length(UTF8),result);
end;

function TSynAnsiConvert.Utf8ToAnsiBuffer(const S: RawUTF8;
  Dest: PAnsiChar; DestSize: integer): integer;
var tmp: array[0..2047] of AnsiChar; // truncated to 2KB as documented
begin
  if (DestSize<=0) or (Dest=nil) then begin
    result := 0;
    exit;
  end;
  result := length(s);
  if result>0 then begin
    if result>SizeOf(tmp) then
      result := SizeOf(tmp);
    result := UTF8BufferToAnsi(tmp,pointer(s),result)-tmp;
    if result>=DestSize then
      result := DestSize-1;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(tmp,Dest^,result);
  end;
  Dest[result] := #0;
end;

function TSynAnsiConvert.UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString;
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    tmp.Init((SourceChars+1) shl fAnsiCharShift);
    FastSetStringCP(result,tmp.buf,
      UnicodeBufferToAnsi(tmp.buf,Source,SourceChars)-tmp.buf,fCodePage);
    tmp.Done;
  end;
end;

function TSynAnsiConvert.RawUnicodeToAnsi(const Source: RawUnicode): RawByteString;
begin
  result := UnicodeBufferToAnsi(pointer(Source),length(Source) shr 1);
end;

function TSynAnsiConvert.AnsiToAnsi(From: TSynAnsiConvert; const Source: RawByteString): RawByteString;
begin
  if From=self then
    result := Source else
    result := AnsiToAnsi(From,pointer(Source),length(Source));
end;

function TSynAnsiConvert.AnsiToAnsi(From: TSynAnsiConvert; Source: PAnsiChar; SourceChars: cardinal): RawByteString;
var tmpU: array[byte] of WideChar;
    U: PWideChar;
begin
  if From=self then
    FastSetStringCP(result,Source,SourceChars,fCodePage) else
  if (Source=nil) or (SourceChars=0) then
    result := '' else
  if SourceChars<SizeOf(tmpU) shr 1 then
    result := UnicodeBufferToAnsi(tmpU,
      (PtrUInt(From.AnsiBufferToUnicode(tmpU,Source,SourceChars))-PtrUInt(@tmpU))shr 1) else begin
    GetMem(U,SourceChars*2+2);
    result := UnicodeBufferToAnsi(U,From.AnsiBufferToUnicode(U,Source,SourceChars)-U);
    FreeMem(U);
  end;
end;


{ TSynAnsiFixedWidth }

function TSynAnsiFixedWidth.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
var i: Integer;
begin
  // PWord*(Dest)[] is much faster than dest^ := WideChar(c) for FPC
  for i := 1 to SourceChars shr 2 do begin
    PWordArray(Dest)[0] := fAnsiToWide[Ord(Source[0])];
    PWordArray(Dest)[1] := fAnsiToWide[Ord(Source[1])];
    PWordArray(Dest)[2] := fAnsiToWide[Ord(Source[2])];
    PWordArray(Dest)[3] := fAnsiToWide[Ord(Source[3])];
    inc(Source,4);
    inc(Dest,4);
  end;
  for i := 1 to SourceChars and 3 do begin
    PWord(Dest)^ := fAnsiToWide[Ord(Source^)];
    inc(Dest);
    inc(Source);
  end;
  if not NoTrailingZero then
    Dest^ := #0;
  result := Dest;
end;

{$ifdef CPUARM} // circumvent FPC issue on ARM
function ToByte(value: cardinal): cardinal; inline;
begin
  result := value and $ff;
end;
{$else}
type ToByte = byte;
{$endif}

function TSynAnsiFixedWidth.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
var EndSource, EndSourceBy4: PAnsiChar;
    c: Cardinal;
label By4, By1; // ugly but faster
begin
  if (self=nil) or (Dest=nil) then begin
    Result := nil;
    Exit;
  end else
  if (Source<>nil) and (SourceChars>0) then begin
    // handle 7 bit ASCII WideChars, by quads (Sha optimization)
    EndSource := Source+SourceChars;
    EndSourceBy4 := EndSource-4;
    if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then
    repeat
By4:  c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      inc(Source,4);
      PCardinal(Dest)^ := c;
      inc(Dest,4);
    until Source>EndSourceBy4;
    // generic loop, handling one WideChar per iteration
    if Source<EndSource then
    repeat
By1:  c := byte(Source^); inc(Source);
      if c<=$7F then begin
        Dest^ := AnsiChar(c); // 0..127 don't need any translation
        Inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end
      else begin // no surrogate is expected in TSynAnsiFixedWidth charsets
        c := fAnsiToWide[c]; // convert FixedAnsi char into Unicode char
        if c>$7ff then begin
          Dest[0] := AnsiChar($E0 or (c shr 12));
          Dest[1] := AnsiChar($80 or ((c shr 6) and $3F));
          Dest[2] := AnsiChar($80 or (c and $3F));
          Inc(Dest,3);
          if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
          if Source<EndSource then continue else break;
        end else begin
          Dest[0] := AnsiChar($C0 or (c shr 6));
          Dest[1] := AnsiChar($80 or (c and $3F));
          Inc(Dest,2);
          if (PtrUInt(Source) and 3=0) and (Source<EndSourceBy4) then goto By4;
          if Source<endSource then continue else break;
        end;
      end;
    until false;
  end;
  if not NoTrailingZero then
    Dest^ := #0;
  Result := Dest;
end;

procedure TSynAnsiFixedWidth.InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
  DestTextWriter: TObject; Escape: TTextWriterKind);
begin
  TTextWriter(DestTextWriter).InternalAddFixedAnsi(Source,SourceChars,fAnsiToWide,Escape);
end;

function TSynAnsiFixedWidth.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
begin
  if SourceChars=0 then
    result := '' else begin
    SetString(result,nil,SourceChars*2+1);
    AnsiBufferToUnicode(pointer(result),Source,SourceChars);
  end;
end;

const
  /// used for fast WinAnsi to Unicode conversion
  // - this table contain all the unicode characters corresponding to
  // the Ansi Code page 1252 (i.e. WinAnsi), which unicode value are > 255
  // - values taken from MultiByteToWideChar(1252,0,@Tmp,256,@WinAnsiTable,256)
  // so these values are available outside the Windows platforms (e.g. Linux/BSD)
  // and even if registry has been tweaked as such:
  // http://www.fas.harvard.edu/~chgis/data/chgis/downloads/v4/howto/cyrillic.html
  WinAnsiUnicodeChars: packed array[128..159] of word =
    (8364, 129, 8218, 402, 8222, 8230, 8224, 8225, 710, 8240, 352, 8249, 338,
     141, 381, 143, 144, 8216, 8217, 8220, 8221, 8226, 8211, 8212, 732, 8482,
     353, 8250, 339, 157, 382, 376);

constructor TSynAnsiFixedWidth.Create(aCodePage: cardinal);
var i: PtrInt;
    A256: array[0..256] of AnsiChar;
    U256: array[0..256] of WideChar; // AnsiBufferToUnicode() write a last #0
begin
  inherited;
  if not IsFixedWidthCodePage(aCodePage) then
    // ESynException.CreateUTF8() uses UTF8ToString() -> use CreateFmt() here
    raise ESynException.CreateFmt('%s.Create - Invalid code page %d',
      [ClassName,fCodePage]);
  // create internal look-up tables
  SetLength(fAnsiToWide,256);
  if (aCodePage=CODEPAGE_US) or (aCodePage=CODEPAGE_LATIN1) or
     (aCodePage=CP_RAWBYTESTRING) then begin
    for i := 0 to 255 do
      fAnsiToWide[i] := i;
    if aCodePage=CODEPAGE_US then // do not trust the Windows API :(
      for i := low(WinAnsiUnicodeChars) to high(WinAnsiUnicodeChars) do
        fAnsiToWide[i] := WinAnsiUnicodeChars[i];
  end else begin // from Operating System returned values
    for i := 0 to 255 do
      A256[i] := AnsiChar(i);
    FillcharFast(U256,SizeOf(U256),0);
    if PtrUInt(inherited AnsiBufferToUnicode(U256,A256,256))-PtrUInt(@U256)>512 then
      // ESynException.CreateUTF8() uses UTF8ToString() -> use CreateFmt() here
      raise ESynException.CreateFmt('OS error for %s.Create(%d)',[ClassName,aCodePage]);
    MoveFast(U256[0],fAnsiToWide[0],512);
  end;
  SetLength(fWideToAnsi,65536);
  for i := 1 to 126 do
    fWideToAnsi[i] := i;
  FillcharFast(fWideToAnsi[127],65536-127,ord('?')); // '?' for unknown char
  for i := 127 to 255 do
    if (fAnsiToWide[i]<>0) and (fAnsiToWide[i]<>ord('?')) then
      fWideToAnsi[fAnsiToWide[i]] := i;
  // fixed width Ansi will never be bigger than UTF-8
  fAnsiCharShift := 0;
end;

function TSynAnsiFixedWidth.IsValidAnsi(WideText: PWideChar; Length: integer): boolean;
var i: PtrInt;
    wc: cardinal;
begin
  result := false;
  if WideText<>nil then
    for i := 0 to Length-1 do begin
      wc := cardinal(WideText[i]);
      if wc=0 then
        break else
      if wc<256 then
        if fAnsiToWide[wc]<256 then
          continue else
          exit else
          if fWideToAnsi[wc]=ord('?') then
            exit else
            continue;
    end;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsi(WideText: PWideChar): boolean;
var wc: cardinal;
begin
  result := false;
  if WideText<>nil then
    repeat
      wc := cardinal(WideText^);
      inc(WideText);
      if wc=0 then
        break else
      if wc<256 then
        if fAnsiToWide[wc]<256 then
          continue else
          exit else
          if fWideToAnsi[wc]=ord('?') then
            exit else
            continue;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsiU(UTF8Text: PUTF8Char): boolean;
var c: PtrUInt;
    i, extra: PtrInt;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^);
      inc(UTF8Text);
      if c=0 then break else
      if c<=127 then
        continue else begin
        extra := UTF8_EXTRABYTES[c];
        if UTF8_EXTRA[extra].minimum>$ffff then
          exit;
        for i := 1 to extra do begin
          if byte(UTF8Text^) and $c0<>$80 then exit; // invalid UTF-8 content
          c := c shl 6+byte(UTF8Text^);
          inc(UTF8Text);
        end;
        dec(c,UTF8_EXTRA[extra].offset);
        if (c>$ffff) or (fWideToAnsi[c]=ord('?')) then
          exit; // invalid char in the WinAnsi code page
      end;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
var c: PtrUInt;
    i, extra: PtrInt;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^);
      inc(UTF8Text);
      if c=0 then break else
      if c<=127 then
        continue else begin
        extra := UTF8_EXTRABYTES[c];
        if UTF8_EXTRA[extra].minimum>$ffff then
          exit;
        for i := 1 to extra do begin
          if byte(UTF8Text^) and $c0<>$80 then exit; // invalid UTF-8 content
          c := c shl 6+byte(UTF8Text^);
          inc(UTF8Text);
        end;
        dec(c,UTF8_EXTRA[extra].offset);
        if (c>255) or (fAnsiToWide[c]>255) then
          exit; // not 8 bit char (like "tm" or such) is marked invalid
      end;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
begin
  // first handle trailing 7 bit ASCII chars, by pairs (Sha optimization)
  if SourceChars>=2 then
  repeat
    c := PCardinal(Source)^;
    if c and $ff80ff80<>0 then
      break; // break on first non ASCII pair
    dec(SourceChars,2);
    inc(Source,2);
    c := c shr 8 or c;
    PWord(Dest)^ := c;
    inc(Dest,2);
  until SourceChars<2;
  // use internal lookup tables for fast process of remaining chars
  for c := 1 to SourceChars shr 2 do begin
    Dest[0] := AnsiChar(fWideToAnsi[Ord(Source[0])]);
    Dest[1] := AnsiChar(fWideToAnsi[Ord(Source[1])]);
    Dest[2] := AnsiChar(fWideToAnsi[Ord(Source[2])]);
    Dest[3] := AnsiChar(fWideToAnsi[Ord(Source[3])]);
    inc(Source,4);
    inc(Dest,4);
  end;
  for c := 1 to SourceChars and 3 do begin
    Dest^ := AnsiChar(fWideToAnsi[Ord(Source^)]);
    inc(Dest);
    inc(Source);
  end;
  result := Dest;
end;

function TSynAnsiFixedWidth.UTF8BufferToAnsi(Dest: PAnsiChar;
  Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
    endSource, endSourceBy4: PUTF8Char;
    i,extra: integer;
label By1, By4, Quit; // ugly but faster
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  endSource := Source+SourceChars;
  endSourceBy4 := endSource-4;
  if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then
    repeat
By4:  c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      PCardinal(Dest)^ := c;
      inc(Source,4);
      inc(Dest,4);
    until Source>endSourceBy4;
  // generic loop, handling one UTF-8 code per iteration
  if Source<endSource then
    repeat
By1:  c := byte(Source^);
      inc(Source);
      if ord(c)<=127 then begin
        Dest^ := AnsiChar(c);
        inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end else begin
        extra := UTF8_EXTRABYTES[c];
        if (extra=0) or (Source+extra>endSource) then break;
        for i := 1 to extra do begin
          if byte(Source^) and $c0<>$80 then
            goto Quit; // invalid UTF-8 content
          c := c shl 6+byte(Source^);
          inc(Source);
        end;
        dec(c,UTF8_EXTRA[extra].offset);
        if c>$ffff then
          Dest^ := '?' else // '?' as in unknown fWideToAnsi[] items
          Dest^ := AnsiChar(fWideToAnsi[c]);
        inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end;
    until false;
Quit:
  result := Dest;
end;

function TSynAnsiFixedWidth.WideCharToAnsiChar(wc: cardinal): integer;
begin
  if wc<256 then
    if fAnsiToWide[wc]<256 then
      result := wc else
      result := -1 else
      if wc<=65535 then begin
        result := fWideToAnsi[wc];
        if result=ord('?') then
          result := -1;
      end else
      result := -1;
end;


{ TSynAnsiUTF8 }

function TSynAnsiUTF8.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
begin
  result := Dest+
    (UTF8ToWideChar(Dest,PUTF8Char(Source),SourceChars,NoTrailingZero) shr 1);
end;

function TSynAnsiUTF8.AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
  SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
begin
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Dest^,SourceChars);
  if not NoTrailingZero then
    Dest[SourceChars] := #0;
  result := Dest+SourceChars;
end;

procedure TSynAnsiUTF8.InternalAppendUTF8(Source: PAnsiChar; SourceChars: Cardinal;
  DestTextWriter: TObject; Escape: TTextWriterKind);
begin
  TTextWriter(DestTextWriter).Add(PUTF8Char(Source),SourceChars,Escape);
end;

function TSynAnsiUTF8.AnsiToRawUnicode(Source: PAnsiChar;
  SourceChars: Cardinal): RawUnicode;
begin
  result := Utf8DecodeToRawUniCode(PUTF8Char(Source),SourceChars);
end;

constructor TSynAnsiUTF8.Create(aCodePage: cardinal);
begin
  if aCodePage<>CP_UTF8 then
    raise ESynException.CreateUTF8('%.Create(%)',[self,aCodePage]);
  inherited Create(aCodePage);
end;

function TSynAnsiUTF8.UnicodeBufferToUTF8(Dest: PAnsiChar; DestChars: Cardinal;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+RawUnicodeToUTF8(PUTF8Char(Dest),DestChars,Source,SourceChars,
    [ccfNoTrailingZero]);
end;

function TSynAnsiUTF8.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  result := UnicodeBufferToUTF8(Dest,SourceChars,Source,SourceChars);
end;

function TSynAnsiUTF8.UnicodeBufferToAnsi(Source: PWideChar;
  SourceChars: Cardinal): RawByteString;
var tmp: TSynTempBuffer;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    tmp.Init(SourceChars*3+1);
    FastSetStringCP(result,tmp.buf,UnicodeBufferToUTF8(tmp.buf,
      SourceChars*3,Source,SourceChars)-tmp.buf,fCodePage);
    tmp.Done;
  end;
end;

function TSynAnsiUTF8.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Dest^,SourceChars);
  result := Dest+SourceChars;
end;

procedure TSynAnsiUTF8.UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
  var result: RawByteString);
begin
  FastSetString(RawUTF8(result),Source,SourceChars);
end;

function TSynAnsiUTF8.UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
begin
  result := UTF8;
  {$ifdef HASCODEPAGE}
  SetCodePage(result,CP_UTF8,false);
  {$endif}
end;

function TSynAnsiUTF8.AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
begin
  result := AnsiText;
  {$ifdef HASCODEPAGE}
  SetCodePage(RawByteString(result),CP_UTF8,false);
  {$endif}
end;

function TSynAnsiUTF8.AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8;
begin
  FastSetString(Result,Source,SourceChars);
end;


{ TSynAnsiUTF16 }

function TSynAnsiUTF16.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal; NoTrailingZero: boolean): PWideChar;
begin
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Dest^,SourceChars);
  result := Pointer(PtrUInt(Dest)+SourceChars);
  if not NoTrailingZero then
    result^ := #0;
end;

const
  NOTRAILING: array[boolean] of TCharConversionFlags =
    ([],[ccfNoTrailingZero]);

function TSynAnsiUTF16.AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
  SourceChars: Cardinal; NoTrailingZero: boolean): PUTF8Char;
begin
  SourceChars := SourceChars shr 1; // from byte count to WideChar count
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,
    PWideChar(Source),SourceChars,NOTRAILING[NoTrailingZero]);
end;

function TSynAnsiUTF16.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
begin
  SetString(result,Source,SourceChars); // byte count
end;

constructor TSynAnsiUTF16.Create(aCodePage: cardinal);
begin
  if aCodePage<>CP_UTF16 then
    raise ESynException.CreateUTF8('%.Create(%)',[self,aCodePage]);
  inherited Create(aCodePage);
end;

function TSynAnsiUTF16.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  SourceChars := SourceChars shl 1; // from WideChar count to byte count
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Dest^,SourceChars);
  result := Dest+SourceChars;
end;

function TSynAnsiUTF16.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+UTF8ToWideChar(PWideChar(Dest),Source,SourceChars,true);
end;


{ TSynTempBuffer }

procedure TSynTempBuffer.Init(const Source: RawByteString);
begin
  Init(pointer(Source),length(Source));
end;

function TSynTempBuffer.Init(Source: PUTF8Char): PUTF8Char;
begin
  Init(Source,StrLen(Source));
  result := buf;
end;

function TSynTempBuffer.Init(SourceLen: integer): pointer;
begin
  Init(nil,SourceLen);
  result := buf;
end;

procedure TSynTempBuffer.Init(Source: pointer; SourceLen: integer);
begin
  len := SourceLen;
  if len<=0 then
    buf := nil else begin
    if len<=SizeOf(tmp)-16 then
      buf := @tmp else
      GetMem(buf,len+16); // +16 for trailing #0 and for PInteger() parsing
    if Source<>nil then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,buf^,len);
      PPtrInt(PAnsiChar(buf)+len)^ := 0; // init last 4/8 bytes (makes valgrid happy)
    end;
  end;
end;

function TSynTempBuffer.Init: integer;
begin
  buf := @tmp;
  result := SizeOf(tmp)-16;
  len := result;
end;

function TSynTempBuffer.InitRandom(RandomLen: integer; forcegsl: boolean): pointer;
begin
  Init(nil,RandomLen);
  if RandomLen>0 then
    FillRandom(buf,(RandomLen shr 2)+1,forcegsl);
  result := buf;     
end;

function TSynTempBuffer.InitIncreasing(Count, Start: integer): PIntegerArray;
begin
  Init(nil,(Count-Start)*4);
  FillIncreasing(buf,Start,Count);
  result := buf;     
end;

function TSynTempBuffer.InitZero(ZeroLen: integer): pointer;
begin
  Init(nil,ZeroLen-16);
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(buf^,ZeroLen,0);
  result := buf;     
end;

procedure TSynTempBuffer.Done;
begin
  if (buf<>@tmp) and (buf<>nil) then
    FreeMem(buf);
end;

procedure TSynTempBuffer.Done(EndBuf: pointer; var Dest: RawUTF8);
begin
  if EndBuf=nil then
    Dest := '' else
    FastSetString(Dest,buf,PAnsiChar(EndBuf)-PAnsiChar(buf));
  if (buf<>@tmp) and (buf<>nil) then
    FreeMem(buf);
end;


{ TSynTempWriter }

procedure TSynTempWriter.Init(maxsize: integer);
begin
  if maxsize<=0 then
    maxsize := SizeOf(tmp.tmp)-16; // TSynTempBuffer allocates +16
  pos := tmp.Init(maxsize);
end;

procedure TSynTempWriter.Done;
begin
  tmp.Done;
end;

function TSynTempWriter.AsBinary: RawByteString;
begin
  FastSetStringCP(result,PAnsiChar(tmp.buf),pos-tmp.buf,CP_RAWBYTESTRING);
end;

function TSynTempWriter.Position: integer;
begin
  result := pos-tmp.buf;
end;

procedure TSynTempWriter.wr(const val; len: integer);
begin
  if pos-tmp.buf+len>tmp.len then
     raise ESynException.CreateUTF8('TSynTempWriter(%) overflow',[tmp.len]);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(val,pos^,len);
  inc(pos,len);
end;

procedure TSynTempWriter.wrb(b: byte);
begin
  wr(b,1);
end;

procedure TSynTempWriter.wrint(int: integer);
begin
  wr(int,4);
end;

procedure TSynTempWriter.wrptrint(int: PtrInt);
begin
  wr(int,SizeOf(int));
end;

procedure TSynTempWriter.wrptr(ptr: pointer);
begin
  wr(ptr,SizeOf(ptr));
end;

procedure TSynTempWriter.wrss(const str: shortstring);
begin
  wr(str,ord(str[0])+1);
end;

procedure TSynTempWriter.wrw(w: word);
begin
  wr(w,2);
end;

function TSynTempWriter.wrfillchar(count: integer; value: byte): PAnsiChar;
begin
  if pos-tmp.buf+count>tmp.len then
     raise ESynException.CreateUTF8('TSynTempWriter(%) overflow',[tmp.len]);
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(pos^,count,value);
  result := pos;
  inc(pos,count);
end;


{ TRawUTF8InterningSlot }

procedure TRawUTF8InterningSlot.Init;
begin
  Safe.Init;
  {$ifndef NOVARIANTS}
  Safe.LockedInt64[0] := 0;
  {$endif}
  Values.Init(TypeInfo(TRawUTF8DynArray),Value,HashAnsiString,
    SortDynArrayAnsiString,crc32c,@Safe.Padding[0].VInteger,false);
  Values.fHasher := InterningHasher; // consistent with TRawUTF8Interning
end;

procedure TRawUTF8InterningSlot.Done;
begin
  Safe.Done;
end;

function TRawUTF8InterningSlot.Count: integer;
begin
  {$ifdef NOVARIANTS}
  result := Safe.Padding[0].VInteger;
  {$else}
  result := Safe.LockedInt64[0];
  {$endif}
end;

procedure TRawUTF8InterningSlot.Unique(var aResult: RawUTF8;
  const aText: RawUTF8; aTextHash: cardinal);
var i: integer;
    added: boolean;
begin
  EnterCriticalSection(Safe.fSection);
  try
    i := Values.FindHashedForAdding(aText,added,aTextHash);
    if added then begin
      Value[i] := aText;   // copy new value to the pool
      aResult := aText;
     end else
      aResult := Value[i]; // return unified string instance
  finally
    LeaveCriticalSection(Safe.fSection);
  end;
end;

procedure TRawUTF8InterningSlot.UniqueText(var aText: RawUTF8; aTextHash: cardinal);
var i: integer;
    added: boolean;
begin
  EnterCriticalSection(Safe.fSection);
  try
    i := Values.FindHashedForAdding(aText,added,aTextHash);
    if added then
      Value[i] := aText else  // copy new value to the pool
      aText := Value[i];      // return unified string instance
  finally
    LeaveCriticalSection(Safe.fSection);
  end;
end;

procedure TRawUTF8InterningSlot.Clear;
begin
  Safe.Lock;
  try
    Values.Clear;
    Values.Rehash;
  finally
    Safe.Unlock;
  end;
end;

function TRawUTF8InterningSlot.Clean(aMaxRefCount: integer): integer;
var i: integer;
    s,d: PPtrUInt; // points to RawUTF8 values (bypass COW assignments)
begin
  result := 0;
  Safe.Lock;
  try
    if Safe.Padding[0].VInteger=0 then
      exit;
    s := pointer(Value);
    d := s;
    for i := 1 to Safe.Padding[0].VInteger do begin
      {$ifdef FPC}
      if StringRefCount(PAnsiString(s)^)<=aMaxRefCount then begin
        Finalize(PRawUTF8(s)^);
      {$else}
      if PInteger(s^-8)^<=aMaxRefCount then begin
        PRawUTF8(s)^ := '';
      {$endif FPC}
        inc(result);
      end else begin
        if s<>d then begin
          d^ := s^;
          s^ := 0; // avoid GPF
        end;
        inc(d);
      end;
      inc(s);
    end;
    if result>0 then begin
      Values.SetCount((PtrUInt(d)-PtrUInt(Value))div SizeOf(d^));
      Values.ReHash;
    end;
  finally
    Safe.UnLock;
  end;
end;


{ TRawUTF8Interning }

constructor TRawUTF8Interning.Create(aHashTables: integer);
var p,i: integer;
begin
  for p := 0 to 9 do
    if aHashTables=1 shl p then begin
      SetLength(fPool,aHashTables);
      fPoolLast := aHashTables-1;
      for i := 0 to fPoolLast do
        fPool[i].Init;
      exit;
    end;
  raise ESynException.CreateUTF8('%.Create(%) not allowed',[self,aHashTables]);
end;

destructor TRawUTF8Interning.Destroy;
var i: integer;
begin
  for i := 0 to fPoolLast do
    fPool[i].Done;
  inherited Destroy;
end;

procedure TRawUTF8Interning.Clear;
var i: integer;
begin
  if self<>nil then
    for i := 0 to fPoolLast do
      fPool[i].Clear;
end;

function TRawUTF8Interning.Clean(aMaxRefCount: integer): integer;
var i: integer;
begin
  result := 0;
  if self<>nil then
    for i := 0 to fPoolLast do
      inc(result,fPool[i].Clean(aMaxRefCount));
end;

function TRawUTF8Interning.Count: integer;
var i: integer;
begin
  result := 0;
  if self<>nil then
    for i := 0 to fPoolLast do
      inc(result,fPool[i].Count);
end;

procedure TRawUTF8Interning.Unique(var aResult: RawUTF8; const aText: RawUTF8);
var hash: cardinal;
begin
  if aText='' then
    aResult := '' else
  if self=nil then
    aResult := aText else begin
    hash := InterningHasher(0,pointer(aText),length(aText)); // = fPool[].Values.HashElement
    fPool[hash and fPoolLast].Unique(aResult,aText,hash);
  end;
end;

procedure TRawUTF8Interning.UniqueText(var aText: RawUTF8);
var hash: cardinal;
begin
  if (self<>nil) and (aText<>'') then begin
    hash := InterningHasher(0,pointer(aText),length(aText)); // = fPool[].Values.HashElement
    fPool[hash and fPoolLast].UniqueText(aText,hash);
  end;
end;

function TRawUTF8Interning.Unique(const aText: RawUTF8): RawUTF8;
var hash: cardinal;
begin
  if aText='' then
    result := '' else
  if self=nil then
    result := aText else begin
    hash := InterningHasher(0,pointer(aText),length(aText)); // = fPool[].Values.HashElement
    fPool[hash and fPoolLast].Unique(result,aText,hash);
  end;
end;

function TRawUTF8Interning.Unique(aText: PUTF8Char; aTextLen: integer): RawUTF8;
begin
  FastSetString(result,aText,aTextLen);
  UniqueText(result);
end;

procedure TRawUTF8Interning.Unique(var aResult: RawUTF8; aText: PUTF8Char;
  aTextLen: integer);
begin
  FastSetString(aResult,aText,aTextLen);
  UniqueText(aResult);
end;

{$ifndef NOVARIANTS}

procedure TRawUTF8Interning.UniqueVariant(var aResult: variant; const aText: RawUTF8);
begin
  {$ifndef FPC}if TVarData(aResult).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(aResult);
  TVarData(aResult).VType := varString;
  TVarData(aResult).VAny := nil;
  Unique(RawUTF8(TVarData(aResult).VAny),aText);
end;

procedure TRawUTF8Interning.UniqueVariantString(var aResult: variant;
  const aText: string);
var tmp: RawUTF8;
begin
  StringToUTF8(aText,tmp);
  UniqueVariant(aResult,tmp);
end;

procedure TRawUTF8Interning.UniqueVariant(var aResult: variant;
  aText: PUTF8Char; aTextLen: integer; aAllowVarDouble: boolean);
var tmp: RawUTF8;
begin
  if not GetNumericVariantFromJSON(aText,TVarData(aResult),aAllowVarDouble) then begin
    FastSetString(tmp,aText,aTextLen);
    UniqueVariant(aResult,tmp);
  end;
end;

procedure TRawUTF8Interning.UniqueVariant(var aResult: variant);
begin
  with TVarData(aresult) do
    if VType=varString then
      UniqueText(RawUTF8(VString)) else
    if VType=varVariant or varByRef then
      UniqueVariant(PVariant(VPointer)^) else
    if VType=varString or varByRef then
      UniqueText(PRawUTF8(VPointer)^);
end;

{$endif NOVARIANTS}

function WideCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
begin
  if aWideChar<=$7F then begin
    Dest^ := AnsiChar(aWideChar);
    result := 1;
  end else
  if aWideChar>$7ff then begin
    Dest[0] := AnsiChar($E0 or (aWideChar shr 12));
    Dest[1] := AnsiChar($80 or ((aWideChar shr 6) and $3F));
    Dest[2] := AnsiChar($80 or (aWideChar and $3F));
    result := 3;
  end else begin
    Dest[0] := AnsiChar($C0 or (aWideChar shr 6));
    Dest[1] := AnsiChar($80 or (aWideChar and $3F));
    result := 2;
  end;
end;

function UTF16CharToUtf8(Dest: PUTF8Char; var Source: PWord): integer;
var c: cardinal;
    j: integer;
begin
  c := Source^;
  inc(Source);
  case c of
  0..$7f: begin
    Dest^ := AnsiChar(c);
    result := 1;
    exit;
  end;
  UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX: begin
    c := ((c-$D7C0)shl 10)+(Source^ xor UTF16_LOSURROGATE_MIN);
    inc(Source);
  end;
  UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX: begin
    c := ((cardinal(Source^)-$D7C0)shl 10)+(c xor UTF16_LOSURROGATE_MIN);
    inc(Source);
  end;
  end; // now c is the UTF-32/UCS4 code point
  case c of
  0..$7ff: result := 2;
  $800..$ffff: result := 3;
  $10000..$1FFFFF: result := 4;
  $200000..$3FFFFFF: result := 5;
  else result := 6;
  end;
  for j := result-1 downto 1 do begin
    Dest[j] := AnsiChar((c and $3f)+$80);
    c := c shr 6;
  end;
  Dest^ := AnsiChar(Byte(c) or UTF8_FIRSTBYTE[result]);
end;

function UCS4ToUTF8(ucs4: cardinal; Dest: PUTF8Char): integer;
var j: integer;
begin
  case ucs4 of
  0..$7f: begin
    Dest^ := AnsiChar(ucs4);
    result := 1;
    exit;
  end;
  $80..$7ff: result := 2;
  $800..$ffff: result := 3;
  $10000..$1FFFFF: result := 4;
  $200000..$3FFFFFF: result := 5;
  else result := 6;
  end;
  for j := result-1 downto 1 do begin
    Dest[j] := AnsiChar((ucs4 and $3f)+$80);
    ucs4 := ucs4 shr 6;
  end;
  Dest^ := AnsiChar(Byte(ucs4) or UTF8_FIRSTBYTE[result]);
end;

procedure AnyAnsiToUTF8(const s: RawByteString; var result: RawUTF8);
{$ifdef HASCODEPAGE}var CodePage: Cardinal;{$endif}
begin
  if s='' then
    result := '' else begin
    {$ifdef HASCODEPAGE}
    CodePage := StringCodePage(s);
    if (CodePage=CP_UTF8) or (CodePage=CP_RAWBYTESTRING) then
      result := s else
      result := TSynAnsiConvert.Engine(CodePage).
    {$else}
    result := CurrentAnsiConvert.
    {$endif}
      AnsiBufferToRawUTF8(pointer(s),length(s));
  end;
end;

function AnyAnsiToUTF8(const s: RawByteString): RawUTF8;
begin
  AnyAnsiToUTF8(s,result);
end;

function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
begin
  result := WinAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);
end;

function ShortStringToUTF8(const source: ShortString): RawUTF8;
begin
  result := WinAnsiConvert.AnsiBufferToRawUTF8(@source[1],ord(source[0]));
end;

procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: integer);
var L: PtrInt;
begin
  L := length(S);
  if L<>0 then begin
    if L>=DestLen then
      L := DestLen-1; // truncate to avoid buffer overflow
    WinAnsiConvert.AnsiBufferToUnicode(PWideChar(Dest),pointer(S),L); // include last #0
  end else
    Dest^[0] := 0;
end;

function WinAnsiToRawUnicode(const S: WinAnsiString): RawUnicode;
begin
  result := WinAnsiConvert.AnsiToRawUnicode(S);
end;

function WinAnsiToUtf8(const S: WinAnsiString): RawUTF8;
begin
  result := WinAnsiConvert.AnsiBufferToRawUTF8(pointer(S),length(s));
end;

function WinAnsiToUtf8(WinAnsi: PAnsiChar; WinAnsiLen: integer): RawUTF8;
begin
  result := WinAnsiConvert.AnsiBufferToRawUTF8(WinAnsi,WinAnsiLen);
end;

function WideCharToWinAnsiChar(wc: cardinal): AnsiChar;
begin
  wc := WinAnsiConvert.WideCharToAnsiChar(wc);
  if integer(wc)=-1 then
    result := '?' else
    result := AnsiChar(wc);
end;

function WideCharToWinAnsi(wc: cardinal): integer;
begin
  result := WinAnsiConvert.WideCharToAnsiChar(wc);
end;

function IsWinAnsi(WideText: PWideChar; Length: integer): boolean;
begin
  result := WinAnsiConvert.IsValidAnsi(WideText,Length);
end;

function IsAnsiCompatible(PC: PAnsiChar): boolean;
begin
  result := false;
  if PC<>nil then
  while true do
    if PC^=#0 then
      break else
    if PC^<=#127 then
      inc(PC) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatible(PC: PAnsiChar; Len: integer): boolean;
var i: integer;
begin
  result := false;
  if PC<>nil then begin
    for i := 1 to Len shr 2 do
      if PCardinal(PC)^ and $80808080<>0 then
        exit else
        inc(PC,4);
    for i := 0 to (Len and 3)-1 do
      if PC[i]>=#127 then
        exit;
  end;
  result := true;
end;

function IsAnsiCompatible(const Text: RawByteString): boolean;
begin
  result := IsAnsiCompatible(PAnsiChar(pointer(Text)),length(Text));
end;

function IsAnsiCompatible(PW: PWideChar): boolean;
begin
  result := false;
  if PW<>nil then
  while true do
    if ord(PW^)=0 then
      break else
    if ord(PW^)<=127 then
      inc(PW) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatible(PW: PWideChar; Len: integer): boolean;
var i: integer;
begin
  result := false;
  if PW<>nil then
    for i := 0 to Len-1 do
      if ord(PW[i])>127 then
        exit;
  result := true;
end;

function IsWinAnsi(WideText: PWideChar): boolean;
begin
  result := WinAnsiConvert.IsValidAnsi(WideText);
end;

function IsWinAnsiU(UTF8Text: PUTF8Char): boolean;
begin
  result := WinAnsiConvert.IsValidAnsiU(UTF8Text);
end;

function IsWinAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
begin
  result := WinAnsiConvert.IsValidAnsiU8Bit(UTF8Text);
end;

function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;
begin
  result := WinAnsiConvert.UTF8BufferToAnsi(dest,source,count)-dest;
end;

function ShortStringToAnsi7String(const source: shortstring): RawByteString;
begin
  FastSetString(RawUTF8(result),@source[1],ord(source[0]));
end;

procedure ShortStringToAnsi7String(const source: shortstring; var result: RawUTF8);
begin
  FastSetString(result,@source[1],ord(source[0]));
end;

procedure UTF8ToShortString(var dest: shortstring; source: PUTF8Char);
var c: cardinal;
    len,extra,i: integer;
begin
  len := 0;
  if source<>nil then
  repeat
    c := byte(source^); inc(source);
    if c=0 then break else
    if c<=127 then begin
      inc(len); dest[len] := AnsiChar(c);
      if len<253 then continue else break;
    end else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then break; // invalid leading byte
      for i := 1 to extra do begin
        if byte(source^) and $c0<>$80 then begin
          dest[0] := AnsiChar(len);
          exit; // invalid UTF-8 content
        end;
        c := c shl 6+byte(source^);
        inc(Source);
      end;
      dec(c,UTF8_EXTRA[extra].offset);
      // #256.. -> slower but accurate conversion
      inc(len);
      if c>$ffff then
        dest[len] := '?' else
        dest[len] := AnsiChar(WinAnsiConvert.fWideToAnsi[c]);
      if len<253 then continue else break;
    end;
  until false;
  dest[0] := AnsiChar(len);
end;

function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString;
begin
  result := WinAnsiConvert.UTF8ToAnsi(S);
end;

function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString;
begin
  result := WinAnsiConvert.UTF8ToAnsi(P);
end;

procedure Utf8ToRawUTF8(P: PUTF8Char; var result: RawUTF8);
begin // fast and Delphi 2009+ ready
  FastSetString(result,P,StrLen(P));
end;

function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char;
  MaxDestChars, sourceBytes: PtrInt; NoTrailingZero: boolean): PtrInt;
// faster than System.Utf8ToUnicode()
var c: cardinal;
    begd: PWideChar;
    endSource: PUTF8Char;
    endDest: PWideChar;
    i,extra: integer;
label Quit, NoSource;
begin
  result := 0;
  if dest=nil then
   exit;
  if source=nil then
    goto NoSource;
  if sourceBytes=0 then begin
    if source^=#0 then
      goto NoSource;
    sourceBytes := StrLen(source);
  end;
  endSource := source+sourceBytes;
  endDest := dest+MaxDestChars;
  begd := dest;
  repeat
    c := byte(source^);
    inc(source);
    if c<=127 then begin
      PWord(dest)^ := c; // much faster than dest^ := WideChar(c) for FPC
      inc(dest);
      if (source<endsource) and (dest<endDest) then
        continue else
        break;
    end;
    extra := UTF8_EXTRABYTES[c];
    if (extra=0) or (Source+extra>endSource) then break;
    for i := 1 to extra do begin
      if byte(Source^) and $c0<>$80 then
        goto Quit; // invalid input content
      c := c shl 6+byte(Source^);
      inc(Source);
    end;
    with UTF8_EXTRA[extra] do begin
      dec(c,offset);
      if c<minimum then
        break; // invalid input content
    end;
    if c<=$ffff then begin
      PWord(dest)^ := c;
      inc(dest);
      if (source<endsource) and (dest<endDest) then
        continue else
        break;
    end;
    dec(c,$10000); // store as UTF-16 surrogates
    PWordArray(dest)[0] := c shr 10  +UTF16_HISURROGATE_MIN;
    PWordArray(dest)[1] := c and $3FF+UTF16_LOSURROGATE_MIN;
    inc(dest,2);
    if (source>=endsource) or (dest>=endDest) then
      break;
  until false;
Quit:
  result := PtrUInt(dest)-PtrUInt(begd); // dest-begd return byte length
NoSource:
  if not NoTrailingZero then
    dest^ := #0; // always append a WideChar(0) to the end of the buffer
end;

function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char; sourceBytes: PtrInt;
  NoTrailingZero: boolean): PtrInt;
// faster than System.UTF8Decode()
var c: cardinal;
    begd: PWideChar;
    endSource, endSourceBy4: PUTF8Char;
    i,extra: PtrInt;
label Quit, NoSource, By1, By4;
begin
  result := 0;
  if dest=nil then
   exit;
  if source=nil then
    goto NoSource;
  if sourceBytes=0 then begin
    if source^=#0 then
      goto NoSource;
    sourceBytes := StrLen(source);
  end;
  begd := dest;
  endSource := Source+SourceBytes;
  endSourceBy4 := endSource-4;
  if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then
    repeat // handle 7 bit ASCII chars, by quad (Sha optimization)
By4:  c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      inc(Source,4);
      PCardinal(dest)^ := (c shl 8 or (c and $FF)) and $00ff00ff;
      c := c shr 16;
      PCardinal(dest+2)^ := (c shl 8 or c) and $00ff00ff;
      inc(dest,4);
    until Source>EndSourceBy4;
  if Source<endSource then
    repeat
By1:  c := byte(Source^); inc(Source);
      if c<=127 then begin
        PWord(dest)^ := c; // much faster than dest^ := WideChar(c) for FPC
        inc(dest);
        if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end;
      extra := UTF8_EXTRABYTES[c];
      if (extra=0) or (Source+extra>endSource) then break;
      for i := 1 to extra do begin
        if byte(Source^) and $c0<>$80 then
          goto Quit; // invalid input content
        c := c shl 6+byte(Source^);
        inc(Source);
      end;
      with UTF8_EXTRA[extra] do begin
        dec(c,offset);
        if c<minimum then
          break; // invalid input content
      end;
      if c<=$ffff then begin
        PWord(dest)^ := c;
        inc(dest);
        if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
        if Source<endSource then continue else break;
      end;
      dec(c,$10000); // store as UTF-16 surrogates
      PWordArray(dest)[0] := c shr 10  +UTF16_HISURROGATE_MIN;
      PWordArray(dest)[1] := c and $3FF+UTF16_LOSURROGATE_MIN;
      inc(dest,2);
      if (PtrUInt(Source) and 3=0) and (Source<=EndSourceBy4) then goto By4;
      if Source>=endSource then break;
    until false;
Quit:
  result := PtrUInt(dest)-PtrUInt(begd); // dest-begd return char length
NoSource:
  if not NoTrailingZero then
    dest^ := #0; // always append a WideChar(0) to the end of the buffer
end;

function IsValidUTF8(source: PUTF8Char): Boolean;
var extra, i: integer;
    c: cardinal;
begin
  result := false;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c=0 then break else
    if c and $80<>0 then begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 1 to extra do
        if byte(source^) and $c0<>$80 then
          exit else
          inc(source); // check valid UTF-8 content
    end;
  until false;
  result := true;
end;

function IsValidUTF8(const source: RawUTF8): Boolean;
begin
  result := IsValidUTF8(pointer(Source),length(Source));
end;

function IsValidUTF8(source: PUTF8Char; sourcelen: PtrInt): Boolean;
var extra, i: integer;
    c: cardinal;
begin
  result := false;
  inc(sourcelen,PtrInt(source));
  if source<>nil then
    while PtrInt(PtrUInt(source))<sourcelen do begin
      c := byte(source^);
      inc(source);
      if c=0 then exit else
      if c and $80<>0 then begin
        extra := UTF8_EXTRABYTES[c];
        if extra=0 then exit else // invalid leading byte
        for i := 1 to extra do
          if (PtrInt(PtrUInt(source))>=sourcelen) or (byte(source^) and $c0<>$80) then
            exit else
            inc(source); // check valid UTF-8 content
      end;
    end;
  result := true;
end;

function IsValidUTF8WithoutControlChars(source: PUTF8Char): Boolean;
var extra, i: integer;
    c: cardinal;
begin
  result := false;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c=0 then break else
    if c<32 then exit else // disallow #1..#31 control char
    if c and $80<>0 then begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 1 to extra do
        if byte(source^) and $c0<>$80 then // invalid UTF-8 encoding
          exit else
          inc(source);
    end;
  until false;
  result := true;
end;

function IsValidUTF8WithoutControlChars(const source: RawUTF8): Boolean;
var s, extra, i, len: integer;
    c: cardinal;
begin
  result := false;
  s := 1;
  len := length(source);
  while s<=len do begin
    c := byte(source[s]);
    inc(s);
    if c<32 then exit else // disallow #0..#31 control char
    if c and $80<>0 then begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 1 to extra do
        if byte(source[s]) and $c0<>$80 then // reached #0 or invalid UTF-8
          exit else
          inc(s);
    end;
  end;
  result := true;
end;


function Utf8ToUnicodeLength(source: PUTF8Char): PtrUInt;
var c: PtrUInt;
    extra,i: integer;
begin
  result := 0;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c=0 then break else
    if c<=127 then
      inc(result) else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      if extra>=UTF8_EXTRA_SURROGATE then
        inc(result,2) else
        inc(result);
      for i := 1 to extra do // inc(source,extra) is faster but not safe
        if byte(source^) and $c0<>$80 then
          exit else
          inc(source); // check valid UTF-8 content
    end;
  until false;
end;

function Utf8TruncateToUnicodeLength(var text: RawUTF8; maxUTF16: integer): boolean;
var c: PtrUInt;
    extra,i: integer;
    source: PUTF8Char;
begin
  source := pointer(text);
  if (source<>nil) and (cardinal(maxUtf16)<cardinal(length(text))) then
    repeat
      if maxUTF16<=0 then begin
        SetLength(text,source-pointer(text)); // truncate
        result := true;
        exit;
      end;
      c := byte(source^);
      inc(source);
      if c=0 then break else
      if c<=127 then
        dec(maxUTF16) else begin
        extra := UTF8_EXTRABYTES[c];
        if extra=0 then break else // invalid leading byte
        if extra>=UTF8_EXTRA_SURROGATE then
          dec(maxUTF16,2) else
          dec(maxUTF16);
        for i := 1 to extra do // inc(source,extra) is faster but not safe
          if byte(source^) and $c0<>$80 then
            break else
            inc(source); // check valid UTF-8 content
      end;
    until false;
  result := false;
end;

function Utf8TruncateToLength(var text: RawUTF8; maxBytes: cardinal): boolean;
begin
  if cardinal(length(text))<maxBytes then begin
    result := false;
    exit; // nothing to truncate
  end;
  while (maxBytes>0) and (ord(text[maxBytes]) and $c0=$80) do dec(maxBytes);
  if (maxBytes>0) and (ord(text[maxBytes]) and $80<>0) then dec(maxBytes);
  SetLength(text,maxBytes);
  result := true;
end;

function Utf8TruncatedLength(const text: RawUTF8; maxBytes: cardinal): integer;
begin
  result := length(text);
  if cardinal(result)<maxBytes then
    exit;
  result := maxBytes;
  while (result>0) and (ord(text[result]) and $c0=$80) do dec(result);
  if (result>0) and (ord(text[result]) and $80<>0) then dec(result);
end;

function Utf8TruncatedLength(text: PAnsiChar; textlen,maxBytes: cardinal): integer;
begin
  if textlen<maxBytes then begin
    result := textlen;
    exit;
  end;
  result := maxBytes;
  while (result>0) and (ord(text[result]) and $c0=$80) do dec(result);
  if (result>0) and (ord(text[result]) and $80<>0) then dec(result);
end;

function Utf8FirstLineToUnicodeLength(source: PUTF8Char): PtrInt;
var c: PtrUInt;
    extra: Integer;
begin
  result := 0;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c in [0,10,13] then break else // #0, #10 or #13 stop the count
    if c<=127 then
      inc(result) else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      if extra>=UTF8_EXTRA_SURROGATE then
        inc(result,2) else
        inc(result);
      inc(source,extra); // a bit less safe, but faster
    end;
  until false;
end;

function Utf8DecodeToRawUnicode(P: PUTF8Char; L: integer): RawUnicode;
var short: array[0..256*6] of WideChar;
    U: PWideChar;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if L=0 then
    L := StrLen(P);
  if L=0 then
    exit;
  // +1 below is for #0 ending -> true WideChar(#0) ending
  if L<SizeOf(short)div 3 then // mostly avoid tmp memory allocation on heap
    SetString(result,PAnsiChar(@short),UTF8ToWideChar(short,P,L)+1) else begin
    GetMem(U,L*3+2); // maximum posible unicode size (if all <#128)
    SetString(result,PAnsiChar(U),UTF8ToWideChar(U,P,L)+1);
    FreeMem(U);
  end;
end;

function Utf8DecodeToRawUnicode(const S: RawUTF8): RawUnicode;
begin
  if S='' then
    result := '' else
    result := Utf8DecodeToRawUnicode(pointer(S),length(S));
end;

function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; DestLen: PInteger=nil): RawUnicode;
var L: integer;
begin
  L := Utf8DecodeToRawUnicodeUI(S,result);
  if DestLen<>nil then
    DestLen^ := L;
end;

function Utf8DecodeToRawUnicodeUI(const S: RawUTF8; var Dest: RawUnicode): integer;
begin
  Dest := ''; // somewhat faster if Dest is freed before any SetLength()
  if S='' then begin
    result := 0;
    exit;
  end;
  result := length(S);
  SetLength(Dest,result*2+2);
  result := UTF8ToWideChar(pointer(Dest),Pointer(S),result);
end;

function RawUnicodeToUtf8(Dest: PUTF8Char; DestLen: PtrInt; Source: PWideChar;
  SourceLen: PtrInt; Flags: TCharConversionFlags): PtrInt;
var c: Cardinal;
    Tail: PWideChar;
    i,j: integer;
label unmatch;
begin
  result := PtrInt(Dest);
  inc(DestLen,PtrInt(Dest));
  if (Source<>nil) and (Dest<>nil) then begin
    // first handle 7 bit ASCII WideChars, by pairs (Sha optimization)
    SourceLen := SourceLen*2+PtrInt(PtrUInt(Source));
    Tail := PWideChar(SourceLen)-2;
    if (PtrInt(PtrUInt(Dest))<DestLen) and (Source<=Tail) then
      repeat
        c := PCardinal(Source)^;
        if c and $ff80ff80<>0 then
          break; // break on first non ASCII pair
        inc(Source,2);
        c := c shr 8 or c;
        PWord(Dest)^ := c;
        inc(Dest,2);
      until (Source>Tail) or (PtrInt(PtrUInt(Dest))>=DestLen);
    // generic loop, handling one UCS4 char per iteration
    if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
    repeat
      // inlined UTF16CharToUtf8() with bufferoverlow check and $FFFD on unmatch
      c := cardinal(Source^);
      inc(Source);
      case c of
      0..$7f: begin
        Dest^ := AnsiChar(c);
        inc(Dest);
        if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
          continue else break;
      end;
      UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX:
        if (PtrInt(PtrUInt(Source))>=SourceLen) or
           ((cardinal(Source^)<UTF16_LOSURROGATE_MIN) or (cardinal(Source^)>UTF16_LOSURROGATE_MAX)) then begin
unmatch:  if (PtrInt(PtrUInt(@Dest[3]))>DestLen) or
             not (ccfReplacementCharacterForUnmatchedSurrogate in Flags) then
            break;
          PWord(Dest)^ := $BFEF;
          Dest[2] := AnsiChar($BD);
          inc(Dest,3);
          if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
            continue else break;
        end else begin
          c := ((c-$D7C0)shl 10)+(cardinal(Source^) xor UTF16_LOSURROGATE_MIN);
          inc(Source);
        end;
      UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX:
        if (PtrInt(PtrUInt(Source))>=SourceLen) or
           ((cardinal(Source^)<UTF16_HISURROGATE_MIN) or (cardinal(Source^)>UTF16_HISURROGATE_MAX)) then
          goto unmatch else begin
          c := ((cardinal(Source^)-$D7C0)shl 10)+(c xor UTF16_LOSURROGATE_MIN);
          inc(Source);
        end;
      end; // now c is the UTF-32/UCS4 code point
      case c of
      0..$7ff: i := 2;
      $800..$ffff: i := 3;
      $10000..$1FFFFF: i := 4;
      $200000..$3FFFFFF: i := 5;
      else i := 6;
      end;
      if PtrInt(PtrUInt(Dest))+i>DestLen then
        break;
      for j := i-1 downto 1 do begin
        Dest[j] := AnsiChar((c and $3f)+$80);
        c := c shr 6;
      end;
      Dest^ := AnsiChar(Byte(c) or UTF8_FIRSTBYTE[i]);
      inc(Dest,i);
      if (PtrInt(PtrUInt(Dest))<DestLen) and (PtrInt(PtrUInt(Source))<SourceLen) then
        continue else break;
    until false;
    if not (ccfNoTrailingZero in Flags) then
      Dest^ := #0;
  end;
  result := PtrInt(PtrUInt(Dest))-result;
end;

procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  var result: RawUTF8; Flags: TCharConversionFlags);
var tmp: TSynTempBuffer;
begin
  if (WideChar=nil) or (WideCharCount=0) then
    result := '' else begin
    tmp.Init(WideCharCount*3);
    FastSetString(Result,tmp.buf,RawUnicodeToUtf8(tmp.buf,tmp.len+1,WideChar,WideCharCount,Flags));
    tmp.Done;
  end;
end;

function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer;
  Flags: TCharConversionFlags): RawUTF8;
begin
  RawUnicodeToUTF8(WideChar,WideCharCount,result, Flags);
end;

function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer; out UTF8Length: integer): RawUTF8;
var LW: integer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if WideCharCount=0 then
    exit;
  LW := WideCharCount*3; // maximum resulting length
  SetLength(result,LW);
  UTF8Length := RawUnicodeToUtf8(pointer(result),LW+1,WideChar,WideCharCount,[ccfNoTrailingZero]);
  if UTF8Length<=0 then
    result := '';
end;

/// convert a RawUnicode string into a UTF-8 string
function RawUnicodeToUtf8(const Unicode: RawUnicode): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(Unicode),length(Unicode) shr 1,result);
end;

function SynUnicodeToUtf8(const Unicode: SynUnicode): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(Unicode),length(Unicode),result);
end;

function RawUnicodeToSynUnicode(const Unicode: RawUnicode): SynUnicode;
begin
  SetString(result,PWideChar(pointer(Unicode)),length(Unicode) shr 1);
end;

function RawUnicodeToSynUnicode(WideChar: PWideChar; WideCharCount: integer): SynUnicode;
begin
  SetString(result,WideChar,WideCharCount);
end;

procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: Integer);
begin
  WinAnsiConvert.UnicodeBufferToAnsi(dest,source,WideCharCount);
end;

function RawUnicodeToWinAnsi(WideChar: PWideChar; WideCharCount: integer): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(WideChar,WideCharCount);
end;

function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(Unicode),length(Unicode) shr 1);
end;

function WideStringToWinAnsi(const Wide: WideString): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(Wide),length(Wide));
end;

procedure UnicodeBufferToWinAnsi(source: PWideChar; out Dest: WinAnsiString);
var L: integer;
begin
  L := StrLenW(source);
  SetLength(Dest,L);
  WinAnsiConvert.UnicodeBufferToAnsi(pointer(Dest),source,L);
end;

function UnicodeBufferToString(source: PWideChar): string;
begin
  result := RawUnicodeToString(source,StrLenW(source));
end;

procedure AnsiCharToUTF8(P: PAnsiChar; L: Integer; var result: RawUTF8; ACP: integer);
begin
  result := TSynAnsiConvert.Engine(ACP).AnsiBufferToRawUTF8(P,L);
end;

{$ifdef HASVARUSTRING}
function UnicodeStringToUtf8(const S: UnicodeString): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(S),length(S),result);
end;

function UTF8DecodeToUnicodeString(const S: RawUTF8): UnicodeString;
begin
  UTF8DecodeToUnicodeString(pointer(S),length(S),result);
end;

procedure UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer; var result: UnicodeString);
var short: array[byte] of WideChar;
    U: PWideChar;
begin
  if (P=nil) or (L=0) then
    result := '' else
  if L<SizeOf(short)div 3 then
    SetString(result,short,UTF8ToWideChar(short,P,L) shr 1) else begin
    GetMem(U,L*3+2); // maximum posible unicode size (if all <#128)
    SetString(result,U,UTF8ToWideChar(U,P,L) shr 1);
    FreeMem(U);
  end;
end;

function UnicodeStringToWinAnsi(const S: string): WinAnsiString;
begin
  result := RawUnicodeToWinAnsi(pointer(S),length(S));
end;

function UTF8DecodeToUnicodeString(P: PUTF8Char; L: integer): UnicodeString;
begin
  UTF8DecodeToUnicodeString(P,L,result);
end;

function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: integer): UnicodeString;
begin
  SetString(result,nil,WinAnsiLen);
  WinAnsiConvert.AnsiBufferToUnicode(pointer(result),WinAnsi,WinAnsiLen);
end;

function WinAnsiToUnicodeString(const WinAnsi: WinAnsiString): UnicodeString;
begin
  result := WinAnsiToUnicodeString(pointer(WinAnsi),length(WinAnsi));
end;

{$endif HASVARUSTRING}

function Ansi7ToString(const Text: RawByteString): string;
{$ifdef UNICODE}
var i: integer;
begin
  SetString(result,nil,length(Text));
  for i := 0 to length(Text)-1 do
    PWordArray(result)[i] := PByteArray(Text)[i]; // no conversion for 7 bit Ansi
end;
{$else}
begin
  result := Text; // if we are SURE this text is 7 bit Ansi -> direct assign
end;
{$endif}

function Ansi7ToString(Text: PWinAnsiChar; Len: integer): string;
begin
  {$ifdef UNICODE}
  Ansi7ToString(Text,Len,result);
  {$else}
  SetString(result,PAnsiChar(Text),Len);
  {$endif}
end;

procedure Ansi7ToString(Text: PWinAnsiChar; Len: integer; var result: string);
{$ifdef UNICODE}
var i: integer;
begin
  SetString(result,nil,Len);
  for i := 0 to Len-1 do
    PWordArray(result)[i] := PByteArray(Text)[i]; // no conversion for 7 bit Ansi
end;
{$else}
begin
  SetString(result,PAnsiChar(Text),Len);
end;
{$endif}

function StringToAnsi7(const Text: string): RawByteString;
{$ifdef UNICODE}
var i: integer;
begin
  SetString(result,nil,length(Text));
  for i := 0 to length(Text)-1 do
    PByteArray(result)[i] := PWordArray(Text)[i]; // no conversion for 7 bit Ansi
end;
{$else}
begin
  result := Text; // if we are SURE this text is 7 bit Ansi -> direct assign
end;
{$endif}

function StringToWinAnsi(const Text: string): WinAnsiString;
begin
  {$ifdef UNICODE}
  result := RawUnicodeToWinAnsi(Pointer(Text),length(Text));
  {$else}
  result := WinAnsiConvert.AnsiToAnsi(CurrentAnsiConvert,Text);
  {$endif}
end;

function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char;
begin
  {$ifdef UNICODE}
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,PWideChar(Source),SourceChars,[]);
  {$else}
  result := CurrentAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);
  {$endif}
end;

procedure StringBufferToUtf8(Source: PChar; out result: RawUTF8); overload;
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(Source,StrLenW(Source),result);
  {$else}
  result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Source,StrLen(Source));
  {$endif}
end;

function StringToUTF8(const Text: string): RawUTF8;
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
  {$else}
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
  {$endif}
end;

procedure StringToUTF8(Text: PChar; TextLen: integer; var result: RawUTF8);
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(Text,TextLen,result);
  {$else}
  result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Text, TextLen);
  {$endif}
end;

procedure StringToUTF8(const Text: string; var result: RawUTF8);
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
  {$else}
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
  {$endif}
end;

function ToUTF8(const Text: string): RawUTF8;
begin
  {$ifdef UNICODE}
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
  {$else}
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
  {$endif}
end;

function ToUTF8(const Ansi7Text: ShortString): RawUTF8;
begin
  FastSetString(result,@Ansi7Text[1],ord(Ansi7Text[0]));
end;

function ToUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8;
begin
  FastSetString(result,nil,36);
  GUIDToText(pointer(result),@guid);
end;

procedure Int32ToUTF8(Value: PtrInt; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

procedure Int64ToUtf8(Value: Int64; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  {$ifdef CPU64}
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then
  {$else} // Int64Rec gives compiler internal error C4963
  if (PCardinalArray(@Value)^[0]<=high(SmallUInt32UTF8)) and
     (PCardinalArray(@Value)^[1]=0) then
  {$endif CPU64}
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt64(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

procedure UInt64ToUtf8(Value: QWord; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  {$ifdef CPU64}
  if Value<=high(SmallUInt32UTF8) then
  {$else} // Int64Rec gives compiler internal error C4963
  if (PCardinalArray(@Value)^[0]<=high(SmallUInt32UTF8)) and
     (PCardinalArray(@Value)^[1]=0) then
  {$endif CPU64}
    result := SmallUInt32UTF8[Value] else begin
    P := StrUInt64(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

function VarRecAsChar(const V: TVarRec): integer;
begin
  case V.VType of
    vtChar:     result := ord(V.VChar);
    vtWideChar: result := ord(V.VWideChar);
    else        result := 0;
  end;
end;

function VarRecToInt64(const V: TVarRec; out value: Int64): boolean;
begin
  case V.VType of
    vtInteger: value := V.VInteger;
    vtInt64 {$ifdef FPC}, vtQWord{$endif}: value := V.VInt64^;
    vtBoolean: if V.VBoolean then value := 1 else value := 0; // normalize
    {$ifndef NOVARIANTS}
    vtVariant: value := V.VVariant^;
    {$endif}
    else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VarRecToDouble(const V: TVarRec; out value: double): boolean;
begin
  case V.VType of
    vtInteger: value := V.VInteger;
    vtInt64:   value := V.VInt64^;
    {$ifdef FPC}
    vtQWord:   value := V.VQWord^;
    {$endif}
    vtBoolean: if V.VBoolean then value := 1 else value := 0; // normalize
    vtExtended: value := V.VExtended^;
    vtCurrency: value := V.VCurrency^;
    {$ifndef NOVARIANTS}
    vtVariant: value := V.VVariant^;
    {$endif}
    else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VarRecToTempUTF8(const V: TVarRec; var Res: TTempUTF8): integer;
{$ifndef NOVARIANTS}
var v64: Int64;
    isString: boolean;
{$endif}
label smlu32;
begin
  Res.TempRawUTF8 := nil; // avoid GPF
  case V.VType of
    vtString: begin
      Res.Text := @V.VString^[1];
      Res.Len := ord(V.VString^[0]);
      result := Res.Len;
      exit;
    end;
    vtAnsiString: begin // expect UTF-8 content
      Res.Text := pointer(V.VAnsiString);
      Res.Len := length(RawUTF8(V.VAnsiString));
      result := Res.Len;
      exit;
    end;
    {$ifdef HASVARUSTRING}
    vtUnicodeString:
      RawUnicodeToUtf8(V.VPWideChar,length(UnicodeString(V.VUnicodeString)),RawUTF8(Res.TempRawUTF8));
    {$endif}
    vtWideString:
      RawUnicodeToUtf8(V.VPWideChar,length(WideString(V.VWideString)),RawUTF8(Res.TempRawUTF8));
    vtPChar: begin // expect UTF-8 content
      Res.Text := V.VPointer;
      Res.Len := StrLen(V.VPointer);
      result := Res.Len;
      exit;
    end;
    vtChar: begin
      Res.Temp[0] := V.VChar; // V may be on transient stack (alf: FPC)
      Res.Text := @Res.Temp;
      Res.Len := 1;
      result := 1;
      exit;
    end;
    vtPWideChar:
      RawUnicodeToUtf8(V.VPWideChar,StrLenW(V.VPWideChar),RawUTF8(Res.TempRawUTF8));
    vtWideChar:
      RawUnicodeToUtf8(@V.VWideChar,1,RawUTF8(Res.TempRawUTF8));
    vtBoolean: begin
      if V.VBoolean then // normalize
        Res.Text := pointer(SmallUInt32UTF8[1]) else
        Res.Text := pointer(SmallUInt32UTF8[0]);
      Res.Len := 1;
      result := 1;
      exit;
    end;
    vtInteger: begin
      result := V.VInteger;
      if cardinal(result)<=high(SmallUInt32UTF8) then begin
smlu32: Res.Text := pointer(SmallUInt32UTF8[result]);
        Res.Len := {$ifdef FPC}_LStrLenP(Res.Text){$else}PInteger(Res.Text-4)^{$endif};
      end else begin
        Res.Text := PUTF8Char(StrInt32(@Res.Temp[23],result));
        Res.Len := @Res.Temp[23]-Res.Text;
      end;
      result := Res.Len;
      exit;
    end;
    vtInt64:
      if (PCardinalArray(V.VInt64)^[0]<=high(SmallUInt32UTF8)) and
         (PCardinalArray(V.VInt64)^[1]=0) then begin
        result := V.VInt64^;
        goto smlu32;
      end else begin
        Res.Text := PUTF8Char(StrInt64(@Res.Temp[23],V.VInt64^));
        Res.Len := @Res.Temp[23]-Res.Text;
        result := Res.Len;
        exit;
      end;
    {$ifdef FPC}
    vtQWord:
      if V.VQWord^<=high(SmallUInt32UTF8) then begin
         result := V.VQWord^;
         goto smlu32;
       end else begin
        Res.Text := PUTF8Char(StrUInt64(@Res.Temp[23],V.VQWord^));
        Res.Len := @Res.Temp[23]-Res.Text;
        result := Res.Len;
        exit;
      end;
    {$endif}
    vtCurrency: begin
      Res.Text := @Res.Temp;
      Res.Len := Curr64ToPChar(V.VInt64^,Res.Temp);
      result := Res.Len;
      exit;
    end;
    vtExtended:
      ExtendedToStr(V.VExtended^,DOUBLE_PRECISION,RawUTF8(Res.TempRawUTF8));
    vtPointer,vtInterface: begin
      Res.Text := @Res.Temp;
      Res.Len := SizeOf(pointer)*2;
      BinToHexDisplayLower(V.VPointer,@Res.Temp,SizeOf(Pointer));
      result := SizeOf(pointer)*2;
      exit;
    end;
    vtClass: begin
      if V.VClass<>nil then begin
        Res.Text := PPUTF8Char(PtrInt(PtrUInt(V.VClass))+vmtClassName)^+1;
        Res.Len := ord(Res.Text[-1]);
      end else
        Res.Len := 0;
      result := Res.Len;
      exit;
    end;
    vtObject: begin
      if V.VObject<>nil then begin
        Res.Text := PPUTF8Char(PPtrInt(V.VObject)^+vmtClassName)^+1;
        Res.Len := ord(Res.Text[-1]);
      end else
        Res.Len := 0;
      result := Res.Len;
      exit;
    end;
    {$ifndef NOVARIANTS}
    vtVariant:
      if VariantToInt64(V.VVariant^,v64) then
        if (PCardinalArray(@v64)^[0]<=high(SmallUInt32UTF8)) and
           (PCardinalArray(@v64)^[1]=0) then begin
          result := v64;
          goto smlu32;
        end else begin
          Res.Text := PUTF8Char(StrInt64(@Res.Temp[23],v64));
          Res.Len := @Res.Temp[23]-Res.Text;
          result := Res.Len;
          exit;
        end else
        VariantToUTF8(V.VVariant^,RawUTF8(Res.TempRawUTF8),isString);
    {$endif}
    else begin
      Res.Len := 0;
      result := 0;
      exit;
    end;
  end;
  Res.Text := Res.TempRawUTF8;
  Res.Len := length(RawUTF8(Res.TempRawUTF8));
  result := Res.Len;
end;

procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8; wasString: PBoolean=nil);
var isString: boolean;
begin
  isString := not (V.VType in [
    vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended]);
  with V do
  case V.VType of
    vtString:
      FastSetString(result,@VString^[1],ord(VString^[0]));
    vtAnsiString:
      result := RawUTF8(VAnsiString); // expect UTF-8 content
    {$ifdef HASVARUSTRING}
    vtUnicodeString:
      result := UnicodeStringToUtf8(UnicodeString(VUnicodeString));
    {$endif}
    vtWideString:
      RawUnicodeToUtf8(VWideString,length(WideString(VWideString)),result);
    vtPChar:
      FastSetString(result,VPChar,StrLen(VPChar));
    vtChar:
      FastSetString(result,PAnsiChar(@VChar),1);
    vtPWideChar:
      RawUnicodeToUtf8(VPWideChar,StrLenW(VPWideChar),result);
    vtWideChar:
      RawUnicodeToUtf8(@VWideChar,1,result);
    vtBoolean:
      if VBoolean then // normalize
        result := SmallUInt32UTF8[1] else
        result := SmallUInt32UTF8[0];
    vtInteger:
      Int32ToUtf8(VInteger,result);
    vtInt64:
      Int64ToUtf8(VInt64^,result);
    {$ifdef FPC}
    vtQWord:
      UInt64ToUtf8(VQWord^,result);
    {$endif}
    vtCurrency:
      Curr64ToStr(VInt64^,result);
    vtExtended:
      ExtendedToStr(VExtended^,DOUBLE_PRECISION,result);
    vtPointer:
      PointerToHex(VPointer,result);
    vtClass:
      if VClass<>nil then
        ToText(VClass,result) else
        result := '';
    vtObject:
      if VObject<>nil then
        ToText(PClass(VObject)^,result) else
        result := '';
    vtInterface:
      {$ifdef HASINTERFACEASTOBJECT}
      if VInterface<>nil then
        ToText((IInterface(VInterface) as TObject).ClassType,result) else
        result := '';
      {$else}
      PointerToHex(VInterface,result);
      {$endif}
    {$ifndef NOVARIANTS}
    vtVariant:
      VariantToUTF8(VVariant^,result,isString);
    {$endif}
    else begin
      isString := false;
      result := '';
    end;
  end;
  if wasString<>nil then
    wasString^ := isString;
end;

function VarRecToUTF8IsString(const V: TVarRec; var value: RawUTF8): boolean;
begin
  VarRecToUTF8(V,value,@result);
end;

procedure VarRecToInlineValue(const V: TVarRec; var result: RawUTF8);
var wasString: boolean;
begin
  VarRecToUTF8(V,result,@wasString);
  if wasString then
    result := QuotedStr(pointer(result),'"');
end;

{$ifdef UNICODE}
function StringToRawUnicode(const S: string): RawUnicode;
begin
  SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;
begin
  result := CurrentAnsiConvert.AnsiToRawUnicode(S);
end;
{$endif}

{$ifdef UNICODE}
function StringToSynUnicode(const S: string): SynUnicode;
begin
  result := S;
end;
{$else}
function StringToSynUnicode(const S: string): SynUnicode;
begin
  result := CurrentAnsiConvert.AnsiToUnicodeString(pointer(S),length(S));
end;
{$endif}

{$ifdef UNICODE}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
  SetString(result,PAnsiChar(P),L*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
  result := CurrentAnsiConvert.AnsiToRawUnicode(P,L);
end;
{$endif}


{$ifdef UNICODE}
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
  SetString(result,P,L);
end;
{$else}
function RawUnicodeToString(P: PWideChar; L: integer): string;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
{$endif}

{$ifdef UNICODE}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
  SetString(result,P,L);
end;
{$else}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string);
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
{$endif}

{$ifdef UNICODE}
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  SetString(result,PWideChar(pointer(U)),StrLenW(Pointer(U)));
end;
{$else}
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),StrLenW(Pointer(U)));
end;
{$endif}

{$ifdef UNICODE}
function SynUnicodeToString(const U: SynUnicode): string;
begin
  result := U;
end;
{$else}
function SynUnicodeToString(const U: SynUnicode): string;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),length(U));
end;
{$endif}

{$ifdef UNICODE}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
  UTF8DecodeToUnicodeString(P,L,result);
end;
{$else}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
  CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
end;
{$endif}

{$ifdef UNICODE}
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
begin
  UTF8DecodeToUnicodeString(P,L,result);
end;
{$else}
procedure UTF8DecodeToString(P: PUTF8Char; L: integer; var result: string);
begin
  CurrentAnsiConvert.UTF8BufferToAnsi(P,L,RawByteString(result));
end;
{$endif}

{$ifdef UNICODE}
function UTF8ToString(const Text: RawUTF8): string;
begin
  UTF8DecodeToUnicodeString(pointer(Text),length(Text),result);
end;
{$else}
function UTF8ToString(const Text: RawUTF8): string;
begin
  CurrentAnsiConvert.UTF8BufferToAnsi(pointer(Text),length(Text),RawByteString(result));
end;
{$endif}

function UTF8ToWideString(const Text: RawUTF8): WideString;
begin
  {$ifdef FPC}
  Finalize(result);
  {$endif}
  UTF8ToWideString(Text,result);
end;

procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString);
begin
  UTF8ToWideString(pointer(Text),Length(Text),result);
end;

procedure UTF8ToWideString(Text: PUTF8Char; Len: integer; var result: WideString);
var short: array[0..256*6] of WideChar;
    U: PWideChar;
begin
  if (Text=nil) or (Len=0) then
    result := '' else
  if Len<SizeOf(short)div 3 then
    SetString(result,short,UTF8ToWideChar(short,Text,Len) shr 1) else begin
    GetMem(U,Len*3+2); // maximum posible unicode size (if all <#128)
    SetString(result,U,UTF8ToWideChar(U,Text,Len) shr 1);
    FreeMem(U);
  end;
end;

function WideStringToUTF8(const aText: WideString): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(aText),length(aText),result);
end;

function UTF8ToSynUnicode(const Text: RawUTF8): SynUnicode;
begin
  UTF8ToSynUnicode(pointer(Text),length(Text),result);
end;

procedure UTF8ToSynUnicode(const Text: RawUTF8; var result: SynUnicode);
begin
  UTF8ToSynUnicode(pointer(Text),length(Text),result);
end;

procedure UTF8ToSynUnicode(Text: PUTF8Char; Len: integer; var result: SynUnicode);
var short: array[byte] of WideChar;
    U: PWideChar;
begin
  if (Text=nil) or (Len=0) then
    result := '' else
  if Len<SizeOf(short)div 3 then
    SetString(result,short,UTF8ToWideChar(short,Text,Len) shr 1) else begin
    GetMem(U,Len*3+2); // maximum posible unicode size (if all <#128)
    SetString(result,U,UTF8ToWideChar(U,Text,Len) shr 1);
    FreeMem(U);
  end;
end;

function StrInt32(P: PAnsiChar; val: PtrInt): PAnsiChar;
{$ifdef ABSOLUTEPASCALORNOTINTEL}
begin // fallback to pure pascal version for ARM or PIC
  if val<0 then begin
    result := StrUInt32(P,PtrUInt(-val))-1;
    result^ := '-';
  end else
    result := StrUInt32(P,val);
end;
{$else}
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=P, rdx=val (Linux: rdi,rsi) - val is QWord on 64-bit Intel CPU
        .noframe
{$endif FPC}
        {$ifndef win64}
        mov     rcx, rdi
        mov     rdx, rsi
        {$endif win64}
        mov     r10, rdx
        sar     r10, 63         // r10=0 if val>=0 or -1 if val<0
        xor     rdx, r10
        sub     rdx, r10        // rdx=abs(val)
        cmp     rdx, 10
        jb      @3              // direct process of common val<10
        mov     rax, rdx
        lea     r8, [rip + TwoDigitLookup]
@s:     lea     rcx, [rcx - 2]
        cmp     rax, 100
        jb      @2
        lea     r9, [rax * 2]
        shr     rax, 2
        mov     rdx, 2951479051793528259 // use power of two reciprocal to avoid division
        mul     rdx
        shr     rdx, 2
        mov     rax, rdx
        imul    rdx, -200
        lea     rdx, [rdx + r8]
        movzx   rdx, word ptr[rdx + r9]
        mov     [rcx], dx
        cmp     rax, 10
        jae     @s
@1:     or      al, '0'
        mov     byte ptr[rcx - 2], '-'
        mov     [rcx - 1], al
        lea     rax, [rcx + r10 - 1]       // includes '-' if val<0
        ret
@2:     movzx   eax, word ptr[r8 + rax * 2]
        mov     byte ptr[rcx - 1], '-'
        mov     [rcx], ax
        lea     rax, [rcx + r10]           // includes '-' if val<0
        ret
@3:     or      dl, '0'
        mov     byte ptr[rcx - 2], '-'
        mov     [rcx - 1], dl
        lea     rax, [rcx + r10 - 1]       // includes '-' if val<0
end;
{$else}
asm // eax=P, edx=val
        mov     ecx, edx
        sar     ecx, 31         // 0 if val>=0 or -1 if val<0
        push    ecx
        xor     edx, ecx
        sub     edx, ecx        // edx=abs(val)
        cmp     edx, 10
        jb      @3  // direct process of common val<10
        push    edi
        mov     edi, eax
        mov     eax, edx
@s:     sub     edi, 2
        cmp     eax, 100
        jb      @2
        mov     ecx, eax
        mov     edx, 1374389535 // use power of two reciprocal to avoid division
        mul     edx
        shr     edx, 5          // now edx=eax div 100
        mov     eax, edx
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ecx * 2 + edx]
        mov     [edi], dx
        cmp     eax, 10
        jae     @s
@1:     dec     edi
        or      al, '0'
        mov     byte ptr[edi - 1], '-'
        mov     [edi], al
        mov     eax, edi
        pop     edi
        pop     ecx
        add     eax, ecx // includes '-' if val<0
        ret
@2:     movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     byte ptr[edi - 1], '-'
        mov     [edi], ax
        mov     eax, edi
        pop     edi
        pop     ecx
        add     eax, ecx // includes '-' if val<0
        ret
@3:     dec     eax
        pop     ecx
        or      dl, '0'
        mov     byte ptr[eax - 1], '-'
        mov     [eax], dl
        add     eax, ecx // includes '-' if val<0
end;
{$endif CPUX64}
{$endif ABSOLUTEPASCALORNOTINTEL}

function StrUInt32(P: PAnsiChar; val: PtrUInt): PAnsiChar;
{$ifdef ABSOLUTEPASCALORNOTINTEL} // fallback to pure pascal version for ARM or PIC
var c100: PtrUInt; // val/c100 are QWord on 64-bit CPU
    tab: PWordArray;
begin // this code is faster than Borland's original str() or IntToStr()
  tab := @TwoDigitLookupW;
  repeat
    if val<10 then begin
      dec(P);
      P^ := AnsiChar(val+ord('0'));
      break;
    end else
    if val<100 then begin
      dec(P,2);
      PWord(P)^ := tab[val];
      break;
    end;
    dec(P,2);
    c100 := val div 100;
    dec(val,c100*100);
    PWord(P)^ := tab[val];
    val := c100;
    if c100=0 then
      break;
  until false;
  result := P;
end;
{$else}
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=P, rdx=val (Linux: rdi,rsi) - val is QWord on Intel 64-bit CPU
        .noframe
{$endif FPC}
        {$ifndef win64}
        mov     rcx, rdi
        mov     rdx, rsi
        {$endif win64}
        cmp     rdx, 10
        jb      @3           // direct process of common val<10
        mov     rax, rdx
        lea     r8, [rip + TwoDigitLookup]
@s:     lea     rcx, [rcx - 2]
        cmp     rax, 100
        jb      @2
        lea     r9, [rax * 2]
        shr     rax, 2
        mov     rdx, 2951479051793528259 // use power of two reciprocal to avoid division
        mul     rdx
        shr     rdx, 2
        mov     rax, rdx
        imul    rdx, -200
        add     rdx, r8
        movzx   rdx, word ptr[rdx + r9]
        mov     [rcx], dx
        cmp     rax, 10
        jae     @s
@1:     dec     rcx
        or      al, '0'
        mov     [rcx], al
@0:     mov     rax, rcx
        ret
@2:     movzx   eax, word ptr[r8 + rax * 2]
        mov     [rcx], ax
        mov     rax, rcx
        ret
@3:     lea     rax, [rcx - 1]
        or      dl, '0'
        mov     [rax], dl
end;
{$else}
asm     // eax=P, edx=val
        cmp     edx, 10
        jb      @3  // direct process of common val=0 (or val<10)
        push    edi
        mov     edi, eax
        mov     eax, edx
        nop
        nop         // @s loop alignment
@s:     sub     edi, 2
        cmp     eax, 100
        jb      @2
        mov     ecx, eax
        mov     edx, 1374389535 // use power of two reciprocal to avoid division
        mul     edx
        shr     edx, 5          // now edx=eax div 100
        mov     eax, edx
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ecx * 2 + edx]
        mov     [edi], dx
        cmp     eax, 10
        jae     @s
@1:     dec     edi
        or      al, '0'
        mov     [edi], al
        mov     eax, edi
        pop     edi
        ret
@2:     movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     [edi], ax
        mov     eax, edi
        pop     edi
        ret
@3:     dec     eax
        or      dl, '0'
        mov     [eax], dl
end;
{$endif CPU64}
{$endif ABSOLUTEPASCALORNOTINTEL}

function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
{$ifdef CPU64}
begin
  result := StrUInt32(P,val); // StrUInt32 converts PtrUInt=QWord on 64-bit CPU
end;
{$else}
var c,c100: QWord;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  if PInt64Rec(@val)^.Hi=0 then
    P := StrUInt32(P,PCardinal(@val)^) else begin
    {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
    c := val;
    repeat
      {$ifdef PUREPASCAL}
      c100 := c div 100;   // one div by two digits
      dec(c,c100*100);     // fast c := c mod 100
      {$else}
      asm // by-passing the RTL is a good idea here
        push    ebx
        mov     edx, dword ptr[c + 4]
        mov     eax, dword ptr[c]
        mov     ebx, 100
        mov     ecx, eax
        mov     eax, edx
        xor     edx, edx
        div     ebx
        mov     dword ptr[c100 + 4], eax
        xchg    eax, ecx
        div     ebx
        mov     dword ptr[c100], eax
        imul    ebx, ecx
        mov     ecx, 100
        mul     ecx
        add     edx, ebx
        pop     ebx
        sub     dword ptr[c + 4], edx
        sbb     dword ptr[c], eax
      end;
      {$endif}
      dec(P,2);
      PWord(P)^ := tab[c];
      c := c100;
      if PInt64Rec(@c)^.Hi=0 then begin
        if PCardinal(@c)^<>0 then
          P := StrUInt32(P,PCardinal(@c)^);
        break;
      end;
    until false;
  end;
  result := P;
end;
{$endif}

function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
begin
  {$ifdef CPU64}
  result := StrInt32(P,val); // StrInt32 converts PtrInt=Int64 on 64-bit CPU
  {$else}
  if val<0 then begin
    P := StrUInt64(P,-val)-1;
    P^ := '-';
  end else
    P := StrUInt64(P,val);
  result := P;
  {$endif CPU64}
end;

function IPToCardinal(P: PUTF8Char; out aValue: cardinal): boolean;
var i,c: cardinal;
    b: array[0..3] of byte;
begin
  aValue := 0;
  result := false;
  if (P=nil) or (IdemPChar(P,'127.0.0.1') and (P[9]=#0)) then
    exit;
  for i := 0 to 3 do begin
    c := GetNextItemCardinal(P,'.');
    if (c>255) or ((P=nil) and (i<3)) then
      exit;
    b[i] := c;
  end;
  if PCardinal(@b)^<>$0100007f then begin
    aValue := PCardinal(@b)^;
    result := true;
  end;
end;

function IPToCardinal(const aIP: RawUTF8; out aValue: cardinal): boolean;
begin
  result := IPToCardinal(pointer(aIP),aValue);
end;

function IPToCardinal(const aIP: RawUTF8): cardinal;
begin
  IPToCardinal(pointer(aIP),result);
end;

const
  // see https://en.wikipedia.org/wiki/Baudot_code
  Baudot2Char: array[0..63] of AnsiChar =
   #0'e'#10'a siu'#13'drjnfcktzlwhypqobg'#254'mxv'#255+
   #0'3'#10'- ''87'#13#0'4'#0',!:(5+)2$6019?@'#254'./;'#255;
var
  Char2Baudot: array[AnsiChar] of byte;

function AsciiToBaudot(const Text: RawUTF8): RawByteString;
begin
  result := AsciiToBaudot(pointer(Text),length(Text));
end;

function AsciiToBaudot(P: PAnsiChar; len: integer): RawByteString;
var i,c,d,bits: integer;
    shift: boolean;
    dest: PByte;
    tmp: TSynTempBuffer;
begin
  result := '';
  if (P=nil) or (len=0) then
    exit;
  shift := false;
  dest := tmp.Init((len*10)shr 3);
  d := 0;
  bits := 0;
  for i := 0 to len-1 do begin
    c := Char2Baudot[P[i]];
    if c>32 then begin
      if not shift then begin
        d := (d shl 5) or 27;
        inc(bits,5);
        shift := true;
      end;
      d := (d shl 5) or (c-32);
      inc(bits,5);
    end else
    if c>0 then begin
      if shift and (P[i]>=' ') then begin
        d := (d shl 5) or 31;
        inc(bits,5);
        shift := false;
      end;
      d := (d shl 5) or c;
      inc(bits,5);
    end;
    while bits>=8 do begin
      dec(bits,8);
      dest^ := d shr bits;
      inc(dest);
    end;
  end;
  if bits>0 then begin
    dest^ := d shl (8-bits);
    inc(dest);
  end;
  SetString(result,PAnsiChar(tmp.buf),PAnsiChar(dest)-PAnsiChar(tmp.buf));
  tmp.Done;
end;

function BaudotToAscii(const Baudot: RawByteString): RawUTF8;
begin
  result := BaudotToAscii(pointer(Baudot),length(Baudot));
end;

function BaudotToAscii(Baudot: PByteArray; len: integer): RawUTF8;
var i,c,b,bits,shift: integer;
    tmp: TSynTempBuffer;
    dest: PAnsiChar;
begin
  result := '';
  if (Baudot=nil) or (len<=0) then
    exit;
  dest := tmp.Init((len shl 3)div 5+1);
  try
    shift := 0;
    b := 0;
    bits := 0;
    for i := 0 to len-1 do begin
      b := (b shl 8) or Baudot[i];
      inc(bits,8);
      while bits>=5 do begin
        dec(bits,5);
        c := (b shr bits) and 31;
        case c of
        27: if shift<>0 then
              exit else
              shift := 32;
        31: if shift<>0 then
              shift := 0 else
              exit;
        else begin
          c := ord(Baudot2Char[c+shift]);
          if c=0 then
            if Baudot[i+1]=0 then // allow triming of last 5 bits
              break else
              exit;
          dest^ := AnsiChar(c);
          inc(dest);
        end;
        end;
      end;
    end;
  finally
    tmp.Done(dest,result);
  end;
end;

function TrimControlChars(const text: RawUTF8; const controls: TSynAnsicharSet): RawUTF8;
var len,i,j,n: integer;
    P: PAnsiChar;
begin
  len := length(text);
  for i := 1 to len do
    if text[i] in controls then begin
      n := i-1;
      FastSetString(result,nil,len);
      P := pointer(result);
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(text)^,P^,n);
      for j := i+1 to len do
        if not(text[j] in controls) then begin
          P[n] := text[j];
          inc(n);
        end;
      SetLength(result, n);
      exit;
    end;
  result := text; // no control char found
end;

{$ifdef CPU64}
procedure Exchg16(P1,P2: PInt64Array); inline;
var c: Int64;
begin
  c := P1[0];
  P1[0] := P2[0];
  P2[0] := c;
  c := P1[1];
  P1[1] := P2[1];
  P2[1] := c;
end;
{$else}
procedure Exchg16(P1,P2: PIntegerArray);
var c: integer;
begin
  c := P1[0];
  P1[0] := P2[0];
  P2[0] := c;
  c := P1[1];
  P1[1] := P2[1];
  P2[1] := c;
  c := P1[2];
  P1[2] := P2[2];
  P2[2] := c;
  c := P1[3];
  P1[3] := P2[3];
  P2[3] := c;
end;
{$endif}

procedure Exchg(P1,P2: PAnsiChar; count: PtrInt);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif}
var i, c: PtrInt;
    u: AnsiChar;
begin
  for i := 1 to count shr POINTERSHR do begin
    c := PPtrInt(P1)^;
    PPtrInt(P1)^ := PPtrInt(P2)^;
    PPtrInt(P2)^ := c;
    inc(P1,SizeOf(c));
    inc(P2,SizeOf(c));
  end;
  for i := 0 to (count and pred(SizeOf(c)))-1 do begin
    u := P1[i];
    P1[i] := P2[i];
    P2[i] := u;
  end;
end;
{$else}
asm // eax=P1, edx=P2, ecx=count
        push    ebx
        push    esi
        push    ecx
        shr     ecx, 2
        jz      @2
@4:     mov     ebx, [eax]
        mov     esi, [edx]
        mov     [eax], esi
        mov     [edx], ebx
        add     eax, 4
        add     edx, 4
        dec     ecx
        jnz     @4
@2:     pop     ecx
        and     ecx, 3
        jz      @0
@1:     mov     bl, [eax]
        mov     bh, [edx]
        mov     [eax], bh
        mov     [edx], bl
        inc     eax
        inc     edx
        dec     ecx
        jnz     @1
@0:     pop     esi
        pop     ebx
end;
{$endif}

function GetAllBits(Bits, BitCount: Cardinal): boolean;
begin
  if BitCount in [low(ALLBITS_CARDINAL)..high(ALLBITS_CARDINAL)] then begin
    BitCount := ALLBITS_CARDINAL[BitCount];
    result := (Bits and BitCount)=BitCount;
  end else
    result := false;
end;

// naive code gives the best performance - bts [Bits] has an overhead
function GetBit(const Bits; aIndex: PtrInt): boolean;
begin
  result := TIntegerArray(Bits)[aIndex shr 5] and (1 shl (aIndex and 31)) <> 0;
end;

procedure SetBit(var Bits; aIndex: PtrInt);
begin
  TIntegerArray(Bits)[aIndex shr 5] := TIntegerArray(Bits)[aIndex shr 5]
    or (1 shl (aIndex and 31));
end;

procedure UnSetBit(var Bits; aIndex: PtrInt);
begin
  PIntegerArray(@Bits)^[aIndex shr 5] := PIntegerArray(@Bits)^[aIndex shr 5]
    and not (1 shl (aIndex and 31));
end;

function GetBitPtr(Bits: pointer; aIndex: PtrInt): boolean;
begin
  result := PIntegerArray(Bits)[aIndex shr 5] and (1 shl (aIndex and 31)) <> 0;
end;

procedure SetBitPtr(Bits: pointer; aIndex: PtrInt);
begin
  PIntegerArray(Bits)[aIndex shr 5] := PIntegerArray(Bits)[aIndex shr 5]
    or (1 shl (aIndex and 31));
end;

procedure UnSetBitPtr(Bits: pointer; aIndex: PtrInt);
begin
  PIntegerArray(Bits)^[aIndex shr 5] := PIntegerArray(Bits)^[aIndex shr 5]
    and not (1 shl (aIndex and 31));
end;

function GetBit64(const Bits: Int64; aIndex: PtrInt): boolean;
begin
  result := aIndex in TBits64(Bits);
end;

procedure SetBit64(var Bits: Int64; aIndex: PtrInt);
begin
  include(PBits64(@Bits)^,aIndex);
end;

procedure UnSetBit64(var Bits: Int64; aIndex: PtrInt);
begin
  exclude(PBits64(@Bits)^,aIndex);
end;

function GetBitsCount(const Bits; Count: PtrInt): integer;
const POPCNTDATA: array[0..15+4] of integer = (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,0,1,3,7);
var P: PByte;
    v: PtrUInt;
    tab: {$ifdef CPUX86NOTPIC}TIntegerArray absolute POPCNTDATA{$else}PIntegerArray{$endif};
begin
  {$ifndef CPUX86NOTPIC}
  tab := @POPCNTDATA;
  {$endif CPUX86NOTPIC}
  P := @Bits;
  result := 0;
  while Count>=8 do begin
    dec(Count,8);
    v := P^;
    inc(result,tab[v and $f]);
    inc(result,tab[v shr 4]);
    inc(P);
  end;
  v := P^;
  if Count>=4 then begin
    dec(Count,4);
    inc(result,tab[v and $f]);
    v := v shr 4;
  end;
  if Count>0 then
    inc(result,tab[v and tab[Count+16]]);
end;

{$ifdef FPC}

type
  /// available type families for Free Pascal RTTI values
  // - values differs from Delphi, and are taken from FPC typinfo.pp unit
  // - here below, we defined tkLString instead of FPC tkAString to match
  // Delphi - see http://lists.freepascal.org/fpc-devel/2013-June/032233.html
  TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,tkFloat,
    tkSet,tkMethod,tkSString,tkLStringOld,tkLString,
    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
    tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
    tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
    tkHelper,tkFile,tkClassRef,tkPointer);

const
   // all potentially managed types - should match ManagedType*() functions
   tkManagedTypes = [tkLStringOld,tkLString,tkWstring,tkUstring,tkArray,
                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
   // maps record or object types
   tkRecordTypes = [tkObject,tkRecord];
   tkRecordKinds = [tkObject,tkRecord];

type
  // as defined in Delphi 6 and up
  TDelphiTypeKind = (dkUnknown, dkInteger, dkChar, dkEnumeration, dkFloat,
    dkString, dkSet, dkClass, dkMethod, dkWChar, dkLString, dkWString,
    dkVariant, dkArray, dkRecord, dkInterface, dkInt64, dkDynArray,
    dkUString, dkClassRef, dkPointer, dkProcedure);

const
  FPCTODELPHI: array[TTypeKind] of TDelphiTypeKind = (
    dkUnknown,dkInteger,dkChar,dkEnumeration,dkFloat,
    dkSet,dkMethod,dkString,dkLString,dkLString,
    dkWString,dkVariant,dkArray,dkRecord,dkInterface,
    dkClass,dkRecord,dkWChar,dkEnumeration,dkInt64,dkInt64,
    dkDynArray,dkInterface,dkProcedure,dkUString,dkWChar,
    dkPointer,dkPointer,dkClassRef,dkPointer);

  DELPHITOFPC: array[TDelphiTypeKind] of TTypeKind = (
    tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkSString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray,
    tkUString, tkClassRef, tkPointer, tkProcVar);

{$else FPC}

type
  /// available type families for Delphi 6 and up, similar to typinfo.pas
  TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray
    {$ifdef UNICODE}, tkUString, tkClassRef, tkPointer, tkProcedure{$endif});

const
  // maps record or object types
  tkRecordTypes = [tkRecord];
  tkRecordKinds = tkRecord;

{$endif}

type
  PTypeKind = ^TTypeKind;
  TOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong
    {$ifdef FPC_NEWRTTI},otSQWord,otUQWord{$endif});
  TFloatType = (ftSingle,ftDoub,ftExtended,ftComp,ftCurr);
  TTypeKinds = set of TTypeKind;

  PStrRec = ^TStrRec;
  /// map the Delphi/FPC string header, as defined in System.pas
{$ifdef FPC} // see TAnsiRec in astrings.inc
  TStrRec = record
  {$ifdef ISFPC27}
    codePage: TSystemCodePage;
    elemSize: Word;
  {$endif}
  {$ifdef CPU64}
    _Padding: DWord;
  {$endif}
    refCnt: SizeInt;
    length: SizeInt;
{$else FPC}
  /// map the Delphi/FPC dynamic array header (stored before each instance)
  TDynArrayRec = packed record
    /// dynamic array reference count (basic garbage memory mechanism)
    {$ifdef CPUX64}
    _Padding: LongInt; // Delphi/FPC XE2+ expects 16 byte alignment
    {$endif}
    refCnt: Longint;
    /// length in element count
    // - size in bytes = length*ElemSize
    length: PtrInt;
  end;
  PDynArrayRec = ^TDynArrayRec;

  TStrRec = packed record
 {$ifdef UNICODE}
    {$ifdef CPU64}
    /// padding bytes for 16 byte alignment of the header
    _Padding: LongInt;
    {$endif}
    /// the associated code page used for this string
    // - exist only since Delphi/FPC 2009
    // - 0 or 65535 for RawByteString
    // - 1200=CP_UTF16 for UnicodeString
    // - 65001=CP_UTF8 for RawUTF8
    // - the current code page for AnsiString
    codePage: Word;
    /// either 1 (for AnsiString) or 2 (for UnicodeString)
    // - exist only since Delphi/FPC 2009
    elemSize: Word;
  {$endif UNICODE}
    /// COW string reference count (basic garbage memory mechanism)
    refCnt: Longint;
    /// length in characters
    // - size in bytes = length*elemSize
    length: Longint;
{$endif FPC}
  end;

  {$ifdef FPC}
    {$PACKRECORDS C}
  {$endif FPC}

  PTypeInfo = ^TTypeInfo;
  {$ifdef HASDIRECTTYPEINFO}
  PTypeInfoStored = PTypeInfo;
  {$else}
  PTypeInfoStored = ^PTypeInfo; // = TypeInfoPtr macro in FPC typinfo.pp
  {$endif}

  // note: FPC TRecInitData is taken from typinfo.pp via SynFPCTypInfo
  // since this information is evolving/breaking a lot in the current FPC trunk

  /// map the Delphi/FPC record field RTTI
  TFieldInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    TypeInfo: PTypeInfoStored;
    {$ifdef FPC}
    Offset: sizeint;
    {$else}
    Offset: PtrUInt;
    {$endif FPC}
  end;
  PFieldInfo = ^TFieldInfo;
  {$ifdef ISDELPHI2010_OR_FPC_NEWRTTI}
  /// map the Delphi record field enhanced RTTI (available since Delphi 2010)
  TEnhancedFieldInfo = packed record
    TypeInfo: PTypeInfoStored;
    Offset: PtrUInt; // match TInitManagedField/TManagedField in FPC typinfo.pp
    {$ifdef ISDELPHI2010}
    Flags: Byte;
    NameLen: byte; // = Name[0] = length(Name)
    {$ENDIF}
  end;
  PEnhancedFieldInfo = ^TEnhancedFieldInfo;
  {$endif}

  TTypeInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    kind: TTypeKind;
    NameLen: byte;
    case TTypeKind of
    tkUnknown: (
      NameFirst: AnsiChar;
    );
    tkDynArray: (
      {$ifdef FPC}
      elSize: SizeUInt;
      elType2: PTypeInfoStored;
      varType: LongInt;
      elType: PTypeInfoStored;
      //DynUnitName: ShortStringBase;
      {$else}
      // storage byte count for this field
      elSize: Longint;
      // nil for unmanaged field
      elType: PTypeInfoStored;
      // OleAuto compatible type
      varType: Integer;
      // also unmanaged field
      elType2: PTypeInfoStored;
      {$endif}
    );
    tkArray: (
      {$ifdef FPC}
      // warning: in VER2_6, this is the element size, not full array size
      arraySize: SizeInt;
      // product of lengths of all dimensions
      elCount: SizeInt;
      {$else}
      arraySize: Integer;
      // product of lengths of all dimensions
      elCount: Integer;
      {$endif}
      arrayType: PTypeInfoStored;
      dimCount: Byte;
      dims: array[0..255 {DimCount-1}] of PTypeInfoStored;
    );
    {$ifdef FPC}
    tkRecord, tkObject:(
      {$ifdef FPC_NEWRTTI}
      RecInitInfo: Pointer;
      {$endif}
      recSize: longint;
      {$ifdef FPC_NEWRTTI}
      TotalFieldCount: longint;
      // note: for FPC 3.1.x and newer ManagedCount is deprecated
      {$else}
      ManagedCount: longint;
      // note: FPC for 3.0.x and previous generates RTTI for unmanaged fields (as in TEnhancedFieldInfo)
      {$endif}
    {$else}
    tkRecord: (
      recSize: cardinal;
      ManagedCount: integer;
    {$endif FPC}
    {$ifdef DELPHI_OR_FPC_OLDRTTI}
      ManagedFields: array[0..0] of TFieldInfo;
    {$else}
      AllFields: array[0..0] of TEnhancedFieldInfo;
    {$endif}
      {$ifdef ISDELPHI2010} // enhanced RTTI containing info about all fields
      NumOps: Byte;
      //RecOps: array[0..0] of Pointer;
      AllCount: Integer; // !!!! may need $RTTI EXPLICIT FIELDS([vcPublic])
      AllFields: array[0..0] of TEnhancedFieldInfo;
      {$endif ISDELPHI2010}
    );
    tkEnumeration: (
      EnumType: TOrdType;
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      tkEnumerationAlignment:DWORD; // needed for correct alignment !!??
      {$endif}
      {$ifdef FPC_ENUMHASINNER}
      inner:
      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
      packed
      {$endif}
      record
      {$endif}
      MinValue: longint;
      MaxValue: longint;
      EnumBaseType: PTypeInfoStored;
      {$ifdef FPC_ENUMHASINNER}
      end;
      {$endif FPC_ENUMHASINNER}
      NameList: string[255];
    );
    tkInteger: (
      IntegerType: TOrdType;
    );
    tkInt64: (
      MinInt64Value, MaxInt64Value: Int64;
    );
    tkSet: (
      SetType: TOrdType;
      {$ifdef FPC}
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      tkSetAlignment: DWORD; // needed for correct alignment !!??
      {$endif}
      {$ifndef VER3_0}
      SetSize: SizeInt;
      {$endif VER3_0}
      {$endif FPC}
      SetBaseType: PTypeInfoStored;
    );
    tkFloat: (
      FloatType: TFloatType;
    );
    tkClass: (
      ClassType: PAnsiChar; // TClass;
      ParentInfo: PTypeInfoStored;
      PropCount: SmallInt;
      UnitNameLen: byte;
    );
  end;

  TPropInfo = packed record
    PropType: PTypeInfoStored;
    GetProc: PtrInt;
    SetProc: PtrInt;
    StoredProc: PtrInt;
    Index: Integer;
    Default: Longint;
    NameIndex: SmallInt;
    {$ifdef FPC}
    PropProcs : Byte;
    {$endif}
    NameLen: byte;
  end;
  PPropInfo = ^TPropInfo;

{$ifdef HASDIRECTTYPEINFO}
type
  Deref = PTypeInfo;
{$else}
function Deref(Info: PTypeInfoStored): PTypeInfo;
{$ifdef HASINLINE} inline;
begin
  if Info=nil then
    result := pointer(Info) else
    result := Info^;
end;
{$else}
asm // Delphi is so bad at compiling above code...
        or      eax, eax
        jz      @z
        mov     eax, [eax]
        ret
@z:     db      $f3 // rep ret
end;
{$endif HASINLINE}
{$endif HASDIRECTTYPEINFO}

const
  /// codePage offset = string header size
  // - used to calc the beginning of memory allocation of a string
  STRRECSIZE = SizeOf(TStrRec);

{$ifdef HASCODEPAGE}
procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);
var r: PAnsiChar; // s may = p -> stand-alone variable
    sr: PStrRec; // local copy of r, to use register
begin
  if len<=0 then
    r := nil else begin
    GetMem(r,len+(STRRECSIZE+2));
    sr := pointer(r);
    sr^.codePage := codepage;
    sr^.elemSize := 1;
    sr^.refCnt := 1;
    sr^.length := len;
    inc(sr);
    PWord(PAnsiChar(sr)+len)^ := 0; // ensure ends with two #0
    r := pointer(sr);
    if p<>nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(p^,sr^,len);
  end;
  {$ifdef FPC}Finalize(RawByteString(s)){$else}RawByteString(s) := ''{$endif};
  pointer(s) := r;
end;

procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);
var r: PAnsiChar;
    sr: PStrRec;
begin
  if len<=0 then
    r := nil else begin
    GetMem(r,len+(STRRECSIZE+4));
    sr := pointer(r);
    sr^.codePage := CP_UTF8;
    sr^.elemSize := 1;
    sr^.refCnt := 1;
    sr^.length := len;
    inc(sr);
    PCardinal(PAnsiChar(sr)+len)^ := 0; // ends with four #0
    r := pointer(sr);
    if p<>nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(p^,sr^,len);
  end;
  {$ifdef FPC}Finalize(s){$else}s := ''{$endif};
  pointer(s) := r;
end;
{$else}
procedure FastSetStringCP(var s; p: pointer; len, codepage: PtrInt);
begin
  SetString(RawByteString(s),PAnsiChar(p),len);
end;
procedure FastSetString(var s: RawUTF8; p: pointer; len: PtrInt);
begin
  SetString(RawByteString(s),PAnsiChar(p),len);
end;
{$endif HASCODEPAGE}

procedure GetMemAligned(var s: RawByteString; p: pointer; len: PtrInt;
  out aligned: pointer);
begin
  SetString(s,nil,len+16);
  aligned := pointer(s);
  inc(PtrUInt(aligned),PtrUInt(aligned) and 15);
  if p<>nil then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(p^,aligned^,len);
end;

function ToText(k: TTypeKind): PShortString; overload;
begin
  result := GetEnumName(TypeInfo(TTypeKind),ord(k));
end;

function ToText(k: TDynArrayKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TDynArrayKind),ord(k));
end;

function UniqueRawUTF8(var UTF8: RawUTF8): pointer;
begin
  {$ifdef FPC}
  UniqueString(UTF8); // @UTF8[1] won't call UniqueString() under FPC :(
  {$endif}
  result := @UTF8[1];
end;

procedure UniqueRawUTF8ZeroToTilde(var UTF8: RawUTF8; MaxSize: integer);
var i: integer;
begin
  i := length(UTF8);
  if i>MaxSize then
    PByteArray(UTF8)[MaxSize] := 0 else
    MaxSize := i;
  for i := 0 to MaxSize-1 do
    if PByteArray(UTF8)[i]=0 then
      PByteArray(UTF8)[i] := ord('~');
end;

{$ifdef FPC}
function TDynArrayRec.GetLength: sizeint;
begin
  result := high+1;
end;

procedure TDynArrayRec.SetLength(len: sizeint);
begin
  high := len-1;
end;
{$endif FPC}

function DynArrayLength(Value: Pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}
begin
  if Value=nil then
    result := PtrInt(Value) else begin
    {$ifdef FPC}
    result := PDynArrayRec(PtrUInt(Value)-SizeOf(TDynArrayRec))^.high+1;
    {$else}
    result := PInteger(PtrUInt(Value)-SizeOf(PtrInt))^;
    {$endif}
  end;
end;

function GetTypeInfo(aTypeInfo: pointer; aExpectedKind: TTypeKind): PTypeInfo; overload;
{$ifdef HASINLINE} inline;
begin
  if (aTypeInfo<>nil) and (PTypeKind(aTypeInfo)^=aExpectedKind) then begin
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    result := GetFPCAlignPtr(aTypeInfo);
    {$else}
    result := aTypeInfo;
    inc(PByte(result),result^.NameLen);
    {$endif}
  end else
    result := nil;
end;
{$else}
asm
        test    eax, eax
        jz      @n
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        cmp     dl, [eax]
        jne     @n
        add     eax, ecx
        ret
@n:     xor     eax, eax
end;
{$endif HASINLINE}

function GetTypeInfo(aTypeInfo: pointer; const aExpectedKind: TTypeKinds): PTypeInfo; overload;
{$ifdef HASINLINE} inline;
begin
  result := aTypeInfo;
  if result<>nil then
    if result^.Kind in aExpectedKind then
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      result := GetFPCAlignPtr(result)
      {$else}
      inc(PByte(result),result^.NameLen)
      {$endif}
    else
      result := nil;
end;
{$else}
asm // eax=aTypeInfo edx=aExpectedKind
        test    eax, eax
        jz      @n
        movzx   ecx, byte ptr[eax]
        bt      edx, ecx
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        jnb     @n
        add     eax, ecx
        ret
@n:     xor     eax, eax
end;
{$endif HASINLINE}

function GetTypeInfo(aTypeInfo: pointer): PTypeInfo; overload;
{$ifdef HASINLINE} inline;
begin
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  result := GetFPCAlignPtr(aTypeInfo);
  {$else}
  result := @PAnsiChar(aTypeInfo)[PTypeInfo(aTypeInfo)^.NameLen];
  {$endif}
end;
{$else}
asm
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        add     eax, ecx
end;
{$endif HASINLINE}

function DynArrayTypeInfoToRecordInfo(aDynArrayTypeInfo: pointer;
  aDataSize: PInteger=nil): pointer;
var info: PTypeInfo;
begin
  result := nil;
  info := GetTypeInfo(aDynArrayTypeInfo,tkDynArray);
  if info=nil then
    exit;
  if info^.elType<>nil then
    result := Deref(info^.elType);
  if aDataSize<>nil then
    aDataSize^ := info^.elSize {$ifdef FPC}and $7FFFFFFF{$endif};
end;

procedure TypeInfoToName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8);
begin
  if aTypeInfo<>nil then
    FastSetString(result,PAnsiChar(@PTypeInfo(aTypeInfo)^.NameLen)+1,
      PTypeInfo(aTypeInfo)^.NameLen) else
    result := default;
end;

function TypeInfoToShortString(aTypeInfo: pointer): PShortString;
begin
  if aTypeInfo<>nil then
    result := @PTypeInfo(aTypeInfo)^.NameLen else
    result := nil;
end;

procedure TypeInfoToQualifiedName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8);
var unitname: RawUTF8;
begin
  if aTypeInfo<>nil then begin
    FastSetString(result,PAnsiChar(@PTypeInfo(aTypeInfo)^.NameLen)+1,
      PTypeInfo(aTypeInfo)^.NameLen);
    if PTypeInfo(aTypeInfo)^.Kind=tkClass then begin
      with GetTypeInfo(aTypeInfo)^ do
        FastSetString(unitname,PAnsiChar(@UnitNameLen)+1,UnitNameLen);
      result := unitname+'.'+result;
    end;
  end else result := default;
end;

function TypeInfoToName(aTypeInfo: pointer): RawUTF8;
begin
  TypeInfoToName(aTypeInfo,Result,'');
end;

function RecordTypeInfoSize(aRecordTypeInfo: pointer): integer;
var info: PTypeInfo;
begin
  info := GetTypeInfo(aRecordTypeInfo,tkRecordKinds);
  if info=nil then
    result := 0 else
    result := info^.recSize;
end;

function GetEnumInfo(aTypeInfo: pointer; out MaxValue: Integer): PShortString;
{$ifdef HASINLINE} inline;
var info: PTypeInfo;
    base: PTypeInfoStored;
begin
  if (aTypeInfo<>nil) and (PTypeKind(aTypeInfo)^=tkEnumeration) then begin
    info := GetTypeInfo(aTypeInfo);
    base := info^.{$ifdef FPC_ENUMHASINNER}inner.{$endif}EnumBaseType;
    {$ifdef FPC} // no redirection if aTypeInfo is already the base type
    if (base<>nil) and (base<>aTypeInfo) then
    {$endif}
      info := GetTypeInfo(base{$ifndef HASDIRECTTYPEINFO}^{$endif});
    MaxValue := info^.{$ifdef FPC_ENUMHASINNER}inner.{$endif}MaxValue;
    result := @info.NameList;
  end else
    result := nil;
end;
{$else}
asm // eax=aTypeInfo edx=@MaxValue
        test    eax, eax
        jz      @n
        cmp     byte ptr[eax], tkEnumeration
        jnz     @n
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        mov     eax, [eax + ecx + TTypeInfo.EnumBaseType]
        mov     eax, [eax]
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        add     eax, ecx
        mov     ecx, [eax + TTypeInfo.MaxValue]
        mov     [edx], ecx
        lea     eax, [eax + TTypeInfo.NameList]
        ret
@n:     xor     eax, eax
end;
{$endif HASINLINE}

function GetSetInfo(aTypeInfo: pointer; out MaxValue: Integer;
  out Names: PShortString): boolean;
var info: PTypeInfo;
begin
  info := GetTypeInfo(aTypeInfo,tkSet);
  if info<>nil then begin
    Names := GetEnumInfo(Deref(info^.SetBaseType),MaxValue);
    result := Names<>nil;
  end else
    result := false;
end;

const
  NULL_LOW  = ord('n')+ord('u')shl 8+ord('l')shl 16+ord('l')shl 24;
  FALSE_LOW = ord('f')+ord('a')shl 8+ord('l')shl 16+ord('s')shl 24;
  TRUE_LOW  = ord('t')+ord('r')shl 8+ord('u')shl 16+ord('e')shl 24;
  NULL_UPP  = ord('N')+ord('U')shl 8+ord('L')shl 16+ord('L')shl 24;

  EndOfJSONValueField = [#0,#9,#10,#13,' ',',','}',']'];
  EndOfJSONField = [',',']','}',':'];
  DigitChars = ['-','+','0'..'9'];
  DigitFirstChars = ['-','1'..'9']; // 0/- excluded by JSON!
  DigitFloatChars = ['-','+','0'..'9','.','E','e'];

  NULL_SHORTSTRING: string[1] = '';

procedure GetEnumNames(aTypeInfo: pointer; aDest: PPShortString);
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res<>nil then
    for i := 0 to MaxValue do begin
      aDest^ := res;
      inc(PByte(res),ord(res^[0])+1); // next short string
      inc(aDest);
    end;
end;

procedure GetEnumTrimmedNames(aTypeInfo: pointer; aDest: PRawUTF8);
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res<>nil then
    for i := 0 to MaxValue do begin
      aDest^ := TrimLeftLowerCaseShort(res);
      inc(PByte(res),ord(res^[0])+1); // next short string
      inc(aDest);
    end;
end;

function GetEnumTrimmedNames(aTypeInfo: pointer): TRawUTF8DynArray;
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res=nil then
    result := nil else begin
    SetLength(result,MaxValue+1);
    for i := 0 to MaxValue do begin
      result[i] := TrimLeftLowerCaseShort(res);
      inc(PByte(res),ord(res^[0])+1); // next short string
    end;
  end;
end;

procedure GetCaptionFromTrimmed(PS: PShortString; var result: string);
var tmp: array[byte] of AnsiChar;
    L: integer;
begin
  L := ord(PS^[0]);
  inc(PByte(PS));
  while (L>0) and (PS^[0] in ['a'..'z']) do begin inc(PByte(PS)); dec(L); end;
  tmp[L] := #0; // as expected by GetCaptionFromPCharLen/UnCamelCase
  {$ifdef FPC}Move{$else}MoveFast{$endif}(PS^,tmp,L);
  GetCaptionFromPCharLen(tmp,result);
end;

procedure GetEnumCaptions(aTypeInfo: pointer; aDest: PString);
var MaxValue, i: integer;
    res: PShortString;
begin
  res := GetEnumInfo(aTypeInfo,MaxValue);
  if res<>nil then
    for i := 0 to MaxValue do begin
      GetCaptionFromTrimmed(res,aDest^);
      inc(PByte(res),ord(res^[0])+1); // next short string
      inc(aDest);
    end;
end;

function GetEnumName(aTypeInfo: pointer; aIndex: integer): PShortString;
{$ifdef HASINLINENOTX86}
var MaxValue: integer;
begin
  result := GetEnumInfo(aTypeInfo,MaxValue);
  if (result<>nil) and (cardinal(aIndex)<=cardinal(MaxValue)) then begin
    if aIndex>0 then
      repeat
        inc(PByte(result),ord(result^[0])+1); // next short string
        dec(aIndex);
        if aIndex=0 then
          break;
        inc(PByte(result),ord(result^[0])+1); // loop unrolled twice
        dec(aIndex);
        if aIndex=0 then
          break;
      until false;
  end else
    result := @NULL_SHORTSTRING;
end;
{$else}
asm // eax=aTypeInfo edx=aIndex
        test    eax, eax
        jz      @0
        cmp     byte ptr[eax], tkEnumeration
        jnz     @0
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        mov     eax, [eax + ecx + TTypeInfo.EnumBaseType]
        mov     eax, [eax]
        movzx   ecx, byte ptr[eax + TTypeInfo.NameLen]
        cmp     edx, [eax + ecx + TTypeInfo.MaxValue]
        ja      @0
        lea     eax, [eax + ecx + TTypeInfo.NameList]
        test    edx, edx
        jz      @z
        push    edx
        shr     edx, 2 // fast by-four scanning
        jz      @1
@4:     dec     edx
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        movzx   ecx, byte ptr[eax]
        lea     eax, [eax + ecx + 1]
        jnz     @4
        pop     edx
        and     edx, 3
        jnz     @s
        ret
@1:     pop     edx
@s:     movzx   ecx, byte ptr[eax]
        dec     edx
        lea     eax, [eax + ecx + 1] // next short string
        jnz     @s
        ret
@z:     rep     ret
@0:     lea     eax, NULL_SHORTSTRING
end;
{$endif HASINLINENOTX86}

{$ifdef PUREPASCAL} // for proper inlining
function IdemPropNameUSameLen(P1,P2: PUTF8Char; P1P2Len: PtrInt): boolean;
var i,j: PtrInt;
begin
  result := false;
  j := 0;
  for i := 1 to P1P2Len shr 2 do
    if (PCardinalArray(P1)[j] xor PCardinalArray(P2)[j]) and $dfdfdfdf<>0 then
      exit else
      inc(j);
  for i := j*4 to P1P2Len-1 do
    if (ord(P1[i]) xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;
{$endif PUREPASCAL}

function FindShortStringListExact(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;
var PLen: PtrInt;
begin
  if aValueLen<>0 then
  for result := 0 to MaxValue do begin
    PLen := ord(List^[0]);
    if (PLen=aValuelen) and IdemPropNameUSameLen(@List^[1],aValue,aValueLen) then
      exit;
    inc(PByte(List),PLen+1); // next short string
  end;
  result := -1;
end;

function FindShortStringListTrimLowerCase(List: PShortString; MaxValue: integer;
  aValue: PUTF8Char; aValueLen: PtrInt): integer;
var PLen: PtrInt;
begin
  if aValueLen<>0 then
  for result := 0 to MaxValue do begin
    PLen := ord(List^[0]);
    inc(PUTF8Char(List));
    repeat
      if not(PUTF8Char(List)^ in ['a'..'z']) then
        break;
      inc(PUTF8Char(List));
      dec(PLen);
    until PLen=0;
    if (PLen=aValueLen) and IdemPropNameUSameLen(aValue,PUTF8Char(List),PLen) then
      exit;
    inc(PUTF8Char(List),PLen);
  end;
  result := -1;
end;

function GetEnumNameValue(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: integer;
  AlsoTrimLowerCase: boolean): Integer;
var List: PShortString;
    MaxValue: integer;
begin
  List := GetEnumInfo(aTypeInfo,MaxValue);
  if (aValueLen<>0) and (List<>nil) then begin
    result := FindShortStringListExact(List,MaxValue,aValue,aValueLen);
    if (result<0) and AlsoTrimLowerCase then
      result := FindShortStringListTrimLowerCase(List,MaxValue,aValue,aValueLen);
  end else
    result := -1;
end;

function GetEnumNameValueTrimmed(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: integer): integer;
var List: PShortString;
    MaxValue: integer;
begin
  List := GetEnumInfo(aTypeInfo,MaxValue);
  if (aValueLen<>0) and (List<>nil) then
    result := FindShortStringListTrimLowerCase(List,MaxValue,aValue,aValueLen) else
    result := -1;
end;

function GetEnumNameValue(aTypeInfo: pointer; const aValue: RawUTF8;
  AlsoTrimLowerCase: boolean=false): Integer;
begin
  result := GetEnumNameValue(aTypeInfo, pointer(aValue), length(aValue),
    AlsoTrimLowerCase);
end;

function GetSetName(aTypeInfo: pointer; const value): RawUTF8;
var PS: PShortString;
    i,max: integer;
begin
  result := '';
  if GetSetInfo(aTypeInfo,max,PS) then begin
    for i := 0 to max do begin
      if GetBitPtr(@value,i) then
        result := FormatUTF8('%%,',[result,PS^]);
      inc(PByte(PS),ord(PS^[0])+1); // next short string
    end;
  end;
  if result<>'' then
    SetLength(result,length(result)-1); // trim last comma
end;

procedure AppendShortComma(text: PAnsiChar; len: integer; var result: shortstring;
  trimlowercase: boolean);
begin
  if trimlowercase then
    while text^ in ['a'..'z'] do
      if len=1 then
        exit else begin
        inc(text);
        dec(len);
      end;
  if integer(ord(result[0]))+len>=255 then
    exit;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(text^,result[ord(result[0])+1],len);
  inc(result[0],len+1);
  result[ord(result[0])] := ',';
end;

procedure GetSetNameShort(aTypeInfo: pointer; const value; out result: ShortString;
  trimlowercase: boolean);
var PS: PShortString;
    i,max: integer;
begin
  result := '';
  if GetSetInfo(aTypeInfo,max,PS) then begin
    for i := 0 to max do begin
      if GetBitPtr(@value,i) then
        AppendShortComma(@PS^[1],ord(PS^[0]),result,trimlowercase);
      inc(PByte(PS),ord(PS^[0])+1); // next short string
    end;
  end;
  if result[ord(result[0])]=',' then
    dec(result[0]);
end;

function GetSetNameValue(aTypeInfo: pointer; var P: PUTF8Char;
  out EndOfObject: AnsiChar): cardinal;
var names: PShortString;
    Text: PUTF8Char;
    wasString: boolean;
    MaxValue, TextLen, i: integer;
begin
  result := 0;
  if (P<>nil) and GetSetInfo(aTypeInfo,MaxValue,names) then begin
    P := GotoNextNotSpace(P);
    if P^='[' then begin
      P := GotoNextNotSpace(P+1);
      if P^=']' then
        inc(P) else begin
        repeat
          Text := GetJSONField(P,P,@wasString,@EndOfObject,@TextLen);
          if (Text=nil) or not wasString then begin
            P := nil; // invalid input (expects a JSON array of strings)
            exit;
          end;
          if Text^='*' then begin
            if MaxValue<32 then
              result := ALLBITS_CARDINAL[MaxValue+1] else
              result := cardinal(-1);
            break;
          end;
          if Text^ in ['a'..'z'] then
            i := FindShortStringListExact(names,MaxValue,Text,TextLen) else
            i := -1;
          if i<0 then
            i := FindShortStringListTrimLowerCase(names,MaxValue,Text,TextLen);
          if i>=0 then
            SetBitPtr(@result,i);
          // unknown enum names (i=-1) would just be ignored
        until EndOfObject=']';
        if P=nil then
          exit; // avoid GPF below if already reached the input end
      end;
      while not (P^ in EndOfJSONField) do begin // mimics GetJSONField()
        if P^=#0 then begin
          P := nil;
          exit; // unexpected end
        end;
        inc(P);
      end;
      EndOfObject := P^;
      P := GotoNextNotSpace(P+1);
    end else
      result := GetCardinal(GetJSONField(P,P,nil,@EndOfObject));
  end;
end;


{ note: those low-level VariantTo*() functions are expected to be there
        even if NOVARIANTS conditional is defined (used e.g. by SynDB.TQuery) }

function VariantToInteger(const V: Variant; var Value: integer): boolean;
var tmp: TVarData;
begin
  with TVarData(V) do
  case VType of
  varNull,
  varEmpty:    Value := 0;
  varBoolean:  if VBoolean then Value := 1 else Value := 0; // normalize
  varSmallint: Value := VSmallInt;
  {$ifndef DELPHI5OROLDER}
  varShortInt: Value := VShortInt;
  varWord:     Value := VWord;
  varLongWord:
    if VLongWord<=cardinal(High(integer)) then
      Value := VLongWord else begin
      result := false;
      exit;
    end;
  {$endif}
  varByte:     Value := VByte;
  varInteger:  Value := VInteger;
  varWord64:
    if (VInt64>=0) and (VInt64<=High(integer)) then
      Value := VInt64 else begin
      result := False;
      exit;
    end;
  varInt64:
    if (VInt64>=Low(integer)) and (VInt64<=High(integer)) then
      Value := VInt64 else begin
      result := False;
      exit;
    end;
  else
    if SetVariantUnRefSimpleValue(V,tmp) then begin
      result := VariantToInteger(variant(tmp),Value);
      exit;
    end else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VariantToDouble(const V: Variant; var Value: double): boolean;
var tmp: TVarData;
begin
  with TVarData(V) do
  if VType=varVariant or varByRef then
    result := VariantToDouble(PVariant(VPointer)^,Value) else
  if VariantToInt64(V,tmp.VInt64) then begin // also handle varEmpty,varNull
    Value := tmp.VInt64;
    result := true;
  end else
  case VType of
  varDouble,varDate: begin
    Value := VDouble;
    result := true;
  end;
  varSingle: begin
    Value := VSingle;
    result := true;
  end;
  varCurrency: begin
    Value := VCurrency;
    result := true;
  end else
    if SetVariantUnRefSimpleValue(V,tmp) then
      result := VariantToDouble(variant(tmp),Value) else
      result := false;
  end;
end;

function VariantToDoubleDef(const V: Variant; const default: double=0): double;
begin
  if not VariantToDouble(V,result) then
    result := default;
end;

function VariantToCurrency(const V: Variant; var Value: currency): boolean;
var tmp: TVarData;
begin
  with TVarData(V) do
  if VType=varVariant or varByRef then
    result := VariantToCurrency(PVariant(VPointer)^,Value) else
  if VariantToInt64(V,tmp.VInt64) then begin
    Value := tmp.VInt64;
    result := true;
  end else
  case VType of
  varDouble,varDate: begin
    Value := VDouble;
    result := true;
  end;
  varSingle: begin
    Value := VSingle;
    result := true;
  end;
  varCurrency: begin
    Value := VCurrency;
    result := true;
  end else
    if SetVariantUnRefSimpleValue(V,tmp) then
      result := VariantToCurrency(variant(tmp),Value) else
      result := false;
  end;
end;

function VariantToBoolean(const V: Variant; var Value: Boolean): boolean;
var tmp: TVarData;
begin
  case TVarData(V).VType of
  varEmpty, varNull: begin
    result := false;
    exit;
  end;
  varBoolean:
    Value := TVarData(V).VBoolean;
  varInteger: // coming e.g. from GetJsonField()
    Value := TVarData(V).VInteger=1;
  else
    if SetVariantUnRefSimpleValue(V,tmp) then
      if tmp.VType=varBoolean then
        Value := tmp.VBoolean else begin
        result := false;
        exit;
      end else begin
        result := false;
        exit;
      end;
  end;
  result := true;
end;

function VariantToInt64(const V: Variant; var Value: Int64): boolean;
var tmp: TVarData;
begin
  with TVarData(V) do
  case VType of
  varNull,
  varEmpty:    Value := 0;
  varBoolean:  if VBoolean then Value := 1 else Value := 0; // normalize
  varSmallint: Value := VSmallInt;
  {$ifndef DELPHI5OROLDER}
  varShortInt: Value := VShortInt;
  varWord:     Value := VWord;
  varLongWord: Value := VLongWord;
  {$endif}
  varByte:     Value := VByte;
  varInteger:  Value := VInteger;
  varWord64:   if VInt64>=0 then
                 Value := VInt64 else begin
                 result := false;
                 exit;
               end;
  varInt64:    Value := VInt64;
  else
    if SetVariantUnRefSimpleValue(V,tmp) then begin
      result := VariantToInt64(variant(tmp),Value);
      exit;
    end else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

function VariantToInt64Def(const V: Variant; DefaultValue: Int64): Int64;
begin
  if not VariantToInt64(V,result) then
    result := DefaultValue;
end;

function VariantToIntegerDef(const V: Variant; DefaultValue: integer): integer;
begin
  if not VariantToInteger(V,result) then
    result := DefaultValue;
end;

{$ifndef NOVARIANTS}

function BinToHexDisplayLowerVariant(Bin: pointer; BinBytes: integer): variant;
begin
  RawUTF8ToVariant(BinToHexDisplayLower(Bin,BinBytes),result);
end;

function VariantHexDisplayToBin(const Hex: variant; Bin: PByte; BinBytes: integer): boolean;
var tmp: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(hex,tmp,wasString);
  result := wasstring and HexDisplayToBin(pointer(tmp),Bin,BinBytes);
end;

function VariantToDateTime(const V: Variant; var Value: TDateTime): boolean;
var tmp: RawUTF8;
    vd: TVarData;
begin
  with TVarData(V) do
  if VType=varVariant or varByRef then
    result := VariantToDateTime(PVariant(VPointer)^,Value) else
  case VType of
  varDouble,varDate: begin
    Value := VDouble;
    result := true;
  end;
  varSingle: begin
    Value := VSingle;
    result := true;
  end;
  varCurrency: begin
    Value := VCurrency;
    result := true;
  end else
    if SetVariantUnRefSimpleValue(V,vd) then
      result := VariantToDateTime(variant(vd),Value) else begin
      VariantToUTF8(V,tmp);
      Iso8601ToDateTimePUTF8CharVar(pointer(tmp),length(tmp),Value);
      result := Value<>0;
    end;
  end;
end;

procedure VariantToInlineValue(const V: Variant; var result: RawUTF8);
var wasString: boolean;
begin
  VariantToUTF8(V,result,wasString);
  if wasString then
    result := QuotedStr(pointer(result),'"');
end;

function VariantToVariantUTF8(const V: Variant): variant;
var tmp: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(V,tmp,wasString);
  if wasString then
    result := V else
    RawUTF8ToVariant(tmp,result);
end;

procedure VariantToUTF8(const V: Variant; var result: RawUTF8;
  var wasString: boolean);
var tmp: TVarData;
begin
  wasString := false;
  with TVarData(V) do
  case VType of
  varEmpty,
  varNull:
    result := NULL_STR_VAR;
  varSmallint:
    Int32ToUTF8(VSmallInt,result);
  {$ifndef DELPHI5OROLDER}
  varShortInt:
    Int32ToUTF8(VShortInt,result);
  varWord:
    UInt32ToUTF8(VWord,result);
  varLongWord:
    UInt32ToUTF8(VLongWord,result);
  {$endif}
  varByte:
    result := SmallUInt32UTF8[VByte];
  varBoolean:
    if VBoolean then
      result := SmallUInt32UTF8[1] else
      result := SmallUInt32UTF8[0];
  varInteger:
    Int32ToUTF8(VInteger,result);
  varInt64:
    Int64ToUTF8(VInt64,result);
  varWord64:
    UInt64ToUTF8(VInt64,result);
  varSingle:
    ExtendedToStr(VSingle,SINGLE_PRECISION,result);
  varDouble:
    ExtendedToStr(VDouble,DOUBLE_PRECISION,result);
  varCurrency:
    Curr64ToStr(VInt64,result);
  varDate: begin
    wasString := true;
    DateTimeToIso8601TextVar(VDate,'T',result);
  end;
  varString: begin
    wasString := true;
    {$ifdef HASCODEPAGE}
    AnyAnsiToUTF8(RawByteString(VString),result);
    {$else}
    result := RawUTF8(VString);
    {$endif}
  end;
  {$ifdef HASVARUSTRING}
  varUString: begin
    wasString := true;
    RawUnicodeToUtf8(VAny,length(UnicodeString(VAny)),result);
  end;
  {$endif}
  varOleStr: begin
    wasString := true;
    RawUnicodeToUtf8(VAny,length(WideString(VAny)),result);
  end;
  else
  if SetVariantUnRefSimpleValue(V,tmp) then
    VariantToUTF8(Variant(tmp),result,wasString) else
  if VType=varVariant or varByRef then // complex varByRef
    VariantToUTF8(PVariant(VPointer)^,result,wasString) else
  if VType=varByRef or varString then begin
    wasString := true;
    {$ifdef HASCODEPAGE}
    AnyAnsiToUTF8(PRawByteString(VString)^,result);
    {$else}
    result := PRawUTF8(VString)^;
    {$endif}
  end else
  if VType=varByRef or varOleStr then begin
    wasString := true;
    RawUnicodeToUtf8(pointer(PWideString(VAny)^),length(PWideString(VAny)^),result);
  end else
  {$ifdef HASVARUSTRING}
  if VType=varByRef or varUString then begin
    wasString := true;
    RawUnicodeToUtf8(pointer(PUnicodeString(VAny)^),length(PUnicodeString(VAny)^),result);
  end else
  {$endif}
    VariantSaveJSON(V,twJSONEscape,result); // will handle also custom types
  end;
end;

function VariantToUTF8(const V: Variant): RawUTF8;
var wasString: boolean;
begin
  VariantToUTF8(V,result,wasString);
end;

function ToUTF8(const V: Variant): RawUTF8;
var wasString: boolean;
begin
  VariantToUTF8(V,result,wasString);
end;

function VariantToUTF8(const V: Variant; var Text: RawUTF8): boolean;
begin
  VariantToUTF8(V,Text,result);
end;

function VariantEquals(const V: Variant; const Str: RawUTF8;
   CaseSensitive: boolean): boolean;
  function Complex: boolean;
  var wasString: boolean;
      tmp: RawUTF8;
  begin
    VariantToUTF8(V,tmp,wasString);
    if CaseSensitive then
      result := (tmp=Str) else
      result := IdemPropNameU(tmp,Str);
  end;
var v1,v2: Int64;
begin
  with TVarData(V) do
    case VType of
    varEmpty,varNull:
      result := Str='';
    varBoolean:
      result := VBoolean=(Str<>'');
    varString:
      if CaseSensitive then
        result := RawUTF8(VString)=Str else
        result := IdemPropNameU(RawUTF8(VString),Str);
    else if VariantToInt64(V,v1) then begin
      SetInt64(pointer(Str),v2);
      result := v1=v2;
     end else
      result := Complex;
  end;
end;

function VariantToString(const V: Variant): string;
var wasString: boolean;
    tmp: RawUTF8;
begin
  with TVarData(V) do
    case VType of
    varEmpty,varNull:
      result := ''; // default VariantToUTF8(null)='null'
    {$ifdef UNICODE} // not HASVARUSTRING: here we handle string=UnicodeString
    varUString:
      result := UnicodeString(VAny);
    else
    if VType=varByRef or varUString then
      result := PUnicodeString(VAny)^
    {$endif}
    else begin
      VariantToUTF8(V,tmp,wasString);
      if tmp='' then
        result := '' else
        UTF8DecodeToString(pointer(tmp),length(tmp),result);
    end;
    end;
end;

procedure VariantDynArrayClear(var Value: TVariantDynArray);
var p: PDynArrayRec;
    V: PVarData;
    i: integer;
    docv: word;
    handler: TCustomVariantType;
begin
  if pointer(Value)=nil then
    exit;
  p := pointer(PtrUInt(Value)-SizeOf(TDynArrayRec)); // p^ = start of heap object
  V := pointer(Value);
  pointer(Value) := nil;
  if p^.refCnt>1 then begin
    InterlockedDecrement(PInteger(@p^.refCnt)^); // FPC has refCnt: PtrInt
    exit;
  end;
  handler := nil;
  docv := DocVariantVType;
  for i := 1 to p^.length do begin
    case V^.VType of
    varEmpty..varDate,varError,varBoolean,varShortInt..varWord64: ;
    varString: {$ifdef FPC}Finalize(RawUTF8(V^.VAny)){$else}RawUTF8(V^.VAny) := ''{$endif};
    varOleStr: WideString(V^.VAny) := '';
    {$ifdef HASVARUSTRING}
    varUString: UnicodeString(V^.VAny) := '';
    {$endif}
    else
    if V^.VType=docv then
      DocVariantType.Clear(V^) else
    if V^.VType=varVariant or varByRef then
      VarClear(PVariant(V^.VPointer)^) else
    if handler=nil then
      if (V^.VType and varByRef=0) and
         FindCustomVariantType(V^.VType,handler) then
        handler.Clear(V^) else
        VarClear(variant(V^)) else
      if V^.VType=handler.VarType then
        handler.Clear(V^) else
        VarClear(variant(V^));
    end;
    inc(V);
  end;
  FreeMem(p);
end;

{$endif NOVARIANTS}


{$ifdef UNICODE}
// this Pos() is seldom used, it was decided to only define it under
// Delphi 2009+ (which expect such a RawUTF8 specific overloaded version)

function Pos(const substr, str: RawUTF8): Integer; overload;
begin
  Result := PosEx(substr, str, 1);
end;

function IntToString(Value: integer): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[23],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[23]-P,result);
end;

function IntToString(Value: cardinal): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[23],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[23]-P,result);
end;

function IntToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt64(@tmp[31],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[31]-P,result);
end;

function DoubleToString(Value: Double): string;
var tmp: ShortString;
begin
  if Value=0 then
    result := '0' else
    Ansi7ToString(PWinAnsiChar(@tmp[1]),
      ExtendedToString(tmp,Value,DOUBLE_PRECISION),result);
end;

function Curr64ToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
begin
  Ansi7ToString(tmp,Curr64ToPChar(Value,tmp),result);
end;

{$else UNICODE}

{$ifdef PUREPASCAL}
function IntToString(Value: integer): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if cardinal(Value)<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt32(@tmp[23],Value);
    SetString(result,P,@tmp[23]-P);
  end;
end;
{$else}
function IntToString(Value: integer): string;
asm
  jmp Int32ToUTF8
end;
{$endif PUREPASCAL}

function IntToString(Value: cardinal): string;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrUInt32(@tmp[23],Value);
    SetString(result,P,@tmp[23]-P);
  end;
end;

function IntToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
begin
  if (Value>=0) and (Value<=high(SmallUInt32UTF8)) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt64(@tmp[31],Value);
    SetString(result,P,@tmp[31]-P);
  end;
end;

function DoubleToString(Value: Double): string;
var tmp: ShortString;
begin
  if Value=0 then
    result := '0' else
    SetString(result,PAnsiChar(@tmp[1]),ExtendedToString(tmp,Value,DOUBLE_PRECISION));
end;

function Curr64ToString(Value: Int64): string;
begin
  result := Curr64ToStr(Value);
end;

{$endif UNICODE}

procedure bswap64array(a,b: PQWordArray; n: PtrInt);
{$ifdef CPUX86} {$ifdef FPC}nostackframe; assembler;{$endif}
asm
    push  ebx
    push  esi
@1: mov   ebx, dword ptr[eax]
    mov   esi, dword ptr[eax + 4]
    bswap ebx
    bswap esi
    mov   dword ptr[edx + 4], ebx
    mov   dword ptr[edx], esi
    add   eax, 8
    add   edx, 8
    dec   ecx
    jnz   @1
    pop   esi
    pop   ebx
end;
{$else}
{$ifdef CPUX64}
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm
    .noframe // rcx=@a rdx=@b r8=n (Linux: rdi,rsi,rdx)
{$endif FPC}
@1: {$ifdef win64}
    mov   rax, qword ptr[rcx]
    bswap rax
    mov   qword ptr[rdx], rax
    add   rcx, 8
    add   rdx, 8
    dec   r8
    {$else}
    mov   rax, qword ptr[rdi]
    bswap rax
    mov   qword ptr[rsi], rax
    add   rdi, 8
    add   rsi, 8
    dec   rdx
    {$endif win64}
    jnz @1
end;
{$else}
var i: PtrInt;
begin
  for i := 0 to n-1 do
    b^[i] := {$ifdef FPC}SwapEndian{$else}bswap64{$endif}(a^[i]);
end;
{$endif CPUX64}
{$endif CPUX86}

{$ifdef FPC}
function bswap32(a: cardinal): cardinal;
begin
  result := SwapEndian(a); // use fast platform-specific function
end;

function bswap64(const a: QWord): QWord;
begin
  result := SwapEndian(a); // use fast platform-specific function
end;
{$else}
{$ifdef CPUX64}
function bswap32(a: cardinal): cardinal;
asm
  .NOFRAME // ecx=a (Linux: edi)
  {$ifdef win64}
  mov eax, ecx
  {$else}
  mov eax, edi
  {$endif win64}
  bswap eax
end;

function bswap64(const a: QWord): QWord;
asm
  .NOFRAME // rcx=a (Linux: rdi)
  {$ifdef win64}
  mov rax, rcx
  {$else}
  mov rax, rdi
  {$endif win64}
  bswap rax
end;
{$else}
{$ifdef CPUX86}
function bswap32(a: cardinal): cardinal;
asm
  bswap eax
end;

function bswap64(const a: QWord): QWord;
asm
  mov edx, a.TQWordRec.L
  mov eax, a.TQWordRec.H
  bswap edx
  bswap eax
end;
{$else}
function bswap32(a: cardinal): cardinal;
begin
  result := ((a and $ff)shl 24)or((a and $ff00)shl 8)or
            ((a and $ff0000)shr 8)or((a and $ff000000)shr 24);
end;

function bswap64(const a: QWord): QWord;
begin
  TQWordRec(result).L := bswap32(TQWordRec(a).H);
  TQWordRec(result).H := bswap32(TQWordRec(a).L);
end;
{$endif CPUX86}
{$endif CPUX64}
{$endif FPC}

{$ifndef PUREPASCAL} { these functions are implemented in asm }
{$ifndef LVCL}       { don't define these functions twice }
{$ifndef FPC}        { some asm functions use some low-level system.pas calls }

{$define DEFINED_INT32TOUTF8}

function Int32ToUTF8(Value : PtrInt): RawUtf8; // 3x faster than SysUtils.IntToStr
// from IntToStr32_JOH_IA32_6_a, adapted for Delphi 2009+
asm // eax=Value, edx=@result
        push    ebx
        push    edi
        push    esi
        mov     ebx, eax                // value
        sar     ebx, 31                 // 0 for +ve value or -1 for -ve value
        xor     eax, ebx
        sub     eax, ebx                // abs(value)
        mov     esi, 10                 // max dig in result
        mov     edi, edx                // @result
        cmp     eax, 10
        sbb     esi, 0
        cmp     eax, 100
        sbb     esi, 0
        cmp     eax, 1000
        sbb     esi, 0
        cmp     eax, 10000
        sbb     esi, 0
        cmp     eax, 100000
        sbb     esi, 0
        cmp     eax, 1000000
        sbb     esi, 0
        cmp     eax, 10000000
        sbb     esi, 0
        cmp     eax, 100000000
        sbb     esi, 0
        cmp     eax, 1000000000
        sbb     esi, ebx                // esi=dig (including sign character)
        mov     ecx, [edx]              // result
        test    ecx, ecx
        je      @newstr                 // create new string for result
        cmp     dword ptr[ecx - 8], 1
        jne     @chgstr                 // reference count <> 1
        cmp     esi, [ecx - 4]
        je      @lenok                  // existing length = required length
        sub     ecx, STRRECSIZE         // allocation address
        push    eax                     // abs(value)
        push    ecx
        mov     eax, esp
        lea     edx, [esi + STRRECSIZE + 1] // new allocation size
        call    System.@ReallocMem      // reallocate result string
        pop     ecx
        pop     eax                     // abs(value)
        add     ecx, STRRECSIZE         // result
        mov     [ecx - 4], esi          // set new length
        mov     byte ptr[ecx + esi], 0  // add null terminator
        mov     [edi], ecx              // set result address
        jmp     @lenok
@chgstr:mov     edx, dword ptr[ecx - 8] // reference count
        add     edx, 1
        jz      @newstr                 // refcount = -1 (string constant)
lock    dec     dword ptr[ecx - 8]      // decrement existing reference count
@newstr:push    eax                     // abs(value)
        mov     eax, esi                // length
        {$ifdef UNICODE}
        mov     edx, CP_UTF8            // utf-8 code page for delphi 2009+
        {$endif}
        call    System.@NewAnsiString
        mov     [edi], eax              // set result address
        mov     ecx, eax                // result
        pop     eax                     // abs(value)
@lenok: mov     byte ptr[ecx], '-'      // store '-' character (may be overwritten)
        add     esi, ebx                // dig (excluding sign character)
        sub     ecx, ebx                // destination of 1st dig
        sub     esi, 2                  // dig (excluding sign character) - 2
        jle     @findig                 // 1 or 2 dig value
        cmp     esi, 8                  // 10 dig value?
        jne     @setres              // not a 10 dig value
        sub     eax, 2000000000         // dig 10 must be either '1' or '2'
        mov     dl, '2'
        jnc     @set10               // dig 10 = '2'
        mov     dl, '1'                 // dig 10 = '1'
        add     eax, 1000000000
@set10: mov     [ecx], dl               // save dig 10
        mov     esi, 7                  // 9 dig remaining
        add     ecx, 1                  // destination of 2nd dig
@setres:mov     edi, $28f5c29           // ((2^32)+100-1)/100
@loop:  mov     ebx, eax                // dividend
        mul     edi                     // edx = dividend div 100
        mov     eax, edx                // set next dividend
        imul    edx, -200             // -2 * (100 * dividend div  100)
        movzx   edx, word ptr[TwoDigitLookup + ebx * 2 + edx] // dividend mod 100 in ascii
        mov     [ecx + esi], dx
        sub     esi, 2
        jg      @loop                   // loop until 1 or 2 dig remaining
@findig:pop     esi
        pop     edi
        pop     ebx
        jnz     @last
        movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     [ecx], ax               // save final 2 dig
        ret
@last:  or      al, '0'                 // ascii adjustment
        mov     [ecx], al               // save final dig
end;

function Int64ToUTF8(Value: Int64): RawUtf8;
asm     // from IntToStr64_JOH_IA32_6_b, adapted for Delphi 2009+
        push    ebx
        mov     ecx, [ebp + 8]          // low integer of val
        mov     edx, [ebp + 12]         // high integer of val
        xor     ebp, ebp                // clear sign flag (ebp already pushed)
        mov     ebx, ecx                // low integer of val
        test    edx, edx
        jnl     @absval
        mov     ebp, 1                  // ebp = 1 for -ve val or 0 for +ve val
        neg     ecx
        adc     edx, 0
        neg     edx
@absval:jnz     @large                  // edx:ecx = abs(val)
        test    ecx, ecx
        js      @large
        mov     edx, eax                // @result
        mov     eax, ebx                // low integer of val
        call    Int32ToUtf8             // call fastest integer inttostr function
        pop     ebx
@exit:  pop     ebp                     // restore stack and exit
        ret     8
@large: push    edi
        push    esi
        mov     edi, eax
        xor     ebx, ebx
        xor     eax, eax
@t15:   cmp     edx, $00005af3          // test for 15 or more dig
        jne     @chk15                  // 100000000000000 div $100000000
        cmp     ecx, $107a4000          // 100000000000000 mod $100000000
@chk15: jb      @t13
@t17:   cmp     edx, $002386f2          // test for 17 or more dig
        jne     @chk17                  // 10000000000000000 div $100000000
        cmp     ecx, $6fc10000          // 10000000000000000 mod $100000000
@chk17: jb      @t1516
@t19:   cmp     edx, $0de0b6b3          // test for 19 dig
        jne     @chk19                  // 1000000000000000000 div $100000000
        cmp     ecx, $a7640000          // 1000000000000000000 mod $100000000
@chk19: jb      @t1718
        mov     al, 19
        jmp     @setl2
@t1718: mov     bl, 18                  // 17 or 18 dig
        cmp     edx, $01634578          // 100000000000000000 div $100000000
        jne     @setlen
        cmp     ecx, $5d8a0000          // 100000000000000000 mod $100000000
        jmp     @setlen
@t1516: mov     bl, 16                  // 15 or 16 dig
        cmp     edx, $00038d7e          // 1000000000000000 div $100000000
        jne     @setlen
        cmp     ecx, $a4c68000          // 1000000000000000 mod $100000000
        jmp     @setlen
@t13:   cmp     edx, $000000e8          // test for 13 or more dig
        jne     @chk13                  // 1000000000000 div $100000000
        cmp     ecx, $d4a51000          // 1000000000000 mod $100000000
@chk13: jb      @t11
@t1314: mov     bl, 14                  // 13 or 14 dig
        cmp     edx, $00000918          // 10000000000000 div $100000000
        jne     @setlen
        cmp     ecx, $4e72a000          // 10000000000000 mod $100000000
        jmp     @setlen
@t11:   cmp     edx, $02                // 10, 11 or 12 dig
        jne     @chk11                  // 10000000000 div $100000000
        cmp     ecx, $540be400          // 10000000000 mod $100000000
@chk11: mov     bl, 11
        jb      @setlen                 // 10 dig
@t1112: mov     bl, 12                  // 11 or 12 dig
        cmp     edx, $17                // 100000000000 div $100000000
        jne     @setlen
        cmp     ecx, $4876e800          // 100000000000 mod $100000000
@setlen:sbb     eax, 0                  // adjust for odd/evem digit count
        add     eax, ebx
@setl2: push    ecx                     // abs(val) in edx:ecx, dig in eax
        push    edx                     // save abs(val)
        lea     edx, [eax + ebp]        // digit needed (including sign character)
        mov     ecx, [edi]              // @result
        mov     esi, edx                // digit needed (including sign character)
        test    ecx, ecx
        je      @newstr                 // create new ansistring for result
        cmp     dword ptr[ecx - 8], 1
        jne     @chgstr                 // reference count <> 1
        cmp     esi, [ecx - 4]
        je      @lenok                  // existing length = required length
        sub     ecx, STRRECSIZE         // allocation address
        push    eax                     // abs(val)
        push    ecx
        mov     eax, esp
        lea     edx, [esi + STRRECSIZE + 1] // new allocation size
        call    System.@ReallocMem      // reallocate result ansistring
        pop     ecx
        pop     eax                     // abs(val)
        add     ecx, STRRECSIZE         // @result
        mov     [ecx - 4], esi          // set new length
        mov     byte ptr[ecx + esi], 0  // add null terminator
        mov     [edi], ecx              // set result address
        jmp     @lenok
@chgstr:mov     edx, dword ptr[ecx - 8] // reference count
        add     edx, 1
        jz      @newstr                 // refcount = -1 (ansistring constant)
lock    dec     dword ptr[ecx - 8]      // decrement existing reference count
@newstr:push    eax                     // abs(val)
        mov     eax, esi                // length
        {$ifdef UNICODE}
        mov     edx, CP_UTF8            // utf-8 code page for delphi 2009+
        {$endif}
        call    System.@NewAnsiString
        mov     [edi], eax              // set result address
        mov     ecx, eax                // @result
        pop     eax                     // abs(val)
@lenok: mov     edi, [edi]              // @result
        sub     esi, ebp                // digit needed (excluding sign character)
        mov     byte ptr[edi], '-'      // store '-' character (may be overwritten)
        add     edi, ebp                // destination of 1st digit
        pop     edx                     // restore abs(val)
        pop     eax
        cmp     esi, 17
        jl      @less17                 // dig < 17
        je      @set17                  // dig = 17
        cmp     esi, 18
        je      @set18                  // dig = 18
        mov     cl, '0' - 1
        mov     ebx, $a7640000          // 1000000000000000000 mod $100000000
        mov     ebp, $0de0b6b3          // 1000000000000000000 div $100000000
@dig19: add     ecx, 1
        sub     eax, ebx
        sbb     edx, ebp
        jnc     @dig19
        add     eax, ebx
        adc     edx, ebp
        mov     [edi], cl
        add     edi, 1
@set18: mov     cl, '0' - 1
        mov     ebx, $5d8a0000          // 100000000000000000 mod $100000000
        mov     ebp, $01634578          // 100000000000000000 div $100000000
@dig18: add     ecx, 1
        sub     eax, ebx
        sbb     edx, ebp
        jnc     @dig18
        add     eax, ebx
        adc     edx, ebp
        mov     [edi], cl
        add     edi, 1
@set17: mov     cl, '0' - 1
        mov     ebx, $6fc10000          // 10000000000000000 mod $100000000
        mov     ebp, $002386f2          // 10000000000000000 div $100000000
@dig17: add     ecx, 1
        sub     eax, ebx
        sbb     edx, ebp
        jnc     @dig17
        add     eax, ebx
        adc     edx, ebp
        mov     [edi], cl
        add     edi, 1                  // update destination
        mov     esi, 16                 // set 16 dig left
@less17:mov     ecx, 100000000          // process next 8 dig
        div     ecx                     // edx:eax = abs(val) = dividend
        mov     ebp, eax                // dividend div 100000000
        mov     ebx, edx
        mov     eax, edx                // dividend mod 100000000
        mov     edx, $51eb851f
        mul     edx
        shr     edx, 5                  // dividend div 100
        mov     eax, edx                // set next dividend
        lea     edx, [edx * 4 + edx]
        lea     edx, [edx * 4 + edx]
        shl     edx, 2                  // dividend div 100 * 100
        sub     ebx, edx                // remainder (0..99)
        movzx   ebx, word ptr[TwoDigitLookup + ebx * 2]
        shl     ebx, 16
        mov     edx, $51eb851f
        mov     ecx, eax                // dividend
        mul     edx
        shr     edx, 5                  // dividend div 100
        mov     eax, edx
        lea     edx, [edx * 4 + edx]
        lea     edx, [edx * 4 + edx]
        shl     edx, 2                  // dividend div 100 * 100
        sub     ecx, edx                // remainder (0..99)
        or      bx, word ptr[TwoDigitLookup + ecx * 2]
        mov     [edi + esi - 4], ebx        // store 4 dig
        mov     ebx, eax
        mov     edx, $51eb851f
        mul     edx
        shr     edx, 5                  // edx = dividend div 100
        lea     eax, [edx * 4 + edx]
        lea     eax, [eax * 4 + eax]
        shl     eax, 2                  // eax = dividend div 100 * 100
        sub     ebx, eax                // remainder (0..99)
        movzx   ebx, word ptr[TwoDigitLookup + ebx * 2]
        movzx   ecx, word ptr[TwoDigitLookup + edx * 2]
        shl     ebx, 16
        or      ebx, ecx
        mov     [edi + esi - 8], ebx    // store 4 dig
        mov     eax, ebp                // remainder
        sub     esi, 10                 // dig left - 2
        jz      @last2
@small: mov     edx, $28f5c29           // ((2^32)+100-1)/100
        mov     ebx, eax                // dividend
        mul     edx
        mov     eax, edx                // set next dividend
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ebx * 2 + edx] // dividend mod 100 in ascii
        mov     [edi + esi], dx
        sub     esi, 2
        jg      @small                  // repeat until less than 2 dig remaining
        jz      @last2
        or      al, '0'                 // ascii adjustment
        mov     [edi], al               // save final digit
        jmp     @done
@last2: movzx   eax, word ptr[TwoDigitLookup + eax * 2]
        mov     [edi], ax               // save final 2 dig
@done:  pop     esi
        pop     edi
        pop     ebx
end;

function Trim(const S: RawUTF8): RawUTF8;
asm  // fast implementation by John O'Harrow, modified for Delphi 2009+
        test    eax, eax                 // S = nil?
        xchg    eax, edx
        jz      System.@LStrClr          // Yes, Return Empty String
        mov     ecx, [edx - 4]           // Length(S)
        cmp     byte ptr[edx], ' '       // S[1] <= ' '?
        jbe     @left                    // Yes, Trim Leading Spaces
        cmp     byte ptr[edx + ecx - 1], ' '  // S[Length(S)] <= ' '?
        jbe     @right                   // Yes, Trim Trailing Spaces
        jmp     System.@LStrLAsg         // No, Result := S (which occurs most time)
@left:  dec     ecx                      // Strip Leading Whitespace
        jle     System.@LStrClr          // All Whitespace
        inc     edx
        cmp     byte ptr[edx], ' '
        jbe     @left
@done:  cmp     byte ptr[edx + ecx - 1], ' '
{$ifdef UNICODE}
        jbe     @right
        push    CP_UTF8 // UTF-8 code page for Delphi 2009+
        call    System.@LStrFromPCharLen // we need a call, not a jmp here
        rep     ret
{$else} ja      System.@LStrFromPCharLen
{$endif}
@right: dec     ecx                      // Strip Trailing Whitespace
        jmp     @done
end;

{$endif FPC}  { above asm function had some low-level system.pas calls }

{$endif LVCL}
{$endif PUREPASCAL}

{$ifdef HASINLINE}
function CompareMemFixed(P1, P2: Pointer; Length: PtrInt): Boolean;
var i: PtrInt;
begin
  result := false;
  for i := 0 to (Length shr POINTERSHR)-1 do
    if PPtrIntArray(P1)[i]<>PPtrIntArray(P2)[i] then
      exit;
  for i := Length-(Length and POINTERAND) to Length-1 do
    if PByteArray(P1)[i]<>PByteArray(P2)[i] then
      exit;
  result := true;
end;
{$endif HASINLINE}

function CompareMemSmall(P1, P2: Pointer; Length: PtrInt): Boolean;
var i: PtrInt;
begin
  result := false;
  for i := 0 to Length-1 do
    if PByteArray(P1)[i]<>PByteArray(P2)[i] then
      exit;
  result := true;
end;

{$ifdef HASINLINE}
procedure FillZero(var dest; count: PtrInt);
begin
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(dest,count,0);
end;
{$else}
procedure FillZero(var dest; count: PtrInt);
asm
  xor ecx, ecx
  jmp dword ptr [FillCharFast]
end;
{$endif}

function PosCharAny(Str: PUTF8Char; Characters: PAnsiChar): PUTF8Char;
var s: PAnsiChar;
    c: AnsiChar;
begin
  if (Str<>nil) and (Characters<>nil) and (Characters^<>#0) then
    repeat
      c := Str^;
      if c=#0 then
        break;
      s := Characters;
      repeat
        if s^=c then begin
          result := Str;
          exit;
        end;
        inc(s);
      until s^=#0;
      inc(Str);
    until false;
  result := nil;
end;

function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;
var i,j,n: PtrInt;
begin
  if (OldChar<>NewChar) and (Source<>'') then begin
    n := length(Source);
    for i := 0 to n-1 do
      if PAnsiChar(pointer(Source))[i]=OldChar then begin
        FastSetString(result,PAnsiChar(pointer(Source)),n);
        for j := i to n-1 do
          if PAnsiChar(pointer(result))[j]=OldChar then
            PAnsiChar(pointer(result))[j] := NewChar;
        exit;
      end;
  end;
  result := Source;
end;

function IdemPChar2(table: PNormTable; p: PUTF8Char; up: PAnsiChar): boolean;
  {$ifdef HASINLINE}inline;{$endif}
var u: AnsiChar;
begin // here p and up are expected to be <> nil
  result := false;
  dec(PtrUInt(p),PtrUInt(up));
  repeat
    u := up^;
    if u=#0 then
      break;
    if table^[up[PtrUInt(p)]]<>u then
      exit;
    inc(up);
  until false;
  result := true;
end;

function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): PtrInt;
var u: AnsiChar;
    table: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin
  if uppersubstr<>nil then begin
    {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7;{$endif}
    u := uppersubstr^;
    for result := 1 to Length(str) do
      if table[str[result]]=u then
        if {$ifdef CPUX86NOTPIC}IdemPChar({$else}IdemPChar2(table,{$endif}
           @PUTF8Char(pointer(str))[result],PAnsiChar(uppersubstr)+1) then
          exit;
  end;
  result := 0;
end;

function StrPosI(uppersubstr,str: PUTF8Char): PUTF8Char;
var u: AnsiChar;
    table: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin
  if (uppersubstr<>nil) and (str<>nil) then begin
    {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7;{$endif}
    u := uppersubstr^;
    result := str;
    while result^<>#0 do begin
      if table[result^]=u then
        if {$ifdef CPUX86NOTPIC}IdemPChar({$else}IdemPChar2(table,{$endif}
           result+1,PAnsiChar(uppersubstr)+1) then
          exit;
      inc(result);
    end;
  end;
  result := nil;
end;

function PosIU(substr: PUTF8Char; const str: RawUTF8): Integer;
var p: PUTF8Char;
begin
  if (substr<>nil) and (str<>'') then begin
    p := pointer(str);
    repeat
      if GetNextUTF8Upper(p)=ord(substr^) then
        if IdemPCharU(p,substr+1) then begin
          result := p-pointer(str);
          exit;
        end;
    until p^=#0;
  end;
  result := 0;
end;

procedure AppendCharToRawUTF8(var Text: RawUTF8; Ch: AnsiChar);
var L: integer;
begin
  L := length(Text);
  SetLength(Text,L+1);
  PByteArray(Text)[L] := ord(Ch);
end;

procedure AppendBufferToRawUTF8(var Text: RawUTF8; Buffer: pointer; BufferLen: PtrInt);
var L: PtrInt;
begin
  if BufferLen<=0 then
    exit;
  L := length(Text);
  SetLength(Text,L+BufferLen);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Buffer^,pointer(PtrInt(Text)+L)^,BufferLen);
end;

procedure AppendBuffersToRawUTF8(var Text: RawUTF8; const Buffers: array of PUTF8Char);
var i,len,TextLen: integer;
    lens: array[0..63] of integer;
    P: PUTF8Char;
begin
  if high(Buffers)>high(lens) then
    raise ESynException.Create('Too many params in AppendBuffersToRawUTF8()');
  len := 0;
  for i := 0 to high(Buffers) do begin
    lens[i] := StrLen(Buffers[i]);
    inc(len,lens[i]);
  end;
  TextLen := Length(Text);
  SetLength(Text,TextLen+len);
  P := pointer(Text);
  inc(P,TextLen);
  for i := 0 to high(Buffers) do
  if Buffers[i]<>nil then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Buffers[i]^,P^,lens[i]);
    inc(P,lens[i]);
  end;
end;

function AppendRawUTF8ToBuffer(Buffer: PUTF8Char; const Text: RawUTF8): PUTF8Char;
var L: PtrInt;
begin
  L := length(Text);
  if L<>0 then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Pointer(Text)^,Buffer^,L);
    inc(Buffer,L);
  end;
  result := Buffer;
end;

function AppendUInt32ToBuffer(Buffer: PUTF8Char; Value: cardinal): PUTF8Char;
var L: integer;
    tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then
    result := AppendRawUTF8ToBuffer(Buffer,SmallUInt32UTF8[Value]) else begin
    P := StrUInt32(@tmp[23],Value);
    L := @tmp[23]-P;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,Buffer^,L);
    result := Buffer+L;
  end;
end;

function QuotedStr(const S: RawUTF8; Quote: AnsiChar): RawUTF8;
begin
  QuotedStr(Pointer(S),Quote,result);
end;

function QuotedStr(Text: PUTF8Char; Quote: AnsiChar): RawUTF8;
begin
  QuotedStr(Text,Quote,result);
end;

procedure QuotedStr(Text: PUTF8Char; Quote: AnsiChar; var result: RawUTF8);
var n, L, first: integer;
    P: PUTF8Char;
label quot;
begin
  n := 0;
  L := 0;
  first := n;
  if Text<>nil then begin
    P := Text;
    repeat
      if P[L]=#0 then
        break else
      if P[L]<>Quote then begin
        inc(L);
        continue;
      end;
      first := L;
      inc(L);
      inc(n);
      repeat
        if P[L]=#0 then
          break else
        if P[L]<>Quote then begin
          inc(L);
          continue;
        end;
        inc(L);
        inc(n);
      until false;
      break;
    until false;
  end;
  FastSetString(result,nil,L+n+2);
  P := pointer(Result);
  P^ := Quote;
  inc(P);
  if n=0 then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Text^,P^,L);
    inc(P,L);
  end else begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Text^,P^,first);
    n := first;
    L := first;
    goto quot;
    repeat
      if Text[L]=#0 then
        break else
      if Text[L]<>Quote then begin
        P[n] := Text[L];
        inc(L);
        inc(n);
      end else begin
quot:   PWord(P+n)^ := ord(Quote)+ord(Quote) shl 8;
        inc(L);
        inc(n,2);
      end;
    until false;
    inc(P,n);
  end;
  P^ := Quote;
  //Assert(P-pointer(Result)+1=length(result));
end;

function GotoEndOfQuotedString(P: PUTF8Char): PUTF8Char;
var quote: AnsiChar;
begin // P^=" or P^=' at function call
  quote := P^;
  inc(P);
  repeat
    if P^=#0 then
      break else
    if P^<>quote then
      inc(P) else
      if P[1]=quote then // allow double quotes inside string
        inc(P,2) else
        break; // end quote
  until false;
  result := P;
end; // P^='"' at function return

procedure QuotedStrJSON(const aText: RawUTF8; var result: RawUTF8;
   const aPrefix, aSuffix: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  if NeedsJsonEscape(aText) then
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddString(aPrefix);
      Add('"');
      AddJSONEscape(pointer(aText));
      Add('"');
      AddString(aSuffix);
      SetText(result);
      exit;
    finally
      Free;
    end else
    result := aPrefix+'"'+aText+'"'+aSuffix;
end;

function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
var c: AnsiChar;
begin // P^='"' at function call
  inc(P);
  repeat
    c := P^;
    if c=#0 then
      break else
    if c<>'\' then
      if c<>'"' then // ignore \"
        inc(P) else
        break else    // found ending "
      if P[1]=#0 then // avoid potential buffer overflow issue for \#0
        break else
        inc(P,2);     // ignore \?
  until false;
  result := P;
end; // P^='"' at function return

function GotoNextNotSpace(P: PUTF8Char): PUTF8Char;
begin
  {$ifdef FPC}
  while (P^<=' ') and (P^<>#0) do inc(P);
  {$else}
  if P^ in [#1..' '] then
    repeat
      inc(P)
    until not(P^ in [#1..' ']);
  {$endif}
  result := P;
end;

function GotoNextSpace(P: PUTF8Char): PUTF8Char;
begin
  if P^>' ' then
    repeat
      inc(P)
    until P^<=' ';
  result := P;
end;

function NextNotSpaceCharIs(var P: PUTF8Char; ch: AnsiChar): boolean;
begin
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^=ch then begin
    inc(P);
    result := true;
  end else
    result := false;
end;

function UnQuoteSQLStringVar(P: PUTF8Char; out Value: RawUTF8): PUTF8Char;
var quote: AnsiChar;
    PBeg, PS: PUTF8Char;
    n: PtrInt;
begin
  if P=nil then begin
    result := nil;
    exit;
  end;
  quote := P^; // " or '
  inc(P);
  // compute unquoted string length
  PBeg := P;
  n := 0;
  repeat
    if P^=#0 then
      break;
    if P^<>quote then
      inc(P) else
      if P[1]=quote then begin
        inc(P,2); // allow double quotes inside string
        inc(n);
      end else
        break; // end quote
  until false;
  if P^=#0 then begin
    result := nil; // end of string before end quote -> incorrect
    exit;
  end;
  // create unquoted string
  if n=0 then
    // no quote within
    FastSetString(Value,PBeg,P-PBeg) else begin
    // unescape internal quotes
    SetLength(Value,P-PBeg-n);
    P := PBeg;
    PS := Pointer(Value);
    repeat
      if P^=quote then
        if P[1]=quote then
          inc(P) else // allow double quotes inside string
          break; // end quote
      PS^ := P^;
      inc(PByte(PS));
      inc(P);
    until false;
  end;
  result := P+1;
end;

function UnQuoteSQLString(const Value: RawUTF8): RawUTF8;
begin
  UnQuoteSQLStringVar(pointer(Value),result);
end;

function UnQuotedSQLSymbolName(const ExternalDBSymbol: RawUTF8): RawUTF8;
begin
  if (ExternalDBSymbol<>'') and
     (ExternalDBSymbol[1] in ['[','"','''','(']) then // e.g. for ZDBC's GetFields()
    result := copy(ExternalDBSymbol,2,length(ExternalDBSymbol)-2) else
    result := ExternalDBSymbol;
end;

function isSelect(P: PUTF8Char; SelectClause: PRawUTF8): boolean;
var from: PUTF8Char;
begin
  if P<>nil then begin
    P := SQLBegin(P);
    case IdemPCharArray(P, ['SELECT','EXPLAIN ','VACUUM','PRAGMA','WITH']) of
    0: if P[6]<=' ' then begin
         if SelectClause<>nil then begin
           inc(P,7);
           from := StrPosI(' FROM ',P);
           if from=nil then
             SelectClause^ := '' else
             FastSetString(SelectClause^,P,from-P);
         end;
         result := true;
       end else
         result := false;
    1:   result := true;
    2,3: result := P[6] in [#0..' ',';'];
    4:   result := (P[4]<=' ') and not (ContainsUTF8(P+5,'INSERT') or
           ContainsUTF8(P+5,'UPDATE') or ContainsUTF8(P+5,'DELETE'));
    else result := false;
    end;
  end else
    result := true; // assume '' statement is SELECT command
end;

function SQLBegin(P: PUTF8Char): PUTF8Char;
begin
  if P<>nil then
  repeat
    if P^<=' ' then // ignore blanks
      repeat
        if P^=#0 then
          break else
          inc(P)
      until P^>' ';
    if PWord(P)^=ord('-')+ord('-')shl 8 then // SQL comments
      repeat
        inc(P)
      until P^ in [#0,#10]
    else
    if PWord(P)^=ord('/')+ord('*')shl 8 then begin // C comments
      inc(P);
      repeat
        inc(P);
        if PWord(P)^=ord('*')+ord('/')shl 8 then begin
          inc(P,2);
          break;
        end;
      until P^=#0;
    end
    else break;
 until false;
 result := P;
end;

procedure SQLAddWhereAnd(var where: RawUTF8; const condition: RawUTF8);
begin
  if where='' then
    where := condition else
    where := where+' and '+condition;
end;

procedure Base64MagicDecode(var ParamValue: RawUTF8);
var
  tmp: RawUTF8;
begin // '\uFFF0base64encodedbinary' decode into binary (input shall have been checked)
  tmp := ParamValue;
  if not Base64ToBinSafe(PAnsiChar(pointer(tmp))+3,length(tmp)-3,RawByteString(ParamValue)) then
    ParamValue := '';
end;

function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: RawByteString): boolean;
var ValueLen: integer;
begin // '\uFFF0base64encodedbinary' checked and decode into binary
  if (Value=nil) or (Value[0]=#0) or (Value[1]=#0) or (Value[2]=#0) or
     (PCardinal(Value)^ and $ffffff<>JSON_BASE64_MAGIC) then
    result := false else begin
    ValueLen := StrLen(Value)-3;
    if ValueLen>0 then
      result := Base64ToBinSafe(PAnsiChar(Value)+3,ValueLen,Blob) else
      result := false;
  end;
end;

function Base64MagicCheckAndDecode(Value: PUTF8Char; var Blob: TSynTempBuffer): boolean;
var ValueLen: integer;
begin // '\uFFF0base64encodedbinary' checked and decode into binary
  if (Value=nil) or (Value[0]=#0) or (Value[1]=#0) or (Value[2]=#0) or
     (PCardinal(Value)^ and $ffffff<>JSON_BASE64_MAGIC) then
    result := false else begin
    ValueLen := StrLen(Value)-3;
    if ValueLen>0 then
      result := Base64ToBin(PAnsiChar(Value)+3,ValueLen,Blob) else
      result := false;
  end;
end;

function Base64MagicCheckAndDecode(Value: PUTF8Char; ValueLen: integer;
  var Blob: RawByteString): boolean;
begin // '\uFFF0base64encodedbinary' checked and decode into binary
  if (ValueLen<4) or (PCardinal(Value)^ and $ffffff<>JSON_BASE64_MAGIC) then
    result := false else
    result := Base64ToBinSafe(PAnsiChar(Value)+3,ValueLen-3,Blob);
end;

{$ifndef DEFINED_INT32TOUTF8}

function Int32ToUtf8(Value: PtrInt): RawUTF8; // faster than SysUtils.IntToStr
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

function Int64ToUtf8(Value: Int64): RawUTF8; // faster than SysUtils.IntToStr
begin
  Int64ToUtf8(Value,result);
end;

function Trim(const S: RawUTF8): RawUTF8;
var I,L: PtrInt;
begin
  L := Length(S);
  I := 1;
  while (I<=L) and (S[I]<=' ') do inc(I);
  if I>L then
    result := '' else
  if (I=1) and (S[L]>' ') then
    result := S else begin
    while S[L]<=' ' do dec(L);
    result := Copy(S,I,L-I+1);
  end;
end;

{$endif DEFINED_INT32TOUTF8}

{$ifndef CPU64} // already implemented by ToUTF8(Value: PtrInt) below
function ToUTF8(Value: Int64): RawUTF8;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt64(@tmp[23],Value);
  FastSetString(result,P,@tmp[23]-P);
end;
{$endif CPU64}

function ToUTF8(Value: PtrInt): RawUTF8;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[23],Value);
  FastSetString(result,P,@tmp[23]-P);
end;

function UInt32ToUtf8(Value: PtrUInt): RawUTF8;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrUInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

procedure UInt32ToUtf8(Value: PtrUInt; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if Value<=high(SmallUInt32UTF8) then
    result := SmallUInt32UTF8[Value] else begin
    P := StrUInt32(@tmp[23],Value);
    FastSetString(result,P,@tmp[23]-P);
  end;
end;

{$ifndef EXTENDEDTOSTRING_USESTR}
var // standard FormatSettings (US)
  SettingsUS: TFormatSettings;
{$endif}

function ExtendedToStringNoExp(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;
var i,prec: integer;
begin
  str(Value:0:Precision,S); // not str(Value:0,S) -> '  0.0E+0000'
  // using str() here avoid FloatToStrF() usage -> LVCL is enough
  result := length(S);
  prec := result; // if no decimal
  if S[1]='-' then
    dec(prec);
  for i := 2 to result do // test if scientific format -> return as this
    case S[i] of
    'E': exit;  // pos('E',S)>0; which Delphi 2009+ doesn't like
    '.': if i>=precision then begin // return huge decimal number as is
      result := i-1;
      exit;
    end else
      dec(prec);
    end;
  if (prec>=Precision) and (prec<>result) then begin
    dec(result,prec-Precision);
    if S[result+1]>'5' then begin // manual rounding
      prec := result;
      repeat
        case S[prec] of
        '.': ; // just ignore decimal separator
        '0'..'8': begin
          inc(S[prec]);
          break;
        end;
        '9': begin
          S[prec] := '0';
          if ((prec=2) and (S[1]='-')) or (prec=1) then begin
            {$ifdef FPC}Move{$else}MoveFast{$endif}(S[prec],S[prec+1],result);
            S[prec] := '1';
            break;
          end;
        end;
        else break;
        end;
        dec(prec);
      until prec=0;
    end; // note: this fixes http://stackoverflow.com/questions/2335162
  end;
  while S[result]='0' do begin
    dec(result); // trunc any trimming 0
    if S[result]='.' then begin
      dec(result);
      if (result=2) and (S[1]='-') and (S[2]='0') then begin
        result := 1;
        S[1] := '0'; // '-0.000' -> '0'
      end;
      break; // decimal were all '0' -> return only integer part
    end;
  end;
end;

function ExtendedToString(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;
{$ifdef EXTENDEDTOSTRING_USESTR}
var scientificneeded: boolean;
    valueabs: TSynExtended;
const SINGLE_HI: TSynExtended = 1E9; // for proper Delphi 5 compilation
      SINGLE_LO: TSynExtended = 1E-9;
      DOUBLE_HI: TSynExtended = 1E14;
      DOUBLE_LO: TSynExtended = 1E-14;
      {$ifndef CPU64}
      EXT_HI: TSynExtended = 1E17;
      EXT_LO: TSynExtended = 1E-17;
      {$endif}
begin
  if Value=0 then begin
    s[1] := '0';
    result := 1;
    exit;
  end;
  scientificneeded := false;
  valueabs := abs(Value);
  if Precision<=SINGLE_PRECISION then begin
    if (valueabs>SINGLE_HI) or (valueabs<SINGLE_LO) then
      scientificneeded := true;
  end else
  {$ifndef CPU64}
  if Precision>DOUBLE_PRECISION then begin
    if (valueabs>EXT_HI) or (valueabs<EXT_LO) then
      scientificneeded := true;
  end else
  {$endif}
    if (valueabs>DOUBLE_HI) or (valueabs<DOUBLE_LO) then
      scientificneeded := true;
  if scientificneeded then begin
    str(Value,S);
    if S[1]=' ' then
      delete(S,1,1);
    result := ord(S[0]);
  end else
    result := ExtendedToStringNoExp(S,Value,Precision);
end;
{$else}
{$ifdef UNICODE}
var i: integer;
{$endif}
begin
  // use ffGeneral: see https://synopse.info/forum/viewtopic.php?pid=442#p442
  result := FloatToText(PChar(@S[1]), Value, fvExtended, ffGeneral,
    Precision, 0, SettingsUS);
  {$ifdef UNICODE} // FloatToText(PWideChar) is faster than FloatToText(PAnsiChar)
  for i := 1 to result do
    PByteArray(@S)[i] := PWordArray(PtrInt(@S)-1)[i];
  {$endif}
end;
{$endif EXTENDEDTOSTRING_USESTR}

function ExtendedToStringNan(const s: shortstring): TSynExtendedNan;
begin
  case PInteger(@s)^ and $ffdfdfdf of
    3+ord('N')shl 8+ord('A')shl 16+ord('N')shl 24:
      result := seNan;
    3+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24,
    4+ord('+')shl 8+ord('I')shl 16+ord('N')shl 24:
      result := seInf;
    4+ord('-')shl 8+ord('I')shl 16+ord('N')shl 24:
      result := seNegInf;
    else
      result := seNumber;
  end;
end;

function ExtendedToStrNan(const s: RawUTF8): TSynExtendedNan;
begin
  case length(s) of
  3: case PInteger(s)^ and $dfdfdf of
     ord('N')+ord('A')shl 8+ord('N')shl 16: result := seNan;
     ord('I')+ord('N')shl 8+ord('F')shl 16: result := seInf;
     else result := seNumber;
     end;
  4: case PInteger(s)^ and $dfdfdfdf of
     ord('+')+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24: result := seInf;
     ord('-')+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24: result := seNegInf;
     else result := seNumber;
     end;
  else result := seNumber;
  end;
end;

function ExtendedToStr(Value: TSynExtended; Precision: integer): RawUTF8;
begin
  ExtendedToStr(Value,Precision,result);
end;

procedure ExtendedToStr(Value: TSynExtended; Precision: integer;
  var result: RawUTF8);
var tmp: ShortString;
    i64: Int64;
begin
  i64 := Trunc(Value);
  if Value=i64 then
    Int64ToUtf8(i64,result) else
    FastSetString(result,@tmp[1],ExtendedToString(tmp,Value,Precision));
end;

function DoubleToStr(Value: Double): RawUTF8;
begin
  ExtendedToStr(Value,DOUBLE_PRECISION,result);
end;

function FormatUTF8(const Format: RawUTF8; const Args: array of const): RawUTF8;
begin
  FormatUTF8(Format,Args,result);
end;

type
  // only supported token is %, with any const arguments
  {$ifdef FPC_OR_UNICODE}TFormatUTF8 = record{$else}TFormatUTF8 = object{$endif}
  public
    b: PTempUTF8;
    L,argN: integer;
    blocks: array[0..63] of TTempUTF8; // to avoid most heap allocations
    procedure Parse(const Format: RawUTF8; const Args: array of const);
    procedure Write(Dest: PUTF8Char);
    function WriteMax(Dest: PUTF8Char; Max: PtrUInt): PUTF8Char;
  end;

procedure TFormatUTF8.Parse(const Format: RawUTF8; const Args: array of const);
var F,FDeb: PUTF8Char;
begin
  if length(Args)*2>=high(blocks) then
    raise ESynException.Create('FormatUTF8: too many args (max=32)!');
  L := 0;
  argN := 0;
  b := @blocks;
  F := pointer(Format);
  repeat
    if F^<>'%' then begin
      FDeb := F;
      while (F^<>'%') and (F^<>#0) do
        inc(F);
      b^.Text := FDeb;
      b^.Len := F-FDeb;
      b^.TempRawUTF8 := nil;
      inc(L,b^.Len);
      inc(b);
    end;
    if F^=#0 then
      break;
    inc(F); // jump '%'
    if argN<=high(Args) then begin
      inc(L,VarRecToTempUTF8(Args[argN],b^));
      inc(b);
      inc(argN);
      if F^=#0 then
        break;
    end else
    if F^=#0 then
      break else begin
      b^.Text := F; // no more available Args -> add all remaining text
      b^.Len := length(Format)-(F-pointer(Format));
      b^.TempRawUTF8 := nil;
      inc(L,b^.Len);
      inc(b);
      break;
    end;
  until false;
end;

procedure TFormatUTF8.Write(Dest: PUTF8Char);
var d: PTempUTF8;
begin
  d := @blocks;
  repeat
    {$ifdef FPC}Move{$else}MoveFast{$endif}(d^.Text^,Dest^,d^.Len);
    inc(Dest,d^.Len);
    if d^.TempRawUTF8<>nil then
      {$ifdef FPC}Finalize(RawUTF8(d^.TempRawUTF8)){$else}RawUTF8(d^.TempRawUTF8) := ''{$endif};
    inc(d);
  until d=b;
end;

function TFormatUTF8.WriteMax(Dest: PUTF8Char; Max: PtrUInt): PUTF8Char;
var d: PTempUTF8;
begin
  inc(Max,PtrUInt(Dest));
  d := @blocks;
  repeat
    if PtrUInt(Dest)+PtrUInt(d^.Len)>Max then begin // avoid buffer overflow
      {$ifdef FPC}Move{$else}MoveFast{$endif}(d^.Text^,Dest^,Max-PtrUInt(Dest));
      repeat
        if d^.TempRawUTF8<>nil then
          {$ifdef FPC}Finalize(RawUTF8(d^.TempRawUTF8)){$else}RawUTF8(d^.TempRawUTF8) := ''{$endif};
        inc(d);
      until d=b; // avoid memory leak
      result := PUTF8Char(Max);
      exit;
    end;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(d^.Text^,Dest^,d^.Len);
    inc(Dest,d^.Len);
    if d^.TempRawUTF8<>nil then
      {$ifdef FPC}Finalize(RawUTF8(d^.TempRawUTF8)){$else}RawUTF8(d^.TempRawUTF8) := ''{$endif};
    inc(d);
  until d=b;
  result := Dest;
end;

procedure FormatUTF8(const Format: RawUTF8; const Args: array of const;
  out result: RawUTF8);
var process: TFormatUTF8;
begin
  if (Format='') or (high(Args)<0) then // no formatting needed
    result := Format else
  if PWord(Format)^=ord('%') then // optimize raw conversion
    VarRecToUTF8(Args[0],result) else begin
    process.Parse(Format,Args);
    if process.L<>0 then begin
      SetLength(result,process.L);
      process.Write(pointer(result));
    end;
  end;
end;

procedure FormatShort(const Format: RawUTF8; const Args: array of const;
  var result: shortstring);
var process: TFormatUTF8;
begin
  if (Format='') or (high(Args)<0) then // no formatting needed
    SetString(result,PAnsiChar(pointer(Format)),length(Format)) else begin
    process.Parse(Format,Args);
    result[0] := AnsiChar(process.WriteMax(@result[1],255)-@result[1]);
  end;
end;

function FormatToShort(const Format: RawUTF8; const Args: array of const): shortstring;
var process: TFormatUTF8;
begin // Delphi 5 has troubles compiling overloaded FormatShort()
  process.Parse(Format,Args);
  result[0] := AnsiChar(process.WriteMax(@result[1],255)-@result[1]);
end;

procedure FormatShort16(const Format: RawUTF8; const Args: array of const;
  var result: TShort16);
var process: TFormatUTF8;
begin
  if (Format='') or (high(Args)<0) then // no formatting needed
    SetString(result,PAnsiChar(pointer(Format)),length(Format)) else begin
    process.Parse(Format,Args);
    result[0] := AnsiChar(process.WriteMax(@result[1],16)-@result[1]);
  end;
end;

procedure FormatString(const Format: RawUTF8; const Args: array of const;
  out result: string);
var process: TFormatUTF8;
    temp: TSynTempBuffer; // will avoid most memory allocations
begin
  if (Format='') or (high(Args)<0) then begin // no formatting needed
    UTF8DecodeToString(pointer(Format),length(Format),result);
    exit;
  end;
  process.Parse(Format,Args);
  temp.Init(process.L);
  process.Write(temp.buf);
  UTF8DecodeToString(temp.buf,process.L,result);
  temp.Done;
end;

function FormatString(const Format: RawUTF8; const Args: array of const): string;
begin
  FormatString(Format,Args,result);
end;

function FormatUTF8(const Format: RawUTF8; const Args, Params: array of const; JSONFormat: boolean): RawUTF8;
var i, tmpN, L, A, P, len: PtrInt;
    isParam: AnsiChar;
    tmp: TRawUTF8DynArray;
    inlin: set of 0..255;
    F,FDeb: PUTF8Char;
    wasString: Boolean;
const NOTTOQUOTE: array[boolean] of set of 0..31 = (
        [vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended],
        [vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended,vtVariant]);
label Txt;
begin
  if Format='' then begin
    result := '';
    exit;
  end;
  if (high(Args)<0) and (high(Params)<0) then begin
    // no formatting to process, but may be a const -> make unique
    FastSetString(result,pointer(Format),length(Format));
    exit; // e.g. _JsonFmt() will parse it in-place
  end;
  if high(Params)<0 then begin
    FormatUTF8(Format,Args,result); // slightly faster overloaded function
    exit;
  end;
  if Format='%' then begin
    VarRecToUTF8(Args[0],result); // optimize raw conversion
    exit;
  end;
  result := '';
  tmpN := 0;
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(inlin,SizeOf(inlin),0);
  L := 0;
  A := 0;
  P := 0;
  F := pointer(Format);
  while F^<>#0 do begin
    if F^<>'%' then begin
      FDeb := F;
      while not (F^ in [#0,'%','?']) do inc(F);
Txt:  len := F-FDeb;
      if len>0 then begin
        inc(L,len);
        if tmpN=length(tmp) then
          SetLength(tmp,tmpN+8);
        FastSetString(tmp[tmpN],FDeb,len); // add inbetween text
        inc(tmpN);
      end;
    end;
    if F^=#0 then
      break;
    isParam := F^;
    inc(F); // jump '%' or '?'
    if (isParam='%') and (A<=high(Args)) then begin // handle % substitution
      if tmpN=length(tmp) then
        SetLength(tmp,tmpN+8);
      VarRecToUTF8(Args[A],tmp[tmpN]);
      inc(A);
      if tmp[tmpN]<>'' then begin
        inc(L,length(tmp[tmpN]));
        inc(tmpN);
      end;
    end else
    if (isParam='?') and (P<=high(Params)) then begin // handle ? substitution
      if tmpN=length(tmp) then
        SetLength(tmp,tmpN+8);
      {$ifndef NOVARIANTS}
      if JSONFormat and (Params[P].VType=vtVariant) then
        VariantSaveJSON(Params[P].VVariant^,twJSONEscape,tmp[tmpN]) else
      {$endif}
      begin
        VarRecToUTF8(Params[P],tmp[tmpN]);
        wasString := not (Params[P].VType in NOTTOQUOTE[JSONFormat]);
        if wasString then
          if JSONFormat then
            QuotedStrJSON(tmp[tmpN],tmp[tmpN]) else
            tmp[tmpN] := QuotedStr(pointer(tmp[tmpN]),'''');
        if not JSONFormat then begin
          inc(L,4); // space for :():
          include(inlin,tmpN);
        end;
      end;
      inc(P);
      inc(L,length(tmp[tmpN]));
      inc(tmpN);
    end else
    if F^<>#0 then begin // no more available Args -> add all remaining text
      FDeb := F;
      repeat inc(F) until (F^=#0);
      goto Txt;
    end;
  end;
  if L=0 then
    exit;
  if not JSONFormat and (tmpN>SizeOf(inlin)shl 3) then
    raise ESynException.CreateUTF8(
      'Too many parameters for FormatUTF8(): %>%',[tmpN,SizeOf(inlin)shl 3]);
  SetLength(result,L);
  F := pointer(result);
  for i := 0 to tmpN-1 do
  if tmp[i]<>'' then begin
    if i in inlin then begin
      PWord(F)^ := ord(':')+ord('(')shl 8;
      inc(F,2);
    end;
    L := {$ifdef FPC}_LStrLen(tmp[i]){$else}PInteger(PtrInt(tmp[i])-SizeOf(integer))^{$endif};
    {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(tmp[i])^,F^,L);
    inc(F,L);
    if i in inlin then begin
      PWord(F)^ := ord(')')+ord(':')shl 8;
      inc(F,2);
    end;
  end;
end;

function ScanUTF8(P: PUTF8Char; PLen: integer; const fmt: RawUTF8;
  const values: array of pointer; ident: PRawUTF8DynArray): integer;
var
  v,w: PtrInt;
  F,FEnd,PEnd: PUTF8Char;
label next;
begin
  result := 0;
  if (fmt='') or (P=nil) or (PLen<=0) or (high(values)<0) then
    exit;
  if ident<>nil then
    SetLength(ident^,length(values));
  F := pointer(fmt);
  FEnd := F+length(fmt);
  PEnd := P+PLen;
  for v := 0 to high(values) do
  repeat
    if (P^<=' ') and (P^<>#0) then // ignore any whitespace char in text
      repeat
        inc(P);
        if P=PEnd then
          exit;
      until (P^>' ') or (P^=#0);
    if F^ in [#1..' '] then // ignore any whitespace char in fmt
      repeat
        inc(F);
        if F=FEnd then
          exit;
      until not (F^ in [#1..' ']);
    if F^='%' then begin // format specifier
      inc(F);
      if F=FEnd then
        exit;
      case F^ of
      'd': PInteger(values[v])^ := GetNextItemInteger(P,#0);
      'D': PInt64(values[v])^ := GetNextItemInt64(P,#0);
      'u': PCardinal(values[v])^ := GetNextItemCardinal(P,#0);
      'U': PQword(values[v])^ := GetNextItemQword(P,#0);
      'f': PDouble(values[v])^ := GetNextItemDouble(P,#0);
      'F': GetNextItemCurrency(P,PCurrency(values[v])^,#0);
      'x': if not GetNextItemHexDisplayToBin(P,values[v],4,#0) then
             exit;
      'X': if not GetNextItemHexDisplayToBin(P,values[v],8,#0) then
             exit;
      's','S': begin
        w := 0;
        while (P[w]>' ') and (P+w<=PEnd) do inc(w);
        if F^='s' then
          SetString(PShortString(values[v])^,PAnsiChar(P),w) else
          FastSetString(PRawUTF8(values[v])^,P,w);
        inc(P,w);
        while (P^<=' ') and (P^<>#0) and (P<=PEnd) do inc(P);
      end;
      'L': begin
        w := 0;
        while not(P[w] in [#0,#10,#13]) and (P+w<=PEnd) do inc(w);
        FastSetString(PRawUTF8(values[v])^,P,w);
        inc(P,w);
      end;
      '%': goto next;
      else raise ESynException.CreateUTF8('ScanUTF8: unknown ''%'' specifier [%]',[F^,fmt]);
      end;
      inc(result);
      if (ord(F[1]) in IsIdentifier) or (ident<>nil) then begin
        w := 0;
        repeat inc(w) until not(ord(F[w]) in IsIdentifier) or (F+w=FEnd);
        if ident<>nil then
          FastSetString(ident^[v],F,w);
        inc(F,w);
      end else
        inc(F);
      if (F>=FEnd) or (P>=PEnd) then
        exit;
      break;
    end else begin
next: while (P^<>F^) and (P<=PEnd) do inc(P);
      inc(F);
      inc(P);
      if (F>=FEnd) or (P>=PEnd) then
        exit;
    end;
  until false;
end;

function ScanUTF8(const text, fmt: RawUTF8; const values: array of pointer;
  ident: PRawUTF8DynArray): integer;
begin
  result := ScanUTF8(pointer(text),length(text),fmt,values,ident);
end;

function RawByteStringArrayConcat(const Values: array of RawByteString): RawByteString;
var i, L: PtrInt;
    P: PAnsiChar;
begin
  L := 0;
  for i := 0 to high(Values) do
    inc(L,length(Values[i]));
  SetString(Result,nil,L);
  P := pointer(Result);
  for i := 0 to high(Values) do begin
    L := length(Values[i]);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Values[i])^,P^,L);
    inc(P,L);
  end;
end;

procedure RawByteStringToBytes(const buf: RawByteString; out bytes: TBytes);
var L: Integer;
begin
  L := Length(buf);
  if L<>0 then begin
    SetLength(bytes,L);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(buf)^,pointer(bytes)^,L);
  end;
end;

procedure BytesToRawByteString(const bytes: TBytes; out buf: RawByteString);
begin
  SetString(buf,PAnsiChar(pointer(bytes)),Length(bytes));
end;

procedure ResourceToRawByteString(const ResName: string; ResType: PChar;
  out buf: RawByteString; Instance: THandle);
var HResInfo: THandle;
    HGlobal: THandle;
begin
  if Instance=0 then
    Instance := HInstance;
  HResInfo := FindResource(Instance,PChar(ResName),ResType);
  if HResInfo=0 then
    exit;
  HGlobal := LoadResource(Instance,HResInfo);
  if HGlobal<>0 then begin
    SetString(buf,PAnsiChar(LockResource(HGlobal)),SizeofResource(Instance,HResInfo));
    UnlockResource(HGlobal); // only needed outside of Windows
    FreeResource(HGlobal);
  end;
end;

procedure ResourceSynLZToRawByteString(const ResName: string;
  out buf: RawByteString; Instance: THandle);
var HResInfo: THandle;
    HGlobal: THandle;
begin
  if Instance=0 then
    Instance := HInstance;
  HResInfo := FindResource(Instance,PChar(ResName),PChar(10));
  if HResInfo=0 then
    exit;
  HGlobal := LoadResource(Instance,HResInfo);
  if HGlobal<>0 then // direct decompression from memory mapped .exe content
    try
      AlgoSynLZ.Decompress(LockResource(HGlobal),SizeofResource(Instance,HResInfo),buf);
    finally
      UnlockResource(HGlobal); // only needed outside of Windows
      FreeResource(HGlobal);
    end;
end;

function StrLenW(S: PWideChar): PtrInt;
begin
  result := 0;
  if S<>nil then
  while true do
    if S[result+0]<>#0 then
    if S[result+1]<>#0 then
    if S[result+2]<>#0 then
    if S[result+3]<>#0 then
      inc(result,4) else begin
      inc(result,3);
      exit;
    end else begin
      inc(result,2);
      exit;
    end else begin
      inc(result);
      exit;
    end else
      exit;
end;

function StrCompW(Str1, Str2: PWideChar): PtrInt;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    if Str1^=Str2^ then
    repeat
      if (Str1^=#0) or (Str2^=#0) then break;
      inc(Str1);
      inc(Str2);
    until Str1^<>Str2^;
    result := PWord(Str1)^-PWord(Str2)^;
    exit;
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;

{$ifdef PUREPASCAL}

function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
var table: PNormTable;
    u: AnsiChar;
begin
  result := false;
  if p=nil then
    exit;
  if up<>nil then begin
    dec(PtrUInt(p),PtrUInt(up));
    table := @NormToUpperAnsi7;
    repeat
      u := up^;
      if u=#0 then
        break;
      if u<>table^[up[PtrUInt(p)]] then
        exit;
      inc(up);
    until false;
  end;
  result := true;
end;

function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
var i: PtrInt; // very optimized code for speed
begin
  if P<>nil then begin
    result := 0;
    for i := 1 to Count shr 2 do // 4 DWORD by loop - aligned read
      if P^[0]<>Value then
      if P^[1]<>Value then
      if P^[2]<>Value then
      if P^[3]<>Value then begin
        inc(PByte(P),SizeOf(P^[0])*4);
        inc(result,4);
      end else begin
        inc(result,3);
        exit;
      end else begin
        inc(result,2);
        exit;
      end else begin
        inc(result,1);
        exit;
      end else
        exit;
    for i := 0 to (Count and 3)-1 do // last 0..3 DWORD
      if P^[i]=Value then
        exit else
        inc(result);
  end;
  result := -1;
end;

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
var i: PtrInt;
begin // very optimized code
  if P<>nil then begin
    for i := 1 to Count shr 2 do      // 4 DWORD by loop - aligned read
      if P^[0]<>Value then
      if P^[1]<>Value then
      if P^[2]<>Value then
      if P^[3]=Value then begin
        result := @P^[3];
        exit;
      end else
        inc(PByte(P),SizeOf(P^[0])*4) else begin
        result := @P^[2];
        exit;
      end else begin
        result := @P^[1];
        exit;
      end else begin
        result := pointer(P);
        exit;
      end;
    for i := 0 to (Count and 3)-1 do  // last 0..3 DWORD
      if P^[i]=Value then begin
        result := @P^[i];
        exit;
      end;
  end;
  result := nil;
end;

function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
var i: PtrInt; // very optimized code for speed
begin
  if P<>nil then begin
    result := true;
    for i := 1 to (Count shr 2) do   // 4 DWORD by loop - aligned read
      if (P^[0]=Value) or (P^[1]=Value) or
         (P^[2]=Value) or (P^[3]=Value) then
        exit else
        inc(PByte(P),SizeOf(P^[0])*4);
    for i := 0 to (Count and 3)-1 do // last 0..3 DWORD
      if P^[i]=Value then
        exit;
  end;
  result := false;
end;

function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
var c: cardinal;
begin // FPC is efficient at compiling this code
  result := nil;
  if Str<>nil then begin
    repeat
      c := PCardinal(str)^;
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      c := c shr 8;
      inc(Str);
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      c := c shr 8;
      inc(Str);
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      c := c shr 8;
      inc(Str);
      if ToByte(c)=0 then
        exit else
      if ToByte(c)=byte(Chr) then
        break;
      inc(Str);
    until false;
    result := Str;
  end;
end;

function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;
label zero;
begin // this code compiles well under FPC and Delphi on both 32-bit and 64-bit
  inc(Length,PtrInt(PtrUInt(P1))-SizeOf(PtrInt)*2);
  if Length>=PtrInt(PtrUInt(P1)) then begin
    if PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^ then
      goto zero;
    inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt));
    inc(PtrInt(P2),SizeOf(PtrInt));
    dec(PtrInt(P2),PtrInt(PtrUInt(P1)));
    PtrInt(PtrUInt(P1)) := PtrInt(PtrUInt(P1)) and -SizeOf(PtrInt);
    inc(PtrInt(P2),PtrInt(PtrUInt(P1)));
    if Length>=PtrInt(PtrUInt(P1)) then
      repeat // compare 4 aligned PtrInt per loop
        if (PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
          goto zero;
        inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt)*2);
        inc(PtrInt(P2),SizeOf(PtrInt)*2);
        if Length<PtrInt(PtrUInt(P1)) then
          break;
        if (PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^) or (PPtrIntArray(P1)[1]<>PPtrIntArray(P2)[1]) then
          goto zero;
        inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt)*2);
        inc(PtrInt(P2),SizeOf(PtrInt)*2);
      until Length<PtrInt(PtrUInt(P1));
  end;
  inc(Length,SizeOf(PtrInt)*2-PtrInt(PtrUInt(P1)));
  if Length>=SizeOf(PtrInt) then begin
    if PPtrInt(PtrUInt(P1))^<>PPtrInt(P2)^ then
      goto zero;
    inc(PtrInt(PtrUInt(P1)),SizeOf(PtrInt));
    inc(PtrInt(P2),SizeOf(PtrInt));
    dec(Length,SizeOf(PtrInt));
  end;
  {$ifdef CPU64}
  if Length>=4 then begin
    if PCardinal(P1)^<>PCardinal(P2)^ then
      goto zero;
    inc(PtrInt(PtrUInt(P1)),4);
    inc(PtrInt(P2),4);
    dec(Length,4);
  end;
  {$endif}
  if Length>=2 then begin
    if PWord(P1)^<>PWord(P2)^ then
      goto zero;
    inc(PtrInt(PtrUInt(P1)),2);
    inc(PtrInt(P2),2);
    dec(Length,2);
  end;
  if Length>=1 then
    if PByte(P1)^<>PByte(P2)^ then
      goto zero;
  result := true;
  exit;
zero:
  result := false;
end;

{$ifdef HASINLINE} // to use directly the SubStr/S arguments registers
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt): PtrInt;
begin
  result := PosExPas(pointer(SubStr),pointer(S),Offset);
end;
{$endif HASINLINE}

// from Aleksandr Sharahov's PosEx_Sha_Pas_2() - refactored for cross-platform
function PosExPas(pSub, p: PUTF8Char; Offset: PtrUInt): PtrInt;
var len, lenSub: PtrInt;
    ch: AnsiChar;
    pStart, pStop: PUTF8Char;
label Loop2, Loop6, TestT, Test0, Test1, Test2, Test3, Test4,
      AfterTestT, AfterTest0, Ret, Exit;
begin
  result := 0;
  if (p=nil) or (pSub=nil) or (Offset<1) then
    goto Exit;
  {$ifdef FPC}
  len := _LStrLenP(p);
  lenSub := _LStrLenP(pSub)-1;
  {$else}
  len := PInteger(p-4)^;
  lenSub := PInteger(pSub-4)^-1;
  {$endif}
  if (len<lenSub+PtrInt(Offset)) or (lenSub<0) then
    goto Exit;
  pStop := p+len;
  inc(p,lenSub);
  inc(pSub,lenSub);
  pStart := p;
  inc(p,Offset+3);
  ch := pSub[0];
  lenSub := -lenSub;
  if p<pStop then goto Loop6;
  dec(p,4);
  goto Loop2;
Loop6: // check 6 chars per loop iteration
  if ch=p[-4] then goto Test4;
  if ch=p[-3] then goto Test3;
  if ch=p[-2] then goto Test2;
  if ch=p[-1] then goto Test1;
Loop2:
  if ch=p[0] then goto Test0;
AfterTest0:
  if ch=p[1] then goto TestT;
AfterTestT:
  inc(p,6);
  if p<pStop then goto Loop6;
  dec(p,4);
  if p>=pStop then goto Exit;
  goto Loop2;
Test4: dec(p,2);
Test2: dec(p,2);
  goto Test0;
Test3: dec(p,2);
Test1: dec(p,2);
TestT: len := lenSub;
  if lenSub<>0 then
    repeat
      if (psub[len]<>p[len+1]) or (psub[len+1]<>p[len+2]) then
        goto AfterTestT;
      inc(len,2);
    until len>=0;
  inc(p,2);
  if p<=pStop then goto Ret;
  goto Exit;
Test0: len := lenSub;
  if lenSub<>0 then
    repeat
      if (psub[len]<>p[len]) or (psub[len+1]<>p[len+1]) then
        goto AfterTest0;
      inc(len,2);
    until len>=0;
  inc(p);
Ret:
  result := p-pStart;
Exit:
end;

function IdemPropNameU(const P1,P2: RawUTF8): boolean;
var L: PtrInt;
begin
  L := length(P1);
  if length(P2)=L then
    result := IdemPropNameUSameLen(pointer(P1),pointer(P2),L) else
    result := false;
end;

function StrIComp(Str1, Str2: pointer): PtrInt;
var C1,C2: PtrInt;
    lookupper: PByteArray; // better x86-64 / PIC asm generation
begin
  result := PtrInt(PtrUInt(Str2))-PtrInt(PtrUInt(Str1));
  if result<>0 then
    if Str1<>nil then
      if Str2<>nil then begin
        lookupper := @NormToUpperAnsi7Byte;
        repeat
          C1 := PByteArray(Str1)[0];
          C2 := PByteArray(Str1)[result];
          inc(PByte(Str1));
          if C1=0 then
            break;
          if C1=C2 then
            continue; // fast optimistic loop for exact chars match
          C1 := lookupper[C1];
          C2 := lookupper[C2];
          if C1<>C2 then
            break;   // no branch taken if first chars differ
        until false; // slower "continue" above if "until C1<>C2"
        result := C1-C2;
      end else
      result := 1 else  // Str2=''
    result := -1;     // Str1=''
end;

function StrLenPas(S: pointer): PtrInt;
begin
  result := 0;
  if S<>nil then
  while true do
    if PAnsiChar(S)[result+0]<>#0 then
    if PAnsiChar(S)[result+1]<>#0 then
    if PAnsiChar(S)[result+2]<>#0 then
    if PAnsiChar(S)[result+3]<>#0 then
      inc(result,4) else begin
      inc(result,3);
      exit;
    end else begin
      inc(result,2);
      exit;
    end else begin
      inc(result);
      exit;
    end else
      exit;
end;

function StrCompFast(Str1, Str2: pointer): PtrInt;
var c: byte;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    c := PByte(Str1)^;
    if c=PByte(Str2)^ then
      repeat
        if c=0 then break;
        inc(PByte(Str1));
        inc(PByte(Str2));
        c := PByte(Str1)^;
      until c<>PByte(Str2)^;
    result := c-PByte(Str2)^;
    exit;
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;

procedure YearToPChar(Y: PtrUInt; P: PUTF8Char);
var d100: PtrUInt;
    tab: PWordArray;
begin
  tab := @TwoDigitLookupW;
  d100 := Y div 100;
  PWordArray(P)[0] := tab[d100];
  PWordArray(P)[1] := tab[Y-(d100*100)];
end;

procedure YearToPChar2(tab: PWordArray; Y: PtrUInt; P: PUTF8Char); {$ifdef HASINLINE}inline;{$endif}
var d100: PtrUInt;
begin
  d100 := Y div 100;
  PWordArray(P)[0] := tab[d100];
  PWordArray(P)[1] := tab[Y-(d100*100)];
end;

function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
begin
  result := Iso8601ToTimeLogPUTF8Char(pointer(S),length(S));
end;

function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
var s: PAnsiChar;
    c: cardinal;
begin
  s := pointer(source);
  if s<>nil then
    repeat
      c := ord(s^);
      if c=0 then
        break else
        dest^ := AnsiChar(NormToUpperAnsi7Byte[c]);
      inc(s);
      inc(dest);
    until false;
  result := dest;
end;

function UpperCopyShort(dest: PAnsiChar; const source: shortstring): PAnsiChar;
var i: PtrInt;
begin
  for i := 1 to ord(source[0]) do begin
    dest^ := AnsiChar(NormToUpperAnsi7Byte[ord(source[i])]);
    inc(dest);
  end;
  result := dest;
end;

function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;
begin
  if source=nil then
    result := false else begin
    result := IdemPChar(source,searchUp);
    source := GotoNextLine(source);
  end;
end;

function fnv32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
var i: PtrInt;
begin
  if buf<>nil then
    for i := 0 to len-1 do
      crc := (crc xor ord(buf[i]))*16777619;
  result := crc;
end;

function kr32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
var i: PtrInt;
begin
  for i := 0 to len-1 do
    crc := ord(buf[i])+crc*31;
  result := crc;
end;

procedure crcblockNoSSE42(crc128, data128: PBlock128);
var c: cardinal;
    tab: ^TCrc32tab;
begin
  tab := @crc32ctab;
  c := crc128^[0] xor data128^[0];
  crc128^[0] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,c shr 24];
  c := crc128^[1] xor data128^[1];
  crc128^[1] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,c shr 24];
  c := crc128^[2] xor data128^[2];
  crc128^[2] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,c shr 24];
  c := crc128^[3] xor data128^[3];
  crc128^[3] := tab[3,ToByte(c)] xor tab[2,ToByte(c shr 8)]
            xor tab[1,ToByte(c shr 16)] xor tab[0,c shr 24];
end;

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
var tab: ^TCrc32tab;
begin
  tab := @crc32ctab;
  result := not crc;
  if (buf<>nil) and (len>0) then begin
    repeat
      if PtrUInt(buf) and 3=0 then // align to 4 bytes boundary
        break;
      result := tab[0,ToByte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    until len=0;
    if len>=4 then
      repeat
        result := result xor PCardinal(buf)^;
        inc(buf,4);
        dec(len,4);
        result := tab[3,ToByte(result)] xor
                  tab[2,ToByte(result shr 8)] xor
                  tab[1,ToByte(result shr 16)] xor
                  tab[0,result shr 24];
      until len<4;
    while len>0 do begin
      result := tab[0,ToByte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    end;
  end;
  result := not result;
end;

function ToVarInt32(Value: PtrInt; Dest: PByte): PByte;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  if Value<0 then
    // -1->2, -2->4..
    Value := (-Value) shl 1 else
  if Value>0 then
    // 1->1, 2->3..
    Value := (Value shl 1)-1;
    // 0->0
  result := ToVarUInt32(Value,Dest);
end;

function ToVarUInt32(Value: PtrUInt; Dest: PByte): PByte;
label _1,_2,_3; // ugly but fast
begin
  if Value>$7f then begin
    if Value<$80 shl 7  then goto _1 else
      if Value<$80 shl 14 then goto _2 else
        if Value<$80 shl 21 then goto _3;
    Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
_3: Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
_2: Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
_1: Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
  end;
  Dest^ := Value;
  inc(Dest);
  result := Dest;
end;

function SortDynArrayInteger(const A,B): integer;
begin
  if integer(A)<integer(B) then
    result := -1 else
  if integer(A)>integer(B) then
    result := 1 else
    result := 0;
end;

function SortDynArrayInt64(const A,B): integer;
{$ifdef CPU64}
begin
  if Int64(A)<Int64(B) then
    result := -1 else
  if Int64(A)>Int64(B) then
    result := 1 else
    result := 0;
end;
{$else}
var tmp: Int64;
begin
  tmp := Int64(A)-Int64(B);
  if tmp<0 then
    result := -1 else
  if tmp>0 then
    result := 1 else
    result := 0;
end;
{$endif CPU64}

function SortDynArrayQWord(const A,B): integer;
begin
  {$ifdef CPU64}
  if QWord(A)<QWord(B) then
    result := -1 else
  if QWord(A)>QWord(B) then
  {$else}
  if PQWord(@A)<PQWord(@B) then
    result := -1 else
  if PQWord(@A)>PQWord(@B) then
  {$endif CPU64}
    result := 1 else
    result := 0;
end;

function CompareQWord(A, B: QWord): integer;
begin
  if A<B then
    result := -1 else
  if A>B then
    result := 1 else
    result := 0;
end;

function SortDynArrayAnsiString(const A,B): integer;
begin
  result := StrComp(pointer(A),pointer(B));
end;

function SortDynArrayAnsiStringI(const A,B): integer;
begin
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
end;

function SortDynArrayRawByteString(const A,B): integer;
var p1,p2: PByteArray;
    l1,l2,i,l: PtrInt; // FPC uses efficiently the CPU registers
begin // we can't use StrComp() since a RawByteString may contain #0
  p1 := pointer(A);
  p2 := pointer(B);
  if p1<>p2 then
    if p1<>nil then
      if p2<>nil then begin
        l1 := PStrRec(Pointer(PtrUInt(p1)-STRRECSIZE))^.length;
        l2 := PStrRec(Pointer(PtrUInt(p2)-STRRECSIZE))^.length;
        l := l1;
        if l2<l1 then
          l := l2;
        i := 0;
        repeat
          result := p1[i]-p2[i];
          if result<>0 then
            exit;
          inc(i);
        until i>=l;
        result := l1-l2;
      end else
      result := 1 else  // p2=''
    result := -1 else // p1=''
  result := 0;      // p1=p2
end;

function SortDynArrayPUTF8Char(const A,B): integer;
begin
  result := StrComp(pointer(A),pointer(B));
end;

{$else PUREPASCAL}

function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        test    eax, eax
        jz      @e            // P=nil -> false
        test    edx, edx
        push    ebx
        jz      @t            // up=nil -> true
        xor     ebx, ebx
@1:     mov     ecx, [edx]    // optimized for DWORD aligned read up^
        test    cl, cl
        mov     bl, [eax]
        jz      @t            // up^[0]=#0 -> OK
        cmp     cl, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[0]]
        jne     @f
        mov     bl, [eax + 1]
        test    ch, ch
        jz      @t            // up^[1]=#0 -> OK
        cmp     ch, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[1]]
        jne     @f
        shr     ecx, 16       // cl=up^[2] ch=up^[3]
        mov     bl, [eax + 2]
        test    cl, cl
        jz      @t            // up^[2]=#0 -> OK
        cmp     cl, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[2]]
        jne     @f
        mov     bl, [eax + 3]
        add     eax, 4
        add     edx, 4
        test    ch, ch
        jz      @t            // up^[3]=#0 -> OK
        cmp     ch, byte ptr[ebx + NormToUpperAnsi7] // NormToUpperAnsi7[p^[3]]
        je      @1
@f:     pop     ebx // NormToUpperAnsi7[p^]<>up^ -> FALSE
@e:     xor     eax, eax
        ret
@t:     pop     ebx // up^=#0 -> TRUE
        mov     al, 1
end;

function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        push    eax
        call    IntegerScan
        pop     edx
        test    eax, eax
        jnz     @e
        dec     eax // returns -1
        ret
@e:     sub     eax, edx
        shr     eax, 2
end;

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=P, edx=Count, Value=ecx
        test    eax, eax
        jz      @ok0 // avoid GPF
        cmp     edx, 8
        jb      @s2
        nop
        nop
        nop // @s1 loop align
@s1:    sub     edx, 8
        cmp     [eax], ecx
        je      @ok0
        cmp     [eax + 4], ecx
        je      @ok4
        cmp     [eax + 8], ecx
        je      @ok8
        cmp     [eax + 12], ecx
        je      @ok12
        cmp     [eax + 16], ecx
        je      @ok16
        cmp     [eax + 20], ecx
        je      @ok20
        cmp     [eax + 24], ecx
        je      @ok24
        cmp     [eax + 28], ecx
        je      @ok28
        add     eax, 32
        cmp     edx, 8
        jae     @s1
@s2:    test    edx, edx
        jz      @z
        cmp     [eax], ecx
        je      @ok0
        dec     edx
        jz      @z
        cmp     [eax + 4], ecx
        je      @ok4
        dec     edx
        jz      @z
        cmp     [eax + 8], ecx
        je      @ok8
        dec     edx
        jz      @z
        cmp     [eax + 12], ecx
        je      @ok12
        dec     edx
        jz      @z
        cmp     [eax + 16], ecx
        je      @ok16
        dec     edx
        jz      @z
        cmp     [eax + 20], ecx
        je      @ok20
        dec     edx
        jz      @z
        cmp     [eax + 24], ecx
        je      @ok24
@z:     xor     eax, eax // return nil if not found
        ret
@ok0:   rep     ret
@ok28:  add     eax, 28
        ret
@ok24:  add     eax, 24
        ret
@ok20:  add     eax, 20
        ret
@ok16:  add     eax, 16
        ret
@ok12:  add     eax, 12
        ret
@ok8:   add     eax, 8
        ret
@ok4:   add     eax, 4
end;

function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=P, edx=Count, Value=ecx
        test    eax, eax
        jz      @z // avoid GPF
        cmp     edx, 8
        jae     @s1
        jmp     dword ptr[edx * 4 + @Table]
@Table: dd      @z, @1, @2, @3, @4, @5, @6, @7
@s1:    // fast search by 8 integers (pipelined instructions)
        sub     edx, 8
        cmp     [eax], ecx
        je      @ok
        cmp     [eax + 4], ecx
        je      @ok
        cmp     [eax + 8], ecx
        je      @ok
        cmp     [eax + 12], ecx
        je      @ok
        cmp     [eax + 16], ecx
        je      @ok
        cmp     [eax + 20], ecx
        je      @ok
        cmp     [eax + 24], ecx
        je      @ok
        cmp     [eax + 28], ecx
        je      @ok
        add     eax, 32
        cmp     edx, 8
        jae     @s1
        jmp     dword ptr[edx * 4 + @Table]
@7:     cmp     [eax + 24], ecx
        je      @ok
@6:     cmp     [eax + 20], ecx
        je      @ok
@5:     cmp     [eax + 16], ecx
        je      @ok
@4:     cmp     [eax + 12], ecx
        je      @ok
@3:     cmp     [eax + 8], ecx
        je      @ok
@2:     cmp     [eax + 4], ecx
        je      @ok
@1:     cmp     [eax], ecx
        je      @ok
@z:     xor     eax, eax
        ret
@ok:    mov     al, 1
end;

function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // faster version by AB - eax=Str dl=Chr
        test    eax, eax
        jz      @z
@1:     mov     ecx, dword ptr [eax]
        cmp     cl, dl
        je      @z
        inc     eax
        test    cl, cl
        jz      @e
        cmp     ch, dl
        je      @z
        inc     eax
        test    ch, ch
        jz      @e
        shr     ecx, 16
        cmp     cl, dl
        je      @z
        inc     eax
        test    cl, cl
        jz      @e
        cmp     ch, dl
        je      @z
        inc     eax
        test    ch, ch
        jnz     @1
@e:     xor     eax, eax
        ret
@z:     db      $f3 // rep ret
end;

function CompareMem(P1, P2: Pointer; Length: PtrInt): Boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm     // eax=P1 edx=P2 ecx=Length
        cmp     eax, edx
        je      @0                 // P1=P2
        sub     ecx, 8
        jl      @small
        push    ebx
        mov     ebx, [eax]         // Compare First 4 Bytes
        cmp     ebx, [edx]
        jne     @setbig
        lea     ebx, [eax + ecx]   // Compare Last 8 Bytes
        add     edx, ecx
        mov     eax, [ebx]
        cmp     eax, [edx]
        jne     @setbig
        mov     eax, [ebx + 4]
        cmp     eax, [edx + 4]
        jne     @setbig
        sub     ecx, 4
        jle     @true              // All Bytes already Compared
        neg     ecx                // ecx=-(Length-12)
        add     ecx, ebx           // DWORD Align Reads
        and     ecx, -4
        sub     ecx, ebx
@loop:  mov     eax, [ebx + ecx]   // Compare 8 Bytes per Loop
        cmp     eax, [edx + ecx]
        jne     @setbig
        mov     eax, [ebx + ecx + 4]
        cmp     eax, [edx + ecx + 4]
        jne     @setbig
        add     ecx, 8
        jl      @loop
@true:  pop     ebx
@0:     mov     al, 1
        ret
@setbig:pop     ebx
        setz    al
        ret
@small: add     ecx, 8             // ecx=0..7
        jle     @0                 // Length <= 0
        neg     ecx                // ecx=-1..-7
        lea     ecx, [@1 + ecx * 8 + 8]   // each @#: block below = 8 bytes
        jmp     ecx
@7:     mov     cl, [eax + 6]
        cmp     cl, [edx + 6]
        jne     @setsml
@6:     mov     ch, [eax + 5]
        cmp     ch, [edx + 5]
        jne     @setsml
@5:     mov     cl, [eax + 4]
        cmp     cl, [edx + 4]
        jne     @setsml
@4:     mov     ch, [eax + 3]
        cmp     ch, [edx + 3]
        jne     @setsml
@3:     mov     cl, [eax + 2]
        cmp     cl, [edx + 2]
        jne     @setsml
@2:     mov     ch, [eax + 1]
        cmp     ch, [edx + 1]
        jne     @setsml
@1:     mov     al, [eax]
        cmp     al, [edx]
@setsml:setz    al
end;

function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt): integer;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm     // eax=SubStr, edx=S, ecx=Offset
        push    ebx
        push    esi
        push    edx
        test    eax, eax
        jz      @notfnd            // exit if SubStr=''
        test    edx, edx
        jz      @notfnd            // exit if S=''
        mov     esi, ecx
        mov     ecx, [edx - 4]     // length(S)
        mov     ebx, [eax - 4]     // length(SubStr)
        add     ecx, edx
        sub     ecx, ebx              // ecx = max start pos for full match
        lea     edx, [edx + esi - 1]  // edx = start position
        cmp     edx, ecx
        jg      @notfnd            // startpos > max start pos
        cmp     ebx, 1
        jle     @onec              // optimized loop for length(SubStr)<=1
        push    edi
        push    ebp
        lea     edi, [ebx - 2]     // edi = length(SubStr)-2
        mov     esi, eax           // esi = SubStr
        movzx   ebx, byte ptr[eax] // bl = search character
        nop; nop
@l:     cmp     bl, [edx]          // compare 2 characters per @l
        je      @c1fnd
@notc1: cmp     bl, [edx + 1]
        je      @c2fnd
@notc2: add     edx, 2
        cmp     edx, ecx            // next start position <= max start position
        jle     @l
        pop     ebp
        pop     edi
@notfnd:xor     eax, eax            // returns 0 if not fnd
        pop     edx
        pop     esi
        pop     ebx
        ret
@c1fnd: mov     ebp, edi            // ebp = length(SubStr)-2
@c1l:   movzx   eax, word ptr[esi + ebp]
        cmp     ax, [edx + ebp]     // compare 2 chars per @c1l (may include #0)
        jne     @notc1
        sub     ebp, 2
        jnc     @c1l
        pop     ebp
        pop     edi
        jmp     @setres
@c2fnd: mov     ebp, edi            // ebp = length(SubStr)-2
@c2l:   movzx   eax, word ptr[esi + ebp]
        cmp     ax, [edx + ebp + 1] // compare 2 chars per @c2l (may include #0)
        jne     @notc2
        sub     ebp, 2
        jnc     @c2l
        pop     ebp
        pop     edi
        jmp     @chkres
@onec:  jl      @notfnd             // needed for zero-length non-nil strings
        movzx   eax, byte ptr[eax]  // search character
@charl: cmp     al, [edx]
        je      @setres
        cmp     al, [edx + 1]
        je      @chkres
        add     edx, 2
        cmp     edx, ecx
        jle     @charl
        jmp     @notfnd
@chkres:cmp     edx, ecx           // check within ansistring
        jge     @notfnd
        add     edx, 1
@setres:pop     ecx                // ecx = S
        pop     esi
        pop     ebx
        neg     ecx
        lea     eax, [edx + ecx + 1]
end;

function IdemPropNameU(const P1,P2: RawUTF8): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=p1, edx=p2
        cmp     eax, edx
        je      @out1
        test    eax, edx
        jz      @maybenil
@notnil:mov     ecx, [eax - 4] // compare lengths
        cmp     ecx, [edx - 4]
        jne     @out1
        push    ebx
        lea     edx, [edx + ecx - 4]  // may include the length for shortest strings
        lea     ebx, [eax + ecx - 4]
        neg     ecx
        mov     eax, [ebx]     // compare last 4 chars
        xor     eax, [edx]
        and     eax, $dfdfdfdf // case insensitive
        jne     @out2
@by4:   add     ecx, 4
        jns     @match
        mov     eax, [ebx + ecx]
        xor     eax, [edx + ecx]
        and     eax, $dfdfdfdf // case insensitive
        je      @by4
@out2:  pop     ebx
@out1:  setz    al
        ret
@match: mov     al, 1
        pop     ebx
        ret
@maybenil: // here we know that eax<>edx
        test    eax, eax
        jz      @nil0     // eax=nil and eax<>edx -> edx<>nil -> false
        test    edx, edx
        jnz     @notnil
        mov     al, dl    // eax<>nil and edx=nil -> false
@nil0:
end;

function IdemPropNameUSameLen(P1,P2: PUTF8Char; P1P2Len: PtrInt): boolean;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=p1, edx=p2, ecx=P1P2Len
        cmp     eax, edx
        je      @out2
        cmp     ecx, 4
        jbe     @sml
        push    ebx
        lea     edx, [edx + ecx - 4]
        lea     ebx, [eax + ecx - 4]
        neg     ecx
        mov     eax, [ebx]     // compare last 4 chars
        xor     eax, [edx]
        and     eax, $dfdfdfdf // case insensitive
        jne     @out1
@by4:   add     ecx, 4
        jns     @match
        mov     eax, [ebx + ecx]
        xor     eax, [edx + ecx]
        and     eax, $dfdfdfdf // case insensitive
        je      @by4
@out1:  pop     ebx
@out2:  setz    al
        ret
        nop
        nop
@match: pop     ebx
        mov     al, 1
        ret
@mask:  dd      0, $df, $dfdf, $dfdfdf, $dfdfdfdf // compare 1..4 chars
@sml:   test    ecx, ecx
        jz      @smlo      // p1p2len=0
        mov     eax, [eax]
        xor     eax, [edx]
        and     eax, dword ptr[@mask + ecx * 4]
@smlo:  setz    al
end;

function StrIComp(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // faster version by AB, from Agner Fog's original
        mov     ecx, eax
        test    eax, edx
        jz      @n
@ok:    sub     edx, eax
        jz      @0
@10:    mov     al, [ecx]
        cmp     al, [ecx + edx]
        jne     @20
        inc     ecx
        test    al, al
        jnz     @10                    // continue with next byte
        // terminating zero found. Strings are equal
@0:     xor     eax, eax
        ret
@20:    // bytes are different. check case
        xor     al, 20H                // toggle case
        cmp     al, [ecx + edx]
        jne     @30
        // possibly differing only by case. Check if a-z
        or      al, 20H                // upper case
        sub     al, 'a'
        cmp     al, 'z' - 'a'
        ja      @30                    // not a-z
        // a-z and differing only by case
        inc     ecx
        jmp     @10                    // continue with next byte
@30:    // bytes are different,even after changing case
        movzx   eax, byte[ecx]        // get original value again
        sub     eax, 'A'
        cmp     eax, 'Z' - 'A'
        ja      @40
        add     eax, 20H
@40:    movzx   edx, byte[ecx + edx]
        sub     edx, 'A'
        cmp     edx, 'Z' - 'A'
        ja      @50
        add     edx, 20H
@50:    sub     eax, edx                 // subtract to get result
        ret
@n:     cmp     eax, edx
        je      @0
        test    eax, eax  // Str1='' ?
        jz      @max
        test    edx, edx  // Str2='' ?
        jnz     @ok
        mov     eax, 1
        ret
@max:   dec     eax
end;

function StrLenPas(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // slower than x86/SSE* StrLen(), but won't read any byte beyond the string
        mov     edx, eax
        test    eax, eax
        jz      @0
        xor     eax, eax
@s:     cmp     byte ptr[eax + edx + 0], 0
        je      @0
        cmp     byte ptr[eax + edx + 1], 0
        je      @1
        cmp     byte ptr[eax + edx + 2], 0
        je      @2
        cmp     byte ptr[eax + edx + 3], 0
        je      @3
        add     eax, 4
        jmp     @s
@1:     inc     eax
        ret
@0:     rep     ret
@2:     add     eax, 2
        ret
@3:     add     eax, 3
end;

function StrCompFast(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // no branch taken in case of not equal first char
        cmp     eax, edx
        je      @zero  // same string or both nil
        test    eax, edx
        jz      @maynil
@1:     mov     cl, [eax]
        mov     ch, [edx]
        inc     eax
        inc     edx
        test    cl, cl
        jz      @exit
        cmp     cl, ch
        je      @1
@exit:  movzx   eax, cl
        movzx   edx, ch
        sub     eax, edx
        ret
@maynil:test    eax, eax  // Str1='' ?
        jz      @max
        test    edx, edx  // Str2='' ?
        jnz     @1
        mov     eax, 1
        ret
@max:   dec     eax
        ret
@zero:  xor     eax, eax
end;

const
  EQUAL_EACH = 8;   // see https://msdn.microsoft.com/en-us/library/bb531463
  NEGATIVE_POLARITY = 16;

function StrCompSSE42(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // warning: may read up to 15 bytes beyond the string itself
      test      eax, edx
      jz        @n
@ok:  sub       eax, edx
      {$ifdef HASAESNI}
      movdqu    xmm0, dqword [edx]
      pcmpistri xmm0, dqword [edx + eax], EQUAL_EACH + NEGATIVE_POLARITY // result in ecx
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
      xor       eax, eax
      ret
@1:   add       edx, 16
      {$ifdef HASAESNI}
      movdqu    xmm0, dqword [edx]
      pcmpistri xmm0, dqword [edx + eax], EQUAL_EACH + NEGATIVE_POLARITY // result in ecx
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
@0:   xor       eax, eax // Str1=Str2
      ret
@n:   cmp       eax, edx
      je        @0
      test      eax, eax  // Str1='' ?
      jz        @max
      test      edx, edx  // Str2='' ?
      jnz       @ok
      mov       eax, 1
      ret
@max: dec       eax
      ret
@2:   add       eax, edx
      movzx     eax, byte ptr [eax+ecx]
      movzx     edx, byte ptr [edx+ecx]
      sub       eax, edx
end;

function SortDynArrayAnsiStringSSE42(const A,B): integer;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // warning: may read up to 15 bytes beyond the string itself
      mov       eax, [eax]
      mov       edx, [edx]
      test      eax, edx
      jz        @n
@ok:  sub       eax, edx
      jz        @0
      {$ifdef HASAESNI}
      movdqu    xmm0, dqword [edx] // result in ecx
      pcmpistri xmm0, dqword [edx+eax], EQUAL_EACH + NEGATIVE_POLARITY
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
      xor       eax, eax
      ret
@1:   add       edx, 16
      {$ifdef HASAESNI}
      movdqu    xmm0, dqword [edx] // result in ecx
      pcmpistri xmm0, dqword [edx+eax], EQUAL_EACH + NEGATIVE_POLARITY
      {$else}
      db $F3,$0F,$6F,$02
      db $66,$0F,$3A,$63,$04,$10,EQUAL_EACH+NEGATIVE_POLARITY
      {$endif}
      ja        @1
      jc        @2
@0:   xor       eax, eax // Str1=Str2
      ret
@n:   cmp       eax, edx
      je        @0
      test      eax, eax  // Str1='' ?
      jz        @max
      test      edx, edx  // Str2='' ?
      jnz       @ok
      or        eax, -1
      ret
@max: inc       eax
      ret
@2:   add       eax, edx
      movzx     eax, byte ptr [eax+ecx]
      movzx     edx, byte ptr [edx+ecx]
      sub       eax, edx
end;

function StrLenSSE42(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // warning: may read up to 15 bytes beyond the string itself
        mov     edx, eax             // copy pointer
        test    eax, eax
        jz      @null                // returns 0 if S=nil
        xor     eax, eax
        {$ifdef HASAESNI}
        pxor    xmm0, xmm0
        pcmpistri xmm0, dqword[edx], EQUAL_EACH  // comparison result in ecx
        {$else}
        db      $66, $0F, $EF, $C0
        db      $66, $0F, $3A, $63, $02, EQUAL_EACH
        {$endif}
        jnz     @loop
        mov     eax, ecx
        ret
        nop   // for @loop alignment
@loop:  add     eax, 16
        {$ifdef HASAESNI}
        pcmpistri xmm0, dqword[edx + eax], EQUAL_EACH  // comparison result in ecx
        {$else}
        db      $66, $0F, $3A, $63, $04, $10, EQUAL_EACH
        {$endif}
        jnz     @loop
@ok:    add     eax, ecx
        ret
@null:  db      $f3 // rep ret
end;

procedure YearToPChar(Y: PtrUInt; P: PUTF8Char);
asm // eax=Y, edx=P
        push    edx
        mov     ecx, eax
        mov     edx, 1374389535 // use power of two reciprocal to avoid division
        mul     edx
        shr     edx, 5          // now edx=Y div 100
        movzx   eax, word ptr[TwoDigitLookup + edx * 2]
        imul    edx, -200
        movzx   edx, word ptr[TwoDigitLookup + ecx * 2 + edx]
        pop     ecx
        shl     edx, 16
        or      eax, edx
        mov     [ecx], eax
end;

function Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
asm
    xor ecx,ecx  // ContainsNoTime=nil
    test eax,eax   // if s='' -> p=nil -> will return 0, whatever L value is
    jz Iso8601ToTimeLogPUTF8Char
    mov edx,[eax-4] // edx=L
@1: jmp Iso8601ToTimeLogPUTF8Char
end;

function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
asm // eax=dest source=edx
        test    edx, edx
        jz      @z
        push    esi
        mov     esi, offset NormToUpperAnsi7
        xor     ecx, ecx
@1:     mov     cl, [edx]
        inc     edx
        test    cl, cl
        mov     cl, [esi + ecx]
        jz      @2
        mov     [eax], cl
        inc     eax
        jmp     @1
@2:     pop     esi
@z:
end;

function UpperCopyShort(dest: PAnsiChar; const source: shortstring): PAnsiChar;
asm // eax=dest source=edx
        push    esi
        push    ebx
        movzx   ebx, byte ptr[edx] // ebx = length(source)
        xor     ecx, ecx
        test    ebx, ebx
        mov     esi, offset NormToUpperAnsi7
        jz      @2 // source=''
        inc     edx
@1:     mov     cl, [edx]
        inc     edx
        dec     ebx
        mov     cl, [esi + ecx]
        mov     [eax], cl
        lea     eax, [eax + 1]
        jnz     @1
@2:     pop     ebx
        pop     esi
@z:
end;

function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;
asm // eax=source edx=searchUp
        push    eax        // save source var
        mov     eax, [eax] // eax=source
        test    eax, eax
        jz      @z
        push    eax
        call    IdemPChar
        pop     ecx        // ecx=source
        push    eax        // save result
@1:     mov     dl, [ecx]  // while not (source^ in [#0,#10,#13]) do inc(source)
        inc     ecx
        cmp     dl, 13
        ja      @1
        je      @e
        or      dl, dl
        jz      @0
        cmp     dl, 10
        jne     @1
        jmp     @4
@e:     cmp     byte ptr[ecx], 10 // jump #13#10
        jne     @4
@3:     inc     ecx
@4:     pop     eax        // restore result
        pop     edx        // restore source var
        mov     [edx], ecx // update source var
        ret
@0:     xor     ecx, ecx   // set source=nil
        jmp     @4
@z:     pop     edx        // ignore source var, result := false
end;

procedure crcblockNoSSE42(crc128, data128: PBlock128);
asm // Delphi is not efficient about compiling above pascal code
        push    ebp
        push    edi
        push    esi
        mov     ebp, eax  // ebp=crc128 edi=data128
        mov     edi, edx
        mov     edx, dword ptr[eax]
        mov     ecx, dword ptr[eax + 4]
        xor     edx, dword ptr[edi]
        xor     ecx, dword ptr[edi + 4]
        movzx   esi, dl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, dh
        shr     edx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     edx, dword ptr[ebp + 8]
        xor     edx, dword ptr[edi + 8]
        mov     dword ptr[ebp], eax
        movzx   esi, cl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, ch
        shr     ecx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, cl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, ch
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     dword ptr[ebp + 4], eax
        mov     ecx, dword ptr[ebp + 12]
        xor     ecx, dword ptr[edi + 12]
        movzx   esi, dl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, dh
        shr     edx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     dword ptr[ebp + 8], eax
        movzx   esi, cl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, ch
        shr     ecx, 16
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        movzx   esi, cl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, ch
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        mov     dword ptr[ebp + 12], eax
        pop     esi
        pop     edi
        pop     ebp
end;

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
asm     // adapted from fast Aleksandr Sharahov version
        test    edx, edx
        jz      @ret
        neg     ecx
        jz      @ret
        not     eax
        push    ebx
@head:  test    dl, 3
        jz      @aligned
        movzx   ebx, byte[edx]
        inc     edx
        xor     bl, al
        shr     eax, 8
        xor     eax, dword ptr[ebx * 4 + crc32ctab]
        inc     ecx
        jnz     @head
        pop     ebx
        not     eax
        ret
@ret:   rep     ret
@aligned:
        sub     edx, ecx
        add     ecx, 8
        jg      @bodydone
        push    esi
        push    edi
        mov     edi, edx
        mov     edx, eax
@bodyloop:
        mov     ebx, [edi + ecx - 4]
        xor     edx, [edi + ecx - 8]
        movzx   esi, bl
        mov     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, bh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        shr     ebx, 16
        movzx   esi, bl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, bh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 7]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 6]
        shr     edx, 16
        movzx   esi, dl
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 5]
        movzx   esi, dh
        xor     eax, dword ptr[esi * 4 + crc32ctab + 1024 * 4]
        add     ecx, 8
        jg      @done
        mov     ebx, [edi + ecx - 4]
        xor     eax, [edi + ecx - 8]
        movzx   esi, bl
        mov     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 3]
        movzx   esi, bh
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 2]
        shr     ebx, 16
        movzx   esi, bl
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 1]
        movzx   esi, bh
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 0]
        movzx   esi, al
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 7]
        movzx   esi, ah
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 6]
        shr     eax, 16
        movzx   esi, al
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 5]
        movzx   esi, ah
        xor     edx, dword ptr[esi * 4 + crc32ctab + 1024 * 4]
        add     ecx, 8
        jle     @bodyloop
        mov     eax, edx
@done:  mov     edx, edi
        pop     edi
        pop     esi
@bodydone:
        sub     ecx, 8
        jl      @tail
        pop     ebx
        not     eax
        ret
@tail:  movzx   ebx, byte[edx + ecx]
        xor     bl, al
        shr     eax, 8
        xor     eax, dword ptr[ebx * 4 + crc32ctab]
        inc     ecx
        jnz     @tail
        pop     ebx
        not     eax
end;

{$ifndef DELPHI5OROLDER}
const
  CMP_RANGES = $44; // see https://msdn.microsoft.com/en-us/library/bb531425

function UpperCopy255BufSSE42(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
asm // eax=dest edx=source ecx=sourceLen
       test    ecx,ecx
       jz      @z
       movdqu  xmm1, dqword ptr [@az]
       movdqu  xmm3, dqword ptr [@bits]
       cmp     ecx, 16
       ja      @big
       // optimize the common case of sourceLen<=16
       movdqu  xmm2, [edx]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES // find in range a-z, return mask in xmm0
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movdqu  [eax], xmm2
       add     eax, ecx
@z:    ret
@big:  push    eax
       cmp     ecx, 240
       jb      @ok
       mov     ecx, 239
@ok:   add     [esp], ecx // save to return end position with the exact size
       shr     ecx, 4
       sub     edx, eax
       inc     ecx
@s:    movdqu  xmm2, [edx+eax]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movdqu  [eax], xmm2
       add     eax, 16
       dec     ecx
       jnz     @s
       pop     eax
       ret
@az:   db 'azazazazazazazaz'         // define range for upper case conversion
@bits: db '                '         // $20 = bit to change when changing case
end;
{$endif DELPHI5OROLDER}

function fnv32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
asm // eax=crc, edx=buf, ecx=len
        push    ebx
        test    edx, edx
        jz      @0
        neg     ecx
        jz      @0
        sub     edx, ecx
@1:     movzx   ebx, byte ptr[edx + ecx]
        xor     eax, ebx
        imul    eax, eax, 16777619
        inc     ecx
        jnz     @1
@0:     pop     ebx
end; // we tried an unrolled version, but it was slower on our Core i7!

function kr32(crc: cardinal; buf: PAnsiChar; len: PtrInt): cardinal;
asm // eax=crc, edx=buf, ecx=len
        test    ecx, ecx
        push    edi
        push    esi
        push    ebx
        push    ebp
        jz      @z
        cmp     ecx, 4
        jb      @s
@8:     mov     ebx, [edx] // unrolled version reading per dword
        add     edx, 4
        mov     esi, eax
        movzx   edi, bl
        movzx   ebp, bh
        shr     ebx, 16
        shl     eax, 5
        sub     eax, esi
        add     eax, edi
        mov     esi, eax
        shl     eax, 5
        sub     eax, esi
        lea     esi, [eax + ebp]
        add     eax, ebp
        movzx   edi, bl
        movzx   ebx, bh
        shl     eax, 5
        sub     eax, esi
        lea     ebp, [eax + edi]
        add     eax, edi
        shl     eax, 5
        sub     eax, ebp
        add     eax, ebx
        cmp     ecx, 8
        lea     ecx, [ecx - 4]
        jae     @8
        test    ecx, ecx
        jz      @z
@s:     mov     esi, eax
@1:     shl     eax, 5
        movzx   ebx, byte ptr[edx]
        inc     edx
        sub     eax, esi
        lea     esi, [eax + ebx]
        add     eax, ebx
        dec     ecx
        jnz     @1
@z:     pop     ebp
        pop     ebx
        pop     esi
        pop     edi
end;

function ToVarInt32(Value: PtrInt; Dest: PByte): PByte;
asm
        test    eax, eax
        jnl     @pos
        neg     eax
        add     eax, eax
        jmp     ToVarUInt32
@pos:   jz      @zer
        lea     eax, [eax * 2 - 1]
        jmp     ToVarUInt32
@zer:   mov     [edx], al
        lea     eax, [edx + 1]
end;

function ToVarUInt32(Value: PtrUInt; Dest: PByte): PByte;
asm
        cmp     eax, $7f
        jbe     @0
        cmp     eax, $00004000
        jb      @1
        cmp     eax, $00200000
        jb      @2
        cmp     eax, $10000000
        jb      @3
        mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@3:     mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@2:     mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@1:     mov     ecx, eax
        shr     eax, 7
        and     cl, $7f
        or      cl, $80
        mov     [edx], cl
        inc     edx
@0:     mov     [edx], al
        lea     eax, [edx + 1]
end;

function SortDynArrayInteger(const A,B): integer;
asm
        mov     ecx, [eax]
        xor     eax, eax
        mov     edx, [edx]
        cmp     ecx, edx
        je      @0
        jg      @1
        dec     eax
@0:     ret
@1:     inc     eax
end;

function SortDynArrayInt64(const A,B): integer;
asm // Delphi x86 compiler is not efficient at compiling below code
        mov     ecx, [eax]
        mov     eax, [eax + 4]
        cmp     eax, [edx + 4]
        jnz     @nz
        cmp     ecx, [edx]
        jz      @0
        jnb     @p
@n:     or      eax, -1
        ret
@0:     xor     eax, eax
        ret
@nz:    jl      @n
@p:     mov     eax, 1
end;

function CompareQWord(A, B: QWord): integer;
begin
  {$ifdef FPC_OR_UNICODE} // recent compilers are able to generate correct code
  if A<B then
    result := -1 else
  if A>B then
    result := 1 else
    result := 0;
  {$else}
  result := SortDynArrayQWord(A,B); // use correct x86 asm version below
  {$endif}
end;

function SortDynArrayQWord(const A,B): integer;
asm // Delphi x86 compiler is not efficient, and oldest even incorrect
        mov     ecx, [eax]
        mov     eax, [eax + 4]
        cmp     eax, [edx + 4]
        jnz     @nz
        cmp     ecx, [edx]
        jz      @0
@nz:    jnb     @p
        or      eax, -1
        ret
@0:     xor     eax, eax
        ret
@p:     mov     eax, 1
end;

function SortDynArrayRawByteString(const A,B): integer;
asm
        jmp     SortDynArrayAnsiString
end;

function SortDynArrayAnsiString(const A,B): integer;
asm // x86 version optimized for AnsiString/RawUTF8 types
        mov     eax, [eax]
        mov     edx, [edx]
        cmp     eax, edx
        je      @0
        test    eax, edx
        jz      @n1
@n2:    movzx   ecx, byte ptr[eax] // first char comparison (quicksort speedup)
        sub     cl, [edx]
        jne     @no
        push    ebx
        mov     ebx, [eax - 4]
        sub     ebx, [edx - 4]
        push    ebx
        adc     ecx, -1
        and     ecx, ebx
        sub     ecx, [eax - 4]
        sub     eax, ecx
        sub     edx, ecx
@s:     mov     ebx, [eax + ecx]  // compare by dword
        xor     ebx, [edx + ecx]
        jnz     @d
        add     ecx, 4
        js      @s
@l:     pop     eax            // all chars equal -> returns length(a)-length(b)
        pop     ebx
        ret
@d:     bsf     ebx, ebx       // char differs -> returns pbyte(a)^-pbyte(b)^
        shr     ebx, 3
        add     ecx, ebx
        jns     @l
        movzx   eax, byte ptr[eax + ecx]
        movzx   edx, byte ptr[edx + ecx]
        pop     ebx
        pop     ebx
        sub     eax, edx
        ret
@n1:    test    eax, eax       // a or b may be ''
        jz      @n0
        test    edx, edx
        jnz     @n2
        cmp     [eax - 4], edx
        je      @0
@no:    jnc     @1
        or      eax, -1
        ret
@n0:    cmp     eax, [edx - 4]
        je      @0
        jnc     @1
        or      eax, -1
        ret
@0:     xor     eax, eax
        ret
@1:     mov     eax, 1
end;

function SortDynArrayAnsiStringI(const A,B): integer;
asm // avoid a call on the stack on x86 platform
        mov     eax, [eax]
        mov     edx, [edx]
        jmp     StrIComp
end;

function SortDynArrayPUTF8Char(const A,B): integer;
asm // avoid a call on the stack on x86 platform
        mov     eax, [eax]
        mov     edx, [edx]
        jmp     dword ptr[StrComp]
end;

{$endif PUREPASCAL}

function PosExChar(Chr: AnsiChar; const Str: RawUTF8): PtrInt;
begin
  {$ifdef FPC}
  if Str<>'' then // // will use fast FPC SSE version
    result := IndexByte(pointer(Str)^,_LStrLen(Str),byte(chr))+1 else
  {$else}
  if Str<>'' then
    for result := 1 to PInteger(PtrInt(Str)-sizeof(Integer))^ do
      if Str[result]=Chr then
        exit;
  {$endif FPC}
    result := 0;
end;

function SplitRight(const Str: RawUTF8; SepChar: AnsiChar; LeftStr: PRawUTF8): RawUTF8;
var i: PtrInt;
begin
  for i := length(Str) downto 1 do
    if Str[i]=SepChar then begin
      result := copy(Str,i+1,maxInt);
      if LeftStr<>nil then
        LeftStr^ := copy(Str,1,i-1);
      exit;
    end;
  result := Str;
  if LeftStr<>nil then
    LeftStr^ := '';
end;

function SplitRights(const Str, SepChar: RawUTF8): RawUTF8;
var i, j, sep: PtrInt;
    c: AnsiChar;
begin
  sep := length(SepChar);
  if sep > 0 then
    if sep = 1 then
      result := SplitRight(Str,SepChar[1]) else begin
    for i := length(Str) downto 1 do begin
      c := Str[i];
      for j := 1 to sep do
        if c=SepChar[j] then begin
          result := copy(Str,i+1,maxInt);
          exit;
        end;
    end;
  end;
  result := Str;
end;

function Split(const Str, SepStr: RawUTF8; StartPos: integer): RawUTF8;
var i: integer;
begin
  i := PosEx(SepStr,Str,StartPos);
  if i>0 then
    result := Copy(Str,StartPos,i-StartPos) else
    if StartPos=1 then
      result := Str else
      result := Copy(Str,StartPos,maxInt);
end;

procedure Split(const Str, SepStr: RawUTF8; var LeftStr, RightStr: RawUTF8; ToUpperCase: boolean);
var i: integer;
    tmp: RawUTF8; // may be called as Split(Str,SepStr,Str,RightStr)
begin
  i := PosEx(SepStr,Str);
  if i=0 then begin
    LeftStr := Str;
    RightStr := '';
  end else begin
    tmp := copy(Str,1,i-1);
    RightStr := copy(Str,i+length(SepStr),maxInt);
    LeftStr := tmp;
  end;
  if ToUpperCase then begin
    LeftStr := UpperCaseU(LeftStr);
    RightStr := UpperCaseU(RightStr);
  end;
end;

function Split(const Str, SepStr: RawUTF8; var LeftStr: RawUTF8; ToUpperCase: boolean=false): RawUTF8;
begin
  Split(Str,SepStr,LeftStr,result,ToUpperCase);
end;

procedure Split(const Str: RawUTF8; const SepStr: array of RawUTF8;
  const DestPtr: array of PRawUTF8);
var s,i,j,n: integer;
begin
  j := 1;
  n := 0;
  s := 0;
  if high(SepStr)>=0 then
    while n<=high(DestPtr) do begin
      i := PosEx(SepStr[s],Str,j);
      if i=0 then begin
        if DestPtr[n]<>nil then
          DestPtr[n]^ := copy(Str,j,MaxInt);
        inc(n);
        break;
      end;
      if DestPtr[n]<>nil then
        DestPtr[n]^ := copy(Str,j,i-j);
      inc(n);
      if s<high(SepStr) then
        inc(s);
      j := i+1;
    end;
  for i := n to high(DestPtr) do
    if DestPtr[i]<>nil then
      DestPtr[i]^ := '';
end;

function StringReplaceAll(const S, OldPattern, NewPattern: RawUTF8): RawUTF8;

  procedure Process(found: integer);
  var oldlen,newlen,i,last,posCount,sharedlen: integer;
      pos: TIntegerDynArray;
      src,dst: PAnsiChar;
  begin
    oldlen := length(OldPattern);
    newlen := length(NewPattern);
    SetLength(pos,64);
    pos[0] := found;
    posCount := 1;
    repeat
      found := PosEx(OldPattern,S,found+oldlen);
      if found=0 then
        break;
      AddInteger(pos,posCount,found);
    until false;
    FastSetString(result,nil,Length(S)+(newlen-oldlen)*posCount);
    last := 1;
    src := pointer(s);
    dst := pointer(result);
    for i := 0 to posCount-1 do begin
      sharedlen := pos[i]-last;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(src^,dst^,sharedlen);
      inc(src,sharedlen+oldlen);
      inc(dst,sharedlen);
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(NewPattern)^,dst^,newlen);
      inc(dst,newlen);
      last := pos[i]+oldlen;
    end;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(src^,dst^,length(S)-last+1);
  end;

var j: integer;
begin
  if (S='') or (OldPattern='') or (OldPattern=NewPattern) then
    result := S else begin
    j := PosEx(OldPattern, S, 1); // our PosEx() is faster than Pos()
    if j=0 then
      result := S else
      Process(j);
  end;
end;

function StringReplaceTabs(const Source,TabText: RawUTF8): RawUTF8;

  procedure Process(S,D,T: PAnsiChar; TLen: integer);
  begin
    repeat
      if S^=#0 then
        break else
      if S^<>#9 then begin
        D^ := S^;
        inc(D);
        inc(S);
      end else begin
        {$ifdef FPC}Move{$else}MoveFast{$endif}(T^,D^,TLen);
        inc(D,TLen);
        inc(S);
      end;
    until false;
  end;

var L,i,n,ttl: PtrInt;
begin
  ttl := length(TabText);
  L := Length(Source);
  n := 0;
  if ttl<>0 then
    for i := 1 to L do
      if Source[i]=#9 then
        inc(n);
  if n=0 then begin
    result := Source;
    exit;
  end;
  SetLength(result,L+n*pred(ttl));
  Process(pointer(Source),pointer(result),pointer(TabText),ttl);
end;

function strspnpas(s,accept: pointer): integer;
var p: PCardinal;
    c: AnsiChar;
    d: cardinal;
begin // returns size of initial segment of s which are in accept
  result := 0;
  repeat
    c := PAnsiChar(s)[result];
    if c=#0 then
      break;
    p := accept;
    repeat // stop as soon as we find any character not from accept
      d := p^;
      inc(p);
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
      d := d shr 8;
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
      d := d shr 8;
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
      d := d shr 8;
      if AnsiChar(d)=c then
        break else
      if AnsiChar(d)=#0 then
        exit;
    until false;
    inc(result);
  until false;
end;

function strcspnpas(s,reject: pointer): integer;
var p: PCardinal;
    c: AnsiChar;
    d: cardinal;
begin // returns size of initial segment of s which are not in reject
  result := 0;
  repeat
    c := PAnsiChar(s)[result];
    if c=#0 then
      break;
    p := reject;
    repeat // stop as soon as we find any character from reject
      d := p^;
      inc(p);
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
      d := d shr 8;
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
      d := d shr 8;
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
      d := d shr 8;
      if AnsiChar(d)=c then
        exit else
      if AnsiChar(d)=#0 then
        break;
    until false;
    inc(result);
  until false;
end;

{$ifndef ABSOLUTEPASCAL}
{$ifdef CPUINTEL}
{$ifdef CPUX64} // inspired by Agner Fog's strspn64.asm
function strcspnsse42(s,reject: pointer): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=s, rdx=reject (Linux: rdi,rsi)
        .noframe
{$endif FPC}
{$ifdef win64}
        push    rdi
        push    rsi
        mov     rdi, rcx
        mov     rsi, rdx
{$endif}mov     r8,  rsi
        xor     ecx, ecx
@1:     movdqu  xmm2, [rdi]
        movdqu  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $30 //  find in set, invert valid bits, return bit mask in xmm0
        {$else}
        db $66,$0F,$3A,$62,$CA,$30
        {$endif}
        movd    eax, xmm0
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     rdi, 16 // first 16 chars matched, continue with next 16 chars
        add     rcx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     rax, rcx
{$ifdef win64}
        pop     rsi
        pop     rdi
{$endif}ret
@4:     and     eax, edx // accumulate matches
@5:     add     rsi, 16  // the set is more than 16 bytes
        movdqu  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $30
        {$else}
        db $66,$0F,$3A,$62,$CA,$30
        {$endif}
        movd    edx, xmm0
        jns     @4
        mov     rsi, r8    // restore set pointer
        and     eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     rdi, 16
        add     rcx, 16
        jmp     @1
end;
function strspnsse42(s,accept: pointer): integer;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=s, rdx=accept (Linux: rdi,rsi)
        .noframe
{$endif FPC}
{$ifdef win64}
        push    rdi
        push    rsi
        mov     rdi, rcx
        mov     rsi, rdx
{$endif}mov     r8,  rsi
        xor     ecx, ecx
@1:     movdqu  xmm2, [rdi]
        movdqu  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $00 //  find in set, return bit mask in xmm0
        {$else}
        db $66,$0F,$3A,$62,$CA,$00
        {$endif}
        movd    eax, xmm0
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     rdi, 16 // first 16 chars matched, continue with next 16 chars
        add     rcx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     rax, rcx
{$ifdef win64}
        pop     rsi
        pop     rdi
{$endif}ret
@4:     or      eax, edx // accumulate matches
@5:     add     rsi, 16  // the set is more than 16 bytes
        movdqu  xmm1, [rsi]
        {$ifdef HASAESNI}
        pcmpistrm xmm1, xmm2, $00
        {$else}
        db $66,$0F,$3A,$62,$CA,$00
        {$endif}
        movd    edx, xmm0
        jns     @4
        mov     rsi, r8    // restore set pointer
        or      eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     rdi, 16 // first 16 chars matched, continue with next 16 chars
        add     rcx, 16
        jmp     @1
end;
{$endif CPUX64}
{$ifdef CPUX86}
function strcspnsse42(s,reject: pointer): integer;
asm // eax=s, edx=reject
        push    edi
        push    esi
        push    ebx
        mov     edi, eax
        mov     esi, edx
        mov     ebx,  esi
        xor     ecx, ecx
@1:     {$ifdef HASAESNI}
        movdqu  xmm2, dqword [edi]
        movdqu  xmm1, dqword [esi]
        pcmpistrm xmm1, xmm2, $30 //  find in set, invert valid bits, return bit mask in xmm0
        movd    eax, xmm0
        {$else}
        db $F3,$0F,$6F,$17
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$30
        db $66,$0F,$7E,$C0
        {$endif}
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     eax, ecx
        pop     ebx
        pop     esi
        pop     edi
        ret
@4:     and     eax, edx  // accumulate matches
@5:     add     esi, 16   // the set is more than 16 bytes
        {$ifdef HASAESNI}
        movdqu  xmm1, [esi]
        pcmpistrm xmm1, xmm2, $30
        movd    edx, xmm0
        {$else}
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$30
        db $66,$0F,$7E,$C2
        {$endif}
        jns     @4
        mov     esi, ebx   // restore set pointer
        and     eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
end;
function strspnsse42(s,accept: pointer): integer;
asm // eax=s, edx=accept
        push    edi
        push    esi
        push    ebx
        mov     edi, eax
        mov     esi, edx
        mov     ebx,  esi
        xor     ecx, ecx
@1:     {$ifdef HASAESNI}
        movdqu  xmm2, dqword [edi]
        movdqu  xmm1, dqword [esi]
        pcmpistrm xmm1, xmm2, $00 //  find in set, return bit mask in xmm0
        movd    eax, xmm0
        {$else}
        db $F3,$0F,$6F,$17
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$00
        db $66,$0F,$7E,$C0
        {$endif}
        jns     @5
@2:     cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
@3:     not     eax
        bsf     eax, eax
        add     eax, ecx
        pop     ebx
        pop     esi
        pop     edi
        ret
@4:     or      eax, edx // accumulate matches
@5:     add     esi, 16  // the set is more than 16 bytes
        {$ifdef HASAESNI}
        movdqu  xmm1, [esi]
        pcmpistrm xmm1, xmm2, $00
        movd    edx, xmm0
        {$else}
        db $F3,$0F,$6F,$0E
        db $66,$0F,$3A,$62,$CA,$00
        db $66,$0F,$7E,$C2
        {$endif}
        jns     @4
        mov     esi, ebx   // restore set pointer
        or      eax, edx   // accumulate matches
        cmp     eax, 65535
        jne     @3
        add     edi, 16 // first 16 chars matched, continue with next 16 chars
        add     ecx, 16
        jmp     @1
end;
{$ifndef DELPHI5OROLDER}
function StrLenSSE2(S: pointer): PtrInt;
asm // from GPL strlen32.asm by Agner Fog - www.agner.org/optimize
        mov     ecx, eax            // copy pointer
        test    eax, eax
        jz      @null               // returns 0 if S=nil
        push    eax                 // save start address
        pxor    xmm0, xmm0          // set to zero
        and     ecx, 15             // lower 4 bits indicate misalignment
        and     eax, -16            // align pointer by 16
        // will never read outside a memory page boundary, so won't trigger GPF
        movdqa  xmm1, [eax]         // read from nearest preceding boundary
        pcmpeqb xmm1, xmm0          // compare 16 bytes with zero
        pmovmskb edx, xmm1          // get one bit for each byte result
        shr     edx, cl             // shift out false bits
        shl     edx, cl             // shift back again
        bsf     edx, edx            // find first 1-bit
        jnz     @A200               // found
        // Main loop, search 16 bytes at a time
@A100:  add     eax, 10H            // increment pointer by 16
        movdqa  xmm1, [eax]         // read 16 bytes aligned
        pcmpeqb xmm1, xmm0          // compare 16 bytes with zero
        pmovmskb edx, xmm1          // get one bit for each byte result
        bsf     edx, edx            // find first 1-bit
        // (moving the bsf out of the loop and using test here would be faster
        // for long strings on old processors, but we are assuming that most
        // strings are short, and newer processors have higher priority)
        jz      @A100               // loop if not found
@A200:  // Zero-byte found. Compute string length
        pop     ecx                 // restore start address
        sub     eax, ecx            // subtract start address
        add     eax, edx            // add byte index
@null:
end;
{$endif DELPHI5OROLDER}
{$endif CPUX86}
{$endif CPUINTEL}
{$endif ABSOLUTEPASCAL}

function IdemPropName(const P1,P2: shortstring): boolean;
begin
  if P1[0]=P2[0] then
    result := IdemPropNameUSameLen(@P1[1],@P2[1],ord(P2[0])) else
    result := false;
end;

function IdemPropName(const P1: shortstring; P2: PUTF8Char; P2Len: PtrInt): boolean;
begin
  if ord(P1[0])=P2Len then
    result := IdemPropNameUSameLen(@P1[1],P2,P2Len) else
    result := false;
end;

function IdemPropName(P1,P2: PUTF8Char; P1Len,P2Len: PtrInt): boolean;
begin
  if P1Len=P2Len then
    result := IdemPropNameUSameLen(P1,P2,P2Len) else
    result := false;
end;

function IdemPropNameU(const P1: RawUTF8; P2: PUTF8Char; P2Len: PtrInt): boolean;
begin
  if length(P1)=P2Len then
    result := IdemPropNameUSameLen(pointer(P1),P2,P2Len) else
    result := false;
end;

function ToText(os: TOperatingSystem): PShortString;
begin
  result := GetEnumName(TypeInfo(TOperatingSystem),ord(os));
end;

function ToText(const osv: TOperatingSystemVersion): ShortString;
begin
  if osv.os=osWindows then
     FormatShort('Windows %', [WINDOWS_NAME[osv.win]], result) else
     TrimLeftLowerCaseToShort(ToText(osv.os),result);
end;

function ToTextOS(osint32: integer): RawUTF8;
var osv: TOperatingSystemVersion absolute osint32;
    ost: ShortString;
begin
  ost := ToText(osv);
  if (osv.os>=osLinux) and (osv.utsrelease[2]<>0) then
    result := FormatUTF8('% %.%.%',[ost,osv.utsrelease[2],osv.utsrelease[1],osv.utsrelease[0]]) else
    result := ShortStringToUTF8(ost);
end;

{$ifdef MSWINDOWS}
procedure FileTimeToInt64(const FT: TFileTime; out I64: Int64);
begin
  {$ifdef CPU64}
  PInt64Rec(@I64)^.Lo := FT.dwLowDateTime;
  PInt64Rec(@I64)^.Hi := FT.dwHighDateTime;
  {$else}
  I64 := PInt64(@FT)^;
  {$endif}
end;

const
  // lpMinimumApplicationAddress retrieved from Windows is very low $10000
  // - i.e. maximum number of ID per table would be 65536 in TSQLRecord.GetID
  // - so we'll force an higher and almost "safe" value as 1,048,576
  // (real value from runnning Windows is greater than $400000)
  MIN_PTR_VALUE = $100000;

  // see http://msdn.microsoft.com/en-us/library/ms724833(v=vs.85).aspx
  VER_NT_WORKSTATION = 1;
  VER_NT_DOMAIN_CONTROLLER = 2;
  VER_NT_SERVER = 3;
  SM_SERVERR2 = 89;
  PROCESSOR_ARCHITECTURE_AMD64 = 9;

{$ifndef UNICODE}
function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall;
  external kernel32 name 'GetVersionExA';
{$endif}

var
  GetTickXP: Int64Rec;

function GetTickCount64ForXP: Int64; stdcall;
var t32: cardinal;
    t64: Int64Rec absolute result;
begin // warning: GetSystemTimeAsFileTime() is fast, but not monotonic!
  t32 := Windows.GetTickCount;
  t64 := GetTickXP; // (almost) atomic read
  if t32<t64.Lo then
    inc(t64.Hi); // wrap-up overflow after 49 days
  t64.Lo := t32;
  GetTickXP := t64; // (almost) atomic write
end; // warning: FPC's GetTickCount64 doesn't handle 49 days wrap :(

{$ifdef FPC} // oddly not defined in fpc\rtl\win
function SwitchToThread: BOOL; stdcall; external kernel32 name 'SwitchToThread';
{$endif}

procedure SleepHiRes(ms: cardinal);
begin
  if (ms<>0) or not SwitchToThread then
    Windows.Sleep(ms);
end;

procedure RetrieveSystemInfo;
var
  IsWow64Process: function(Handle: THandle; var Res: BOOL): BOOL; stdcall;
  GetNativeSystemInfo: procedure(var SystemInfo: TSystemInfo); stdcall;
  Res: BOOL;
  Kernel: THandle;
  P: pointer;
  Vers: TWindowsVersion;
  cpu, manuf, prod, prodver: string;
begin
  Kernel := GetModuleHandle(kernel32);
  GetTickCount64 := GetProcAddress(Kernel,'GetTickCount64');
  if not Assigned(GetTickCount64) then
    GetTickCount64 := @GetTickCount64ForXP;
  IsWow64Process := GetProcAddress(Kernel,'IsWow64Process');
  Res := false;
  IsWow64 := Assigned(IsWow64Process) and
    IsWow64Process(GetCurrentProcess,Res) and Res;
  FillcharFast(SystemInfo,SizeOf(SystemInfo),0);
  if IsWow64 then // see http://msdn.microsoft.com/en-us/library/ms724381(v=VS.85).aspx
    GetNativeSystemInfo := GetProcAddress(Kernel,'GetNativeSystemInfo') else
    @GetNativeSystemInfo := nil;
  if Assigned(GetNativeSystemInfo) then
    GetNativeSystemInfo(SystemInfo) else
    Windows.GetSystemInfo(SystemInfo);
  GetMem(P,10); // ensure that using MIN_PTR_VALUE won't break anything
  if (PtrUInt(P)>MIN_PTR_VALUE) and
     (PtrUInt(SystemInfo.lpMinimumApplicationAddress)<=MIN_PTR_VALUE) then
     PtrUInt(SystemInfo.lpMinimumApplicationAddress) := MIN_PTR_VALUE;
  Freemem(P);
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  Vers := wUnknown;
  with OSVersionInfo do
  // see https://msdn.microsoft.com/en-us/library/windows/desktop/ms724833
  case dwMajorVersion of
    5: case dwMinorVersion of
       0: Vers := w2000;
       1: Vers := wXP;
       2: if (wProductType=VER_NT_WORKSTATION) and
             (SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_AMD64) then
            Vers := wXP_64 else
          if GetSystemMetrics(SM_SERVERR2)=0 then
            Vers := wServer2003 else
            Vers := wServer2003_R2;
      end;
    6: case dwMinorVersion of
       0: Vers := wVista;
       1: Vers := wSeven;
       2: Vers := wEight;
       3: Vers := wEightOne;
       4: Vers := wTen;
       end;
    10: Vers := wTen;
  end;
  if Vers>=wVista then begin
    if OSVersionInfo.wProductType<>VER_NT_WORKSTATION then begin // Server edition
      inc(Vers,2); // e.g. wEight -> wServer2012
      if (Vers=wServer2016) and (OSVersionInfo.dwBuildNumber>=17763) then
        Vers := wServer2019_64; // https://stackoverflow.com/q/53393150
    end;
    if (SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_AMD64) and
       (Vers < wServer2019_64) then
      inc(Vers);   // e.g. wEight -> wEight64
  end;
  OSVersion := Vers;
  with OSVersionInfo do
    if wServicePackMajor=0 then
      FormatUTF8('Windows % (%.%.%)',[WINDOWS_NAME[Vers],
        dwMajorVersion,dwMinorVersion,dwBuildNumber],OSVersionText) else
      FormatUTF8('Windows % SP% (%.%.%)',[WINDOWS_NAME[Vers],wServicePackMajor,
        dwMajorVersion,dwMinorVersion,dwBuildNumber],OSVersionText);
  OSVersionInt32 := (integer(Vers) shl 8)+ord(osWindows);
  {$ifndef LVCL}
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKeyReadOnly('\Hardware\Description\System\CentralProcessor\0') then begin
      cpu := ReadString('ProcessorNameString');
      if cpu='' then
        cpu := ReadString('Identifier');
    end;
    if OpenKeyReadOnly('\Hardware\Description\System\BIOS') then begin
      manuf := SysUtils.Trim(ReadString('SystemManufacturer'));
      if manuf<>'' then
        manuf := manuf+' ';
      prod := SysUtils.Trim(ReadString('SystemProductName'));
      prodver := SysUtils.Trim(ReadString('SystemVersion'));
      if prodver='' then
        prodver := SysUtils.Trim(ReadString('BIOSVersion'));
      if prodver<>'' then
        FormatUTF8('%% %',[manuf,prod,prodver],BiosInfoText) else
        FormatUTF8('%%',[manuf,prod],BiosInfoText);
    end;
  finally
    Free;
  end;
  {$endif}
  if cpu='' then
    cpu := GetEnvironmentVariable('PROCESSOR_IDENTIFIER');
  cpu := SysUtils.Trim(cpu);
  FormatUTF8('% x % ('+CPU_ARCH_TEXT+')',[SystemInfo.dwNumberOfProcessors,cpu],CpuInfoText);
end;

{$else}

{$ifndef BSD}
procedure SetLinuxDistrib(const release: RawUTF8);
var
  distrib: TOperatingSystem;
  dist: RawUTF8;
begin
  for distrib := osArch to high(distrib) do begin
    dist := UpperCase(TrimLeftLowerCaseShort(ToText(distrib)));
    if PosI(pointer(dist),release)>0 then begin
      OS_KIND := distrib;
      break;
    end;
  end;
end;
{$endif BSD}

procedure RetrieveSystemInfo;
var modname, beg: PUTF8Char;
    {$ifdef BSD}
    temp: shortstring;
    {$else}
    cpuinfo: PUTF8Char;
    proccpuinfo,prod,prodver,release,dist: RawUTF8;
    SR: TSearchRec;
    {$endif BSD}
begin
  modname := nil;
  {$ifdef BSD}
  fpuname(SystemInfo.uts);
  SystemInfo.dwNumberOfProcessors := fpsysctlhwint(HW_NCPU);
  Utf8ToRawUTF8(fpsysctlhwstr(HW_MACHINE,temp),BiosInfoText);
  modname := fpsysctlhwstr(HW_MODEL,temp);
  with SystemInfo.uts do
    FormatUTF8('%-% %',[sysname,release,version],OSVersionText);
  {$else}
  {$ifdef KYLIX3}
  uname(SystemInfo.uts);
  {$else}
  fpuname(SystemInfo.uts);
  {$endif KYLIX3}
  prod := Trim(StringFromFile('/sys/class/dmi/id/product_name',true));
  if prod<>'' then begin
    prodver := Trim(StringFromFile('/sys/class/dmi/id/product_version',true));
    if prodver<>'' then
      FormatUTF8('% %',[prod,prodver],BiosInfoText) else
      BiosInfoText := prod;
  end;
  SystemInfo.dwNumberOfProcessors := 0;
  proccpuinfo := StringFromFile('/proc/cpuinfo',true);
  cpuinfo := pointer(proccpuinfo);
  while cpuinfo<>nil do begin
    beg := cpuinfo;
    cpuinfo := GotoNextLine(cpuinfo);
    if IdemPChar(beg,'PROCESSOR') then
      if beg^='P' then
        modname := beg else // Processor : ARMv7
        inc(SystemInfo.dwNumberOfProcessors) else // processor : 0
    if IdemPChar(beg,'MODEL NAME') then
      modname := beg;
  end;
  modname := PosChar(modname,':');
  if modname<>nil then
    modname := GotoNextNotSpace(modname+1);
  release := trim(FindIniNameValue(pointer(StringFromFile('/etc/os-release')),'PRETTY_NAME='));
  if (release<>'') and (release[1]='"') then
    release := copy(release,2,length(release)-2);
  release := trim(release);
  if release='' then begin
    release := trim(FindIniNameValue(pointer(StringFromFile('/etc/lsb-release')),'DISTRIB_DESCRIPTION='));
    if (release<>'') and (release[1]='"') then
      release := copy(release,2,length(release)-2);
  end;
  if (release='') and (FindFirst('/etc/*-release',faAnyFile,SR)=0) then begin
    release := StringToUTF8(SR.Name); // 'redhat-release' 'SuSE-release'
    if IdemPChar(pointer(release),'LSB-') and (FindNext(SR)=0) then
       release := StringToUTF8(SR.Name);
    release := split(release,'-');
    dist := split(trim(StringFromFile('/etc/'+SR.Name)),#10);
    if (dist<>'') and (PosExChar('=',dist)=0) and (PosExChar(' ',dist)>0) then
      SetLinuxDistrib(dist) // e.g. 'Red Hat Enterprise Linux Server release 6.7 (Santiago)'
    else
      dist := '';
    FindClose(SR);
  end;
  if (release<>'') and (OS_KIND=osLinux) then begin
    SetLinuxDistrib(release);
    if (OS_KIND=osLinux) and (dist<>'') then begin
      SetLinuxDistrib(dist);
      release := dist;
    end;
    if (OS_KIND=osLinux) and ((PosEx('RH',release)>0) or (PosEx('Red Hat',release)>0)) then
      OS_KIND := osRedHat;
  end;
  SystemInfo.release := release;
  {$endif BSD}
  OSVersionInt32 := {$ifdef FPC}integer(KernelRevision shl 8)+{$endif}ord(OS_KIND);
  with SystemInfo.uts do
    FormatUTF8('% %',[sysname,release],OSVersionText);
  if SystemInfo.release<>'' then
    OSVersionText := FormatUTF8('% - %',[SystemInfo.release,OSVersionText]);
  if (SystemInfo.dwNumberOfProcessors>0) and (modname<>nil) then begin
    beg := modname;
    while not (ord(modname^) in [0,10,13]) do begin
      if modname^<' ' then
        modname^ := ' ';
      inc(modname);
    end;
    modname^ := #0;
    FormatUTF8('% x % ('+CPU_ARCH_TEXT+')',[SystemInfo.dwNumberOfProcessors,beg],CpuInfoText);
  end;
end;

{$ifdef KYLIX3}
function FileOpen(const FileName: string; Mode: LongWord): Integer;
const
  SHAREMODE: array[0..fmShareDenyNone shr 4] of Byte = (
    0,        // No share mode specified
    F_WRLCK,  // fmShareExclusive
    F_RDLCK,  // fmShareDenyWrite
    0);       // fmShareDenyNone
var FileHandle, Tvar: Integer;
    LockVar: TFlock;
    smode: Byte;
begin
  result := -1;
  if FileExists(FileName) and
     ((Mode and 3)<=fmOpenReadWrite) and ((Mode and $F0)<=fmShareDenyNone) then begin
    FileHandle := open64(pointer(FileName),(Mode and 3),FileAccessRights);
    if FileHandle=-1 then
      exit;
    smode := Mode and $F0 shr 4;
    if SHAREMODE[smode]<>0 then begin
      with LockVar do begin
        l_whence := SEEK_SET;
        l_start := 0;
        l_len := 0;
        l_type := SHAREMODE[smode];
      end;
      Tvar := fcntl(FileHandle,F_SETLK,LockVar);
      if Tvar=-1 then begin
        __close(FileHandle);
        exit;
      end;
    end;
    result := FileHandle;
  end;
end;

function GetTickCount64: Int64;
begin
  result := SynKylix.GetTickCount64;
end;
{$endif KYLIX3}

{$ifdef FPC}
function GetTickCount64: Int64;
begin
  result := SynFPCLinux.GetTickCount64;
end;
{$endif}

{$endif MSWINDOWS}

function FileOpenSequentialRead(const FileName: string): Integer;
begin
  {$ifdef MSWINDOWS}
  result := CreateFile(pointer(FileName),GENERIC_READ,
    FILE_SHARE_READ or FILE_SHARE_WRITE,nil, // same as fmShareDenyNone
    OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,0);
  {$else}
  result := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  {$endif MSWINDOWS}
end;

function FileStreamSequentialRead(const FileName: string): TFileStream;
begin
  {$ifdef DELPHI5ORFPC}
  result := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
  {$else}
  result := TFileStream.Create(FileOpenSequentialRead(FileName));
  {$endif}
end;

function Elapsed(var PreviousTix: Int64; Interval: Integer): Boolean;
var now: Int64;
begin
  if Interval<=0 then
    result := false else begin
    now := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64;
    if now-PreviousTix>Interval then begin
      PreviousTix := now;
      result := true;
    end else
      result := false;
  end;
end;

{$ifndef FPC} // FPC has its built-in InterlockedIncrement/InterlockedDecrement
{$ifdef PUREPASCAL}
function InterlockedIncrement(var I: Integer): Integer;
begin
  {$ifdef MSWINDOWS} // AtomicIncrement() may not be available e.g. on Delphi XE2
  result := Windows.InterlockedIncrement(I);
  {$else}
  result := AtomicIncrement(I);
  {$endif}
end;

function InterlockedDecrement(var I: Integer): Integer;
begin
  {$ifdef MSWINDOWS} // AtomicDecrement() may not be available e.g. on Delphi XE2
  result := Windows.InterlockedDecrement(I);
  {$else}
  result := AtomicDecrement(I);
  {$endif}
end;
{$else}
function InterlockedIncrement(var I: Integer): Integer;
asm
        mov     edx, 1
        xchg    eax, edx
   lock xadd    [edx], eax
        inc     eax
end;
function InterlockedDecrement(var I: Integer): Integer;
asm
        mov     edx, -1
        xchg    eax, edx
   lock xadd    [edx], eax
        dec     eax
end;
{$endif}
{$endif FPC}

procedure SoundExComputeAnsi(var p: PAnsiChar; var result: cardinal; Values: PSoundExValues);
var n,v,old: PtrUInt;
begin
  n := 0;
  old := 0;
  if Values<>nil then
  repeat
    {$ifdef USENORMTOUPPER}
    v := NormToUpperByte[ord(p^)]; // also handle 8 bit WinAnsi (1252 accents)
    {$else}
    v := NormToUpperAnsi7Byte[ord(p^)]; // 7 bit char uppercase
    {$endif}
    if not (v in IsWord) then break;
    inc(p);
    dec(v,ord('B'));
    if v>high(TSoundExValues) then continue;
    v := Values[v]; // get soundex value
    if (v=0) or (v=old) then continue; // invalid or dopple value
    old := v;
    result := result shl SOUNDEX_BITS;
    inc(result,v);
    inc(n);
    if n=((32-8)div SOUNDEX_BITS) then // first char use up to 8 bits
      break; // result up to a cardinal size
  until false;
end;

function SoundExComputeFirstCharAnsi(var p: PAnsiChar): cardinal;
label Err;
begin
  if p=nil then begin
Err:result := 0;
    exit;
  end;
  repeat
    {$ifdef USENORMTOUPPER}
    result := NormToUpperByte[ord(p^)]; // also handle 8 bit WinAnsi (CP 1252)
    {$else}
    result := NormToUpperAnsi7Byte[ord(p^)]; // 7 bit char uppercase
    {$endif}
    if result=0 then
      goto Err; // end of input text, without a word
    inc(p);
    // trim initial spaces or 'H'
  until AnsiChar(result) in ['A'..'G','I'..'Z'];
end;

function GetHighUTF8UCS4(var U: PUTF8Char): PtrUInt;
var extra,i: PtrInt;
    c: PtrUInt;
begin
  result := 0;
  c := byte(U^); // here U^>=#80
  inc(U);
  extra := UTF8_EXTRABYTES[c];
  if extra=0 then exit else // invalid leading byte
  for i := 1 to extra do begin
    if byte(U^) and $c0<>$80 then
      exit; // invalid input content
    c := c shl 6+byte(U^);
    inc(U);
  end;
  with UTF8_EXTRA[extra] do begin
    dec(c,offset);
    if c<minimum then
      exit; // invalid input content
  end;
  result := c;
end;

function GetHighUTF8UCS4Inlined(var U: PUTF8Char): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}
var extra,i: PtrInt;
    c: PtrUInt;
begin
  result := 0;
  c := byte(U^); // here U^>=#80
  inc(U);
  extra := UTF8_EXTRABYTES[c];
  if extra=0 then exit else // invalid leading byte
  for i := 1 to extra do begin
    if byte(U^) and $c0<>$80 then
      exit; // invalid input content
    c := c shl 6+byte(U^);
    inc(U);
  end;
  with UTF8_EXTRA[extra] do begin
    dec(c,offset);
    if c<minimum then
      exit; // invalid input content
  end;
  result := c;
end;

function GetNextUTF8Upper(var U: PUTF8Char): PtrUInt;
begin
  result := ord(U^);
  if result=0 then
    exit;
  if result<=127 then begin
    inc(U);
    {$ifdef USENORMTOUPPER}
    result := NormToUpperByte[result];
    {$else}
    result := NormToUpperAnsi7Byte[result];
    {$endif}
    exit;
  end;
  result := GetHighUTF8UCS4(U);
  if (result<=255) and (WinAnsiConvert.AnsiToWide[result]<=255) then
    {$ifdef USENORMTOUPPER}
    result := NormToUpperByte[result];
    {$else}
    result := NormToUpperAnsi7Byte[result];
    {$endif}
end;

procedure SoundExComputeUTF8(var U: PUTF8Char; var result: cardinal; Values: PSoundExValues);
var n,v,old: cardinal;
begin
  n := 0;
  old := 0;
  if Values<>nil then
  repeat
    v := GetNextUTF8Upper(U);
    if not (v in IsWord) then break;
    dec(v,ord('B'));
    if v>high(TSoundExValues) then continue;
    v := Values[v]; // get soundex value
    if (v=0) or (v=old) then continue; // invalid or dopple value
    old := v;
    result := result shl SOUNDEX_BITS;
    inc(result,v);
    inc(n);
    if n=((32-8)div SOUNDEX_BITS) then // first char use up to 8 bits
      break; // result up to a cardinal size
  until false;
end;

function SoundExComputeFirstCharUTF8(var U: PUTF8Char): cardinal;
label Err;
begin
  if U=nil then begin
Err:result := 0;
    exit;
  end;
  repeat
    result := GetNextUTF8Upper(U);
    if result=0 then
      goto Err; // end of input text, without a word
    // trim initial spaces or 'H'
  until AnsiChar(result) in ['A'..'G','I'..'Z'];
end;

function FindNextUTF8WordBegin(U: PUTF8Char): PUTF8Char;
var c: cardinal;
    V: PUTF8Char;
begin
  result := nil;
  repeat
    c := GetNextUTF8Upper(U);
    if c=0 then
      exit;
  until not(c in IsWord);
  repeat
    V := U;
    c := GetNextUTF8Upper(U);
    if c=0 then
      exit;
  until c in IsWord;
  result := V;
end;


{ TSynSoundEx }

const
  /// english Soundex pronunciation scores
  // - defines the default values used for the SoundEx() function below
  // (used if Values parameter is nil)
  ValueEnglish: TSoundExValues =
  // B C D E F G H I J K L M N O P Q R S T U V W X Y Z
    (1,2,3,0,1,2,0,0,2,2,4,5,5,0,1,2,6,2,3,0,1,0,2,0,2);

  /// french Soundex pronunciation scores
  // - can be used to override default values used for the SoundEx()
  // function below
  ValueFrench: TSoundExValues =
  // B C D E F G H I J K L M N O P Q R S T U V W X Y Z
    (1,2,3,0,9,7,0,0,7,2,4,5,5,0,1,2,6,8,3,0,9,0,8,0,8);

  /// spanish Soundex pronunciation scores
  // - can be used to override default values used for the SoundEx()
  // function below
  ValueSpanish: TSoundExValues =
  // B C D E F G H I J K L M N O P Q R S T U V W X Y Z
    (1,2,3,0,1,2,0,0,0,2,0,5,5,0,1,2,6,2,3,0,1,0,2,0,2);

  SOUNDEXVALUES: array[TSynSoundExPronunciation] of PSoundExValues =
    (@ValueEnglish,@ValueFrench,@ValueSpanish,@ValueEnglish);

function TSynSoundEx.Ansi(A: PAnsiChar): boolean;
var Value, c: cardinal;
begin
  result := false;
  if A=nil then exit;
  repeat
    // test beginning of word
    c := SoundExComputeFirstCharAnsi(A);
    if c=0 then exit else
    if c=FirstChar then begin
      // here we had the first char match -> check if word match UpperValue
      Value := c-(ord('A')-1);
      SoundExComputeAnsi(A,Value,fValues);
      if Value=search then begin
        result := true; // UpperValue found!
        exit;
      end;
    end else
    repeat
      if A^=#0 then exit else
{$ifdef USENORMTOUPPER}
        if not(NormToUpperByte[ord(A^)] in IsWord) then break else inc(A);
{$else} if not(ord(A^) in IsWord) then break else inc(A); {$endif}
    until false;
    // find beginning of next word
    repeat
      if A^=#0 then exit else
{$ifdef USENORMTOUPPER}
        if NormToUpperByte[ord(A^)] in IsWord then break else inc(A);
{$else} if ord(A^) in IsWord then break else inc(A); {$endif}
    until false;
  until false;
end;

function TSynSoundEx.UTF8(U: PUTF8Char): boolean;
var Value, c: cardinal;
    V: PUTF8Char;
begin
  result := false;
  if U=nil then exit;
  repeat
    // find beginning of word
    c := SoundExComputeFirstCharUTF8(U);
    if c=0 then exit else
    if c=FirstChar then begin
      // here we had the first char match -> check if word match UpperValue
      Value := c-(ord('A')-1);
      SoundExComputeUTF8(U,Value,fValues);
      if Value=search then begin
        result := true; // UpperValue found!
        exit;
      end;
    end else
    repeat
      c := GetNextUTF8Upper(U);
      if c=0 then
        exit;
    until not(c in IsWord);
    // find beginning of next word
    repeat
      if U=nil then exit;
      V := U;
      c := GetNextUTF8Upper(U);
      if c=0 then
        exit;
    until c in IsWord;
    U := V;
  until U=nil;
end;

function TSynSoundEx.Prepare(UpperValue: PAnsiChar; Lang: PSoundExValues): boolean;
begin
  fValues := Lang;
  Search := SoundExAnsi(UpperValue,nil,Lang);
  if Search=0 then
    result := false else begin
    FirstChar := SoundExComputeFirstCharAnsi(UpperValue);
    result := true;
  end;
end;

function TSynSoundEx.Prepare(UpperValue: PAnsiChar; Lang: TSynSoundExPronunciation): boolean;
begin
  result := Prepare(UpperValue,SOUNDEXVALUES[Lang]);
end;

function SoundExAnsi(A: PAnsiChar; next: PPAnsiChar;
  Lang: PSoundExValues): cardinal;
begin
  result := SoundExComputeFirstCharAnsi(A);
  if result<>0 then begin
    dec(result,ord('A')-1);   // first Soundex char is first char
    SoundExComputeAnsi(A,result,Lang);
  end;
  if next<>nil then begin
    {$ifdef USENORMTOUPPER}
    while NormToUpperByte[ord(A^)] in IsWord do inc(A); // go to end of word
    {$else}
    while ord(A^) in IsWord do inc(A); // go to end of word
    {$endif}
    next^ := A;
  end;
end;

function SoundExAnsi(A: PAnsiChar; next: PPAnsiChar;
  Lang: TSynSoundExPronunciation): cardinal;
begin
  result := SoundExAnsi(A,next,SOUNDEXVALUES[Lang]);
end;

function SoundExUTF8(U: PUTF8Char; next: PPUTF8Char;
  Lang: TSynSoundExPronunciation): cardinal;
begin
  result := SoundExComputeFirstCharUTF8(U);
  if result<>0 then begin
    dec(result,ord('A')-1);   // first Soundex char is first char
    SoundExComputeUTF8(U,result,SOUNDEXVALUES[Lang]);
  end;
  if next<>nil then
    next^ := FindNextUTF8WordBegin(U);
end;

{$ifdef USENORMTOUPPER}

function AnsiICompW(u1, u2: PWideChar): PtrInt; {$ifdef HASINLINE}inline;{$endif}
begin
  if u1<>u2 then
    if u1<>nil then
      if u2<>nil then
        repeat
          result := PtrInt(u1^)-PtrInt(u2^);
          if result<>0 then begin
            if (PtrInt(u1^)>255) or (PtrInt(u2^)>255) then exit;
            result := NormToUpperAnsi7Byte[PtrInt(u1^)]-NormToUpperAnsi7Byte[PtrInt(u2^)];
            if result<>0 then exit;
          end;
          if (u1^=#0) or (u2^=#0) then break;
          inc(u1);
          inc(u2);
        until false else
        result := 1 else  // u2=''
      result := -1 else // u1=''
    result := 0;      // u1=u2
end;


{$ifdef PUREPASCAL}
function AnsiIComp(Str1, Str2: PWinAnsiChar): PtrInt;
var table: PNormTableByte;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    table := @NormToUpperByte;
    repeat
      result := table[ord(Str1^)]-table[pByte(Str2)^];
      if result<>0 then exit;
      if (Str1^=#0) or (Str2^=#0) then break;
      inc(Str1);
      inc(Str2);
    until false;
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;
{$else}
function AnsiIComp(Str1, Str2: PWinAnsiChar): PtrInt;
asm // fast 8 bits WinAnsi comparaison using the NormToUpper[] array
        cmp     eax, edx
        je      @2
        test    eax, edx // is either of the strings perhaps nil?
        jz      @3
@0:     push    ebx // compare the first character (faster quicksort)
        movzx   ebx, byte ptr[eax] // ebx=S1[1]
        movzx   ecx, byte ptr[edx] // ecx=S2[1]
        test    ebx, ebx
        jz      @z
        cmp     ebx, ecx
        je      @s
        mov     bl, byte ptr[NormToUpper + ebx]
        mov     cl, byte ptr[NormToUpper + ecx]
        cmp     ebx, ecx
        je      @s
        mov     eax, ebx
        pop     ebx
        sub     eax, ecx // return S1[1]-S2[1]
        ret
@2b:    pop     ebx
@2:     xor     eax, eax
        ret
@3:     test    eax, eax // S1=''
        jz      @4
        test    edx, edx // S2='' ?
        jnz     @0
        mov     eax, 1 // return 1 (S1>S2)
        ret
@s:     inc     eax
        inc     edx
        mov     bl, [eax] // ebx=S1[i]
        mov     cl, [edx] // ecx=S2[i]
        test    ebx, ebx
        je      @z        // end of S1
        cmp     ebx, ecx
        je      @s
        mov     bl, byte ptr[NormToUpper + ebx]
        mov     cl, byte ptr[NormToUpper + ecx]
        cmp     ebx, ecx
        je      @s
        mov     eax, ebx
        pop     ebx
        sub     eax, ecx // return S1[i]-S2[i]
        ret
@z:     cmp     ebx, ecx // S1=S2?
        jz      @2b
        pop     ebx
@4:     or      eax, -1 // return -1 (S1<S2)
end;
{$endif PUREPASCAL}

function ConvertCaseUTF8(P: PUTF8Char; const Table: TNormTableByte): PtrInt;
var D,S: PUTF8Char;
    c: PtrUInt;
    extra,i: integer;
begin
  result := 0;
  if P=nil then
    exit;
  D := P;
  repeat
    c := byte(P[0]);
    inc(P);
    if c=0 then
      break;
    if c<=127 then begin
      D[result] := AnsiChar(Table[c]);
      inc(result);
    end else begin
      extra := UTF8_EXTRABYTES[c];
      if extra=0 then exit else // invalid leading byte
      for i := 0 to extra-1 do
        if byte(P[i]) and $c0<>$80 then
          exit else // invalid input content
          c := c shl 6+byte(P[i]);
      with UTF8_EXTRA[extra] do begin
        dec(c,offset);
        if c<minimum then
          exit; // invalid input content
      end;
      if (c<=255) and (Table[c]<=127) then begin
        D[result] := AnsiChar(Table[c]);
        inc(result);
        inc(P,extra);
        continue;
      end;
      S := P-1;
      inc(P,extra);
      inc(extra);
      {$ifdef FPC}Move{$else}MoveFast{$endif}(S^,D[result],extra);
      inc(result,extra);
    end;
  until false;
end;

function UpperCaseU(const S: RawUTF8): RawUTF8;
var LS,LD: integer;
begin
  LS := length(S);
  FastSetString(result,pointer(S),LS);
  LD := ConvertCaseUTF8(pointer(result),NormToUpperByte);
  if LS<>LD then
    SetLength(result,LD);
end;

function LowerCaseU(const S: RawUTF8): RawUTF8;
var LS,LD: integer;
begin
  LS := length(S);
  FastSetString(result,pointer(S),LS);
  LD := ConvertCaseUTF8(pointer(result),NormToLowerByte);
  if LS<>LD then
    SetLength(result,LD);
end;

function UTF8IComp(u1, u2: PUTF8Char): PtrInt;
var c2: PtrInt;
    table: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperByte{$else}PNormTableByte{$endif};
begin // fast UTF-8 comparaison using the NormToUpper[] array for all 8 bits values
  {$ifndef CPUX86NOTPIC}table := @NormToUpperByte;{$endif}
  if u1<>u2 then
  if u1<>nil then
  if u2<>nil then
  repeat
    result := ord(u1^);
    c2 := ord(u2^);
    if result<=127 then
      if result<>0 then begin
        inc(u1);
        result := table[result];
        if c2<=127 then begin
          if c2=0 then exit; // u1>u2 -> return u1^
          inc(u2);
          dec(result,table[c2]);
          if result<>0 then exit;
          continue;
        end;
      end else begin // u1^=#0 -> end of u1 reached
        if c2<>0 then    // end of u2 reached -> u1=u2 -> return 0
          result := -1;    // u1<u2
        exit;
      end else begin
        result := GetHighUTF8UCS4Inlined(u1);
        if result and $ffffff00=0 then
          result := table[result]; // 8 bits to upper, 32-bit as is
      end;
    if c2<=127 then begin
      if c2=0 then exit; // u1>u2 -> return u1^
      inc(u2);
      dec(result,table[c2]);
      if result<>0 then exit;
      continue;
    end else begin
      c2 := GetHighUTF8UCS4Inlined(u2);
      if c2<=255 then
        dec(result,table[c2]) else // 8 bits to upper
        dec(result,c2); // 32-bit widechar returns diff
      if result<>0 then exit;
    end;
  until false else
  result := 1 else  // u2=''
  result := -1 else // u1=''
  result := 0;      // u1=u2
end;

function UTF8ILComp(u1, u2: PUTF8Char; L1,L2: cardinal): PtrInt;
var c2: PtrInt;
    extra,i: integer;
    table: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperByte{$else}PNormTableByte{$endif};
label neg,pos;
begin // fast UTF-8 comparaison using the NormToUpper[] array for all 8 bits values
  {$ifndef CPUX86NOTPIC}table := @NormToUpperByte;{$endif}
  if u1<>u2 then
  if (u1<>nil) and (L1<>0) then
  if (u2<>nil) and (L2<>0) then
  repeat
    result := ord(u1^);
    c2 := ord(u2^);
    inc(u1);
    dec(L1);
    if result<=127 then begin
      result := table[result];
      if c2<=127 then begin
        dec(result,table[c2]);
        dec(L2);
        inc(u2);
        if result<>0 then
           exit else
        if L1<>0 then
          if L2<>0 then
            continue else // L1>0 and L2>0 -> next char
            goto pos else // L1>0 and L2=0 -> u1>u2
          if L2<>0 then
            goto neg else // L1=0 and L2>0 -> u1<u2
            exit;         // L1=0 and L2=0 -> u1=u2
      end;
    end else begin
      extra := UTF8_EXTRABYTES[result];
      if extra=0 then goto neg; // invalid leading byte
      dec(L1,extra);
      if Integer(L1)<0 then goto neg;
      for i := 0 to extra-1 do
        result := result shl 6+PByteArray(u1)[i];
      dec(result,UTF8_EXTRA[extra].offset);
      inc(u1,extra);
      if result and $ffffff00=0 then
        result := table[result]; // 8 bits to upper, 32-bit as is
    end;
    // here result=NormToUpper[u1^]
    inc(u2);
    dec(L2);
    if c2<=127 then begin
      dec(result,table[c2]);
      if result<>0 then exit;
    end else begin
      extra := UTF8_EXTRABYTES[c2];
      if extra=0 then goto pos;
      dec(L2,extra);
      if integer(L2)<0 then goto pos;
      for i := 0 to extra-1 do
        c2 := c2 shl 6+PByteArray(u2)[i];
      dec(c2,UTF8_EXTRA[extra].offset);
      inc(u2,extra);
      if c2 and $ffffff00=0 then
        dec(result,table[c2]) else // 8 bits to upper
        dec(result,c2); // returns 32-bit diff
      if result<>0 then exit;
    end;
    // here we have result=NormToUpper[u2^]-NormToUpper[u1^]=0
    if L1=0 then // test if we reached end of u1 or end of u2
      if L2=0 then exit     // u1=u2
         else goto neg else // u1<u2
    if L2=0 then goto pos;  // u1>u2
  until false else
pos: result := 1 else  // u2='' or u1>u2
neg: result := -1 else // u1='' or u1<u2
     result := 0;      // u1=u2
end;

function SameTextU(const S1, S2: RawUTF8): Boolean;
// checking UTF-8 lengths is not accurate: surrogates may be confusing
begin
  result := UTF8IComp(pointer(S1),pointer(S2))=0;
end;

{$else} // no NormToUpper[]

function AnsiIComp(Str1, Str2: PWinAnsiChar): integer;
{$ifdef PUREPASCAL}
begin
  result := StrIComp(Str1,Str2); // fast enough, especially since inlined
end;
{$else}
asm
  jmp StrIComp // LVCL without NormToUpper[]: use default SysUtils implementation
end;
{$endif}
{$endif}

function FindAnsi(A, UpperValue: PAnsiChar): boolean;
var ValueStart: PAnsiChar;
{$ifndef USENORMTOUPPER}
    ch: AnsiChar;
{$endif}
begin
  result := false;
  if (A=nil) or (UpperValue=nil) then exit;
  ValueStart := UpperValue;
  repeat
    // test beginning of word
    repeat
      if A^=#0 then exit else
{$ifdef USENORMTOUPPER}
      if byte(NormToUpper[A^]) in IsWord then break else inc(A);  {$else}
      if byte(NormToUpperAnsi7[A^]) in IsWord then break else inc(A);
{$endif}
    until false;
    // check if this word is the UpperValue
    UpperValue := ValueStart;
    repeat
{$ifdef USENORMTOUPPER}
      if NormToUpper[A^]<>UpperValue^ then break;  {$else}
      if NormToUpperAnsi7[A^]<>UpperValue^ then break;
{$endif}
      inc(UpperValue);
      if UpperValue^=#0 then begin
        result := true; // UpperValue found!
        exit;
      end;
      inc(A);
      if A^=#0 then exit;
    until false;
    // find beginning of next word
    repeat
      if A^=#0 then exit else
{$ifdef USENORMTOUPPER}
        if not (NormToUpperByte[ord(A^)] in IsWord) then break else inc(A);
{$else} if not (ord(A^) in IsWord) then break else inc(A); {$endif}
    until false;
  until false;
end;

function FindUnicode(PW, Upper: PWideChar; UpperLen: integer): boolean;
var Start: PWideChar;
begin
  result := false;
  if (PW=nil) or (Upper=nil) then exit;
  repeat
    // go to beginning of next word
    repeat
      if ord(PW^)=0 then exit else
      if (ord(PW^)>126) or (ord(PW^) in IsWord) then
        Break;
      inc(PW);
    until false;
    Start := PW;
    // search end of word matching UpperLen characters
    repeat
      inc(PW);
    until (PW-Start>=UpperLen) or
      (ord(PW^)=0) or ((ord(PW^)<126) and (not(ord(PW^) in IsWord)));
    if PW-Start>=UpperLen then
      if CompareStringW(LOCALE_USER_DEFAULT,NORM_IGNORECASE,Start,UpperLen,Upper,UpperLen)=2 then begin
        result := true; // match found
        exit;
      end;
    // not found: go to end of current word
    repeat
      if PW^=#0 then exit else
      if ((ord(PW^)<126) and (not(ord(PW^) in IsWord))) then Break;
      inc(PW);
    until false;
  until false;
end;

function FindUTF8(U: PUTF8Char; UpperValue: PAnsiChar): boolean;
var ValueStart: PAnsiChar;
{$ifdef USENORMTOUPPER}
    c: PtrUInt;
    FirstChar: AnsiChar;
label Next;
{$else}
    ch: AnsiChar;
{$endif}
begin
  result := false;
  if (U=nil) or (UpperValue=nil) then exit;
{$ifdef USENORMTOUPPER}
  // handles 8-bits WinAnsi chars inside UTF-8 encoded data
  FirstChar := UpperValue^;
  ValueStart := UpperValue+1;
  repeat
    // test beginning of word
    repeat
      c := byte(U^);
      inc(U);
      if c=0 then exit else
      if c<=127 then begin
        if c in IsWord then
          if PAnsiChar(@NormToUpper)[c]<>FirstChar then
            goto Next else
            break;
      end else
      if c and $20=0 then begin // fast direct process $0..$7ff
        c := c shl 6+byte(U^)-$3080;
        inc(U);
        if c<=255 then begin
          c := NormToUpperByte[c];
          if c in IsWord then
            if AnsiChar(c)<>FirstChar then
              goto Next else
              break;
        end;
      end else
        if UTF8_EXTRABYTES[c]=0 then
          exit else // invalid leading byte
          inc(U,UTF8_EXTRABYTES[c]); // just ignore surrogates for soundex
    until false;
    // here we had the first char match -> check if this word match UpperValue
    UpperValue := ValueStart;
    repeat
      if UpperValue^=#0 then begin
        result := true; // UpperValue found!
        exit;
      end;
      c := byte(U^); inc(U); // next chars
      if c=0 then exit else
      if c<=127 then begin
        if PAnsiChar(@NormToUpper)[c]<>UpperValue^ then break;
      end else
      if c and $20=0 then begin
        c := c shl 6+byte(U^)-$3080;
        inc(U);
        if (c>255) or (PAnsiChar(@NormToUpper)[c]<>UpperValue^) then break;
      end else begin
        if UTF8_EXTRABYTES[c]=0 then
          exit else // invalid leading byte
          inc(U,UTF8_EXTRABYTES[c]);
        break;
      end;
      inc(UpperValue);
    until false;
Next: // find beginning of next word
    U := FindNextUTF8WordBegin(U);
  until U=nil;
{$else}
  // this tiny version only handles 7-bits ansi chars and ignore all UTF-8 chars
  ValueStart := UpperValue;
  repeat
    // find beginning of word
    repeat
      if byte(U^)=0 then exit else
      if byte(U^)<=127 then
        if byte(U^) in IsWord then
          break else
          inc(U) else
      if byte(U^) and $20=0 then
        inc(U,2) else
        inc(U,3);
    until false;
    // check if this word is the UpperValue
    UpperValue := ValueStart;
    repeat
      ch := NormToUpperAnsi7[U^];
      if ch<>UpperValue^ then break;
      inc(UpperValue);
      if UpperValue^=#0 then begin
        result := true; // UpperValue found!
        exit;
      end;
      inc(U);
      if byte(U^)=0 then exit else
      if byte(U^) and $80<>0 then break; // 7 bits char check only
    until false;
    // find beginning of next word
    U := FindNextUTF8WordBegin(U);
  until U=nil;
{$endif}
end;

function HexDisplayToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: integer): boolean;
var B,C: PtrUInt;
    i: integer;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
begin
  result := false; // return false if any invalid char
  if (Hex=nil) or (Bin=nil) then
    exit;
  {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
  inc(Bin,BinBytes-1);
  for i := 1 to BinBytes do begin
    B := tab[Ord(Hex^)];
    inc(Hex);
    if B>15 then exit;
    B := B shl 4;
    C := tab[Ord(Hex^)];
    inc(Hex);
    if C>15 then exit;
    Bin^ := B+C;
    dec(Bin);
  end;
  result := true; // correct content in Hex
end;

function HexDisplayToCardinal(Hex: PAnsiChar; out aValue: cardinal): boolean;
begin
  result := HexDisplayToBin(Hex,@aValue,SizeOf(aValue));
  if not result then
   aValue := 0;
end;

function HexDisplayToInt64(Hex: PAnsiChar; out aValue: Int64): boolean;
begin
  result := HexDisplayToBin(Hex,@aValue,SizeOf(aValue));
  if not result then
   aValue := 0;
end;

function HexDisplayToInt64(const Hex: RawByteString): Int64;
begin
  if not HexDisplayToBin(pointer(Hex),@result,SizeOf(result)) then
    result := 0;
end;

function HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean;
var I: Integer;
    B,C: PtrUInt;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
begin
  result := false; // return false if any invalid char
  if Hex=nil then
    exit;
  {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
  if Bin<>nil then
    for I := 1 to BinBytes do begin
      B := tab[Ord(Hex^)];
      inc(Hex);
      if B>15 then exit;
      B := B shl 4;
      C := tab[Ord(Hex^)];
      inc(Hex);
      if C>15 then exit;
      Bin^ := B+C;
      inc(Bin);
    end else
    for I := 1 to BinBytes do begin // Bin=nil -> validate Hex^ input
      B := tab[Ord(Hex^)];
      inc(Hex);
      if B>15 then exit;
      C := tab[Ord(Hex^)];
      inc(Hex);
      if C>15 then exit;
    end;
  result := true; // conversion OK
end;

function IsHex(const Hex: RawByteString; BinBytes: integer): boolean;
begin
  result := (length(Hex)=BinBytes*2) and SynCommons.HexToBin(pointer(Hex),nil,BinBytes);
end;

function HexToCharValid(Hex: PAnsiChar): boolean;
begin
  result := (ConvertHexToBin[Ord(Hex[0])]<=15) and
            (ConvertHexToBin[Ord(Hex[1])]<=15);
end;

function HexToChar(Hex: PAnsiChar; Bin: PUTF8Char): boolean;
var B,C: PtrUInt;
begin
  if Hex<>nil then begin
    B := ConvertHexToBin[Ord(Hex[0])];
    if B<=15 then begin
      C := ConvertHexToBin[Ord(Hex[1])];
      if C<=15 then begin
        if Bin<>nil then
          Bin^ := AnsiChar(B shl 4+C);
        result := true;
        exit;
      end;
    end;
  end;
  result := false; // return false if any invalid char
end;

function HexToWideChar(Hex: PAnsiChar): cardinal;
var B: PtrUInt;
begin
  result := ConvertHexToBin[Ord(Hex[0])];
  if result<=15 then begin
    B := ConvertHexToBin[Ord(Hex[1])];
    if B<=15 then begin
      result := result shl 4+B;
      B := ConvertHexToBin[Ord(Hex[2])];
      if B<=15 then begin
        result := result shl 4+B;
        B := ConvertHexToBin[Ord(Hex[3])];
        if B<=15 then begin
          result := result shl 4+B;
          exit;
        end;
      end;
    end;
  end;
  result := 0;
end;

{ --------- Base64 encoding/decoding }

type
  TBase64Enc = array[0..63] of AnsiChar;
  TBase64Dec = array[AnsiChar] of shortint;
const
  b64enc: TBase64Enc =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  b64URIenc: TBase64Enc =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
var
  /// a conversion table from Base64 text into binary data
  // - used by Base64ToBin/IsBase64 functions
  // - contains -1 for invalid char, -2 for '=', 0..63 for b64enc[] chars
  ConvertBase64ToBin, ConvertBase64URIToBin: TBase64Dec;

function Base64AnyDecode(const decode: TBase64Dec; sp,rp: PAnsiChar; len: PtrInt): boolean;
var c, ch: PtrInt;
begin
  result := false;
  while len>=4 do begin
    c := decode[sp[0]];
    if c<0 then
      exit;
    c := c shl 6;
    ch := decode[sp[1]];
    if ch<0 then
      exit;
    c := (c or ch) shl 6;
    ch := decode[sp[2]];
    if ch<0 then
      exit;
    c := (c or ch) shl 6;
    ch := decode[sp[3]];
    if ch<0 then
      exit;
    c := c or ch;
    rp[2] := AnsiChar(c);
    c := c shr 8;
    rp[1] := AnsiChar(c);
    c := c shr 8;
    rp[0] := AnsiChar(c);
    dec(len,4);
    inc(rp,3);
    inc(sp,4);
  end;
  if len>=2 then begin
    c := decode[sp[0]];
    if c<0 then
      exit;
    c := c shl 6;
    ch := decode[sp[1]];
    if ch<0 then
      exit;
    if len=2 then
      rp[0] := AnsiChar((c or ch) shr 4) else begin
      c := (c or ch) shl 6;
      ch := decode[sp[2]];
      if ch<0 then
        exit;
      c := (c or ch) shr 2;
      rp[1] := AnsiChar(c);
      rp[0] := AnsiChar(c shr 8);
    end;
  end;
  result := true;
end;

function Base64Decode(sp,rp: PAnsiChar; len: PtrInt): boolean; {$ifdef FPC}inline;{$endif}
begin
  len := len shl 2; // len was the number of 4 chars chunks in sp
  if (len>0) and (ConvertBase64ToBin[sp[len-2]]>=0) then
    if ConvertBase64ToBin[sp[len-1]]>=0 then else
      dec(len) else
      dec(len,2); // Base64AnyDecode() algorithm ignores the trailing '='
  result := Base64AnyDecode(ConvertBase64ToBin,sp,rp,len);
end;

{$ifdef PUREPASCAL}
function Base64EncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
var i: integer;
    c: cardinal;
    enc: TBase64Enc; // a local stack copy makes the loop slightly faster
begin
  enc := b64enc;
  result := len div 3;
  for i := 1 to result do begin
    c := ord(sp[0]) shl 16 + ord(sp[1]) shl 8 + ord(sp[2]);
    rp[0] := enc[(c shr 18) and $3f];
    rp[1] := enc[(c shr 12) and $3f];
    rp[2] := enc[(c shr 6) and $3f];
    rp[3] := enc[c and $3f];
    inc(rp,4);
    inc(sp,3);
  end;
end;
{$else PUREPASCAL}
function Base64EncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
asm // eax=rp edx=sp ecx=len - pipeline optimized version by AB
        push    ebx
        push    esi
        push    edi
        push    ebp
        mov     ebx, edx
        mov     esi, eax
        mov     eax, ecx
        mov     edx, 1431655766 // faster eax=len div 3 using reciprocal
        sar     ecx, 31
        imul    edx
        mov     eax, edx
        sub     eax, ecx
        mov     edi, offset b64enc
        mov     ebp, eax
        push    eax
        jz      @z
        // edi=b64enc[] ebx=sp esi=rp ebp=len div 3
        xor     eax, eax
@1:    // read 3 bytes from sp
        movzx   edx, byte ptr[ebx]
        shl     edx, 16
        mov     al, [ebx + 2]
        mov     ah, [ebx + 1]
        add     ebx, 3
        or      eax, edx
        // encode as Base64
        mov     ecx, eax
        mov     edx, eax
        shr     ecx, 6
        and     edx, $3f
        and     ecx, $3f
        mov     dh, [edi + edx]
        mov     dl, [edi + ecx]
        mov     ecx, eax
        shr     eax, 12
        shr     ecx, 18
        shl     edx, 16
        and     ecx, $3f
        and     eax, $3f
        mov     cl, [edi + ecx]
        mov     ch, [edi + eax]
        or      ecx, edx
        // write the 4 encoded bytes into rp
        mov     [esi], ecx
        add     esi, 4
        dec     ebp
        jnz     @1
@z:     pop     eax // result := len div 3
        pop     ebp
        pop     edi
        pop     esi
        pop     ebx
end;
{$endif PUREPASCAL}

procedure Base64EncodeTrailing(rp, sp: PAnsiChar; len: cardinal);
  {$ifdef HASINLINE}inline;{$endif}
var c: cardinal;
begin
  case len of
    1: begin
      c := ord(sp[0]) shl 4;
      rp[0] := b64enc[(c shr 6) and $3f];
      rp[1] := b64enc[c and $3f];
      rp[2] := '=';
      rp[3] := '=';
    end;
    2: begin
      c := ord(sp[0]) shl 10 + ord(sp[1]) shl 2;
      rp[0] := b64enc[(c shr 12) and $3f];
      rp[1] := b64enc[(c shr 6) and $3f];
      rp[2] := b64enc[c and $3f];
      rp[3] := '=';
    end;
  end;
end;

procedure Base64Encode(rp, sp: PAnsiChar; len: cardinal);
var main: cardinal;
begin
  main := Base64EncodeMain(rp,sp,len);
  Base64EncodeTrailing(rp+main*4,sp+main*3,len-main*3);
end;

function BinToBase64Length(len: PtrUInt): PtrUInt;
begin
  result := ((len+2)div 3)*4;
end;

function BinToBase64(const s: RawByteString): RawUTF8;
var len: integer;
begin
  result := '';
  len := length(s);
  if len=0 then
    exit;
  SetLength(result,BinToBase64Length(len));
  Base64Encode(pointer(result),pointer(s),len);
end;

function BinToBase64(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  result := '';
  if BinBytes=0 then
    exit;
  SetLength(result,BinToBase64Length(BinBytes));
  Base64Encode(pointer(result),Bin,BinBytes);
end;

function BinToBase64(const data, Prefix, Suffix: RawByteString; WithMagic: boolean): RawUTF8;
var lendata,lenprefix,lensuffix,len: integer;
    res: PByteArray absolute result;
begin
  result := '';
  lendata := length(data);
  lenprefix := length(Prefix);
  lensuffix := length(Suffix);
  if lendata+lenprefix+lensuffix=0 then
    exit;
  len := ((lendata+2) div 3)*4+lenprefix+lensuffix;
  if WithMagic then
    inc(len,3);
  SetLength(result,len);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Prefix)^,res[0],lenprefix);
  if WithMagic then begin
    PInteger(@res[lenprefix])^ := JSON_BASE64_MAGIC;
    inc(lenprefix,3);
  end;
  Base64Encode(@res[lenprefix],pointer(data),lendata);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Suffix)^,res[len-lensuffix],lensuffix);
end;

function BinToBase64WithMagic(const data: RawByteString): RawUTF8;
var len: integer;
begin
  result := '';
  len := length(data);
  if len=0 then
    exit;
  SetLength(result,((len+2) div 3)*4+3);
  PInteger(pointer(result))^ := JSON_BASE64_MAGIC;
  Base64Encode(PAnsiChar(pointer(result))+3,pointer(data),len);
end;

function BinToBase64WithMagic(Data: pointer; DataLen: integer): RawUTF8;
begin
  result := '';
  if DataLen<=0 then
    exit;
  SetLength(result,((DataLen+2) div 3)*4+3);
  PInteger(pointer(result))^ := JSON_BASE64_MAGIC;
  Base64Encode(PAnsiChar(pointer(result))+3,Data,DataLen);
end;

function IsBase64(sp: PAnsiChar; len: PtrInt): boolean;
var i: PtrInt;
begin
  result := false;
  if (len=0) or (len and 3<>0) then
    exit;
  for i := 0 to len-5 do
    if ConvertBase64ToBin[sp[i]]<0 then
      exit;
  inc(sp,len-4);
  if (ConvertBase64ToBin[sp[0]]=-1) or (ConvertBase64ToBin[sp[1]]=-1) or
     (ConvertBase64ToBin[sp[2]]=-1) or (ConvertBase64ToBin[sp[3]]=-1) then
      exit;
  result := true; // layout seems correct
end;

function IsBase64(const s: RawByteString): boolean;
begin
  result := IsBase64(pointer(s),length(s));
end;

function Base64ToBinLengthSafe(sp: PAnsiChar; len: PtrInt): PtrInt;
begin
  if IsBase64(sp,len) then begin
    if ConvertBase64ToBin[sp[len-2]]>=0 then
      if ConvertBase64ToBin[sp[len-1]]>=0 then
        result := 0 else
        result := 1 else
        result := 2;
    result := (len shr 2)*3-result;
  end else
    result := 0;
end;

function Base64ToBinLength(sp: PAnsiChar; len: PtrInt): PtrInt;
begin
  result := 0;
  if (len=0) or (len and 3<>0) then
    exit;
  if ConvertBase64ToBin[sp[len-2]]>=0 then
    if ConvertBase64ToBin[sp[len-1]]>=0 then
      result := 0 else
      result := 1 else
      result := 2;
  result := (len shr 2)*3-result;
end;

function Base64ToBin(const s: RawByteString): RawByteString;
begin
  Base64ToBinSafe(pointer(s),length(s),result);
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt): RawByteString;
begin
  Base64ToBinSafe(sp,len,result);
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean;
begin
  result := Base64ToBinSafe(sp,len,data);
end;

function Base64ToBinSafe(const s: RawByteString): RawByteString;
begin
  Base64ToBinSafe(pointer(s),length(s),result);
end;

function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt): RawByteString;
begin
  Base64ToBinSafe(sp,len,result);
end;

function Base64ToBinSafe(sp: PAnsiChar; len: PtrInt; var data: RawByteString): boolean;
var resultLen: PtrInt;
begin
  resultLen := Base64ToBinLength(sp,len);
  if resultLen<>0 then begin
    SetString(data,nil,resultLen);
    if ConvertBase64ToBin[sp[len-2]]>=0 then
      if ConvertBase64ToBin[sp[len-1]]>=0 then else
        dec(len) else
        dec(len,2); // adjust for Base64AnyDecode() algorithm
    result := Base64AnyDecode(ConvertBase64ToBin,sp,pointer(data),len);
    if not result then
      data := '';
  end else begin
    result := false;
    data := '';
  end;
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt; var blob: TSynTempBuffer): boolean;
begin
  blob.Init(Base64ToBinLength(sp,len));
  result := (blob.len>0) and Base64Decode(sp,blob.buf,len shr 2);
end;

function Base64ToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt;
  nofullcheck: boolean): boolean;
begin // nofullcheck is just ignored and deprecated
  result := (bin<>nil) and (Base64ToBinLength(base64,base64len)=binlen) and
    Base64Decode(base64,bin,base64len shr 2);
end;

function Base64ToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt;
  nofullcheck: boolean): boolean;
begin
  result := Base64ToBin(pointer(base64),bin,length(base64),binlen,nofullcheck);
end;

{ --------- Base64 URI encoding/decoding }

{$ifdef PUREPASCAL}
procedure Base64uriEncode(rp, sp: PAnsiChar; len: cardinal);
var i, main, c: cardinal;
    enc: TBase64Enc; // a local stack copy makes the loop slightly faster
begin
  enc := b64URIenc;
  main := len div 3;
  for i := 1 to main do begin
    c := ord(sp[0]) shl 16 + ord(sp[1]) shl 8 + ord(sp[2]);
    rp[0] := enc[(c shr 18) and $3f];
    rp[1] := enc[(c shr 12) and $3f];
    rp[2] := enc[(c shr 6) and $3f];
    rp[3] := enc[c and $3f];
    inc(rp,4);
    inc(sp,3);
  end;
  case len-main*3 of
    1: begin
      c := ord(sp[0]) shl 4;
      rp[0] := enc[(c shr 6) and $3f];
      rp[1] := enc[c and $3f];
    end;
    2: begin
      c := ord(sp[0]) shl 10 + ord(sp[1]) shl 2;
      rp[0] := enc[(c shr 12) and $3f];
      rp[1] := enc[(c shr 6) and $3f];
      rp[2] := enc[c and $3f];
    end;
  end;
end;
{$else PUREPASCAL}
function Base64uriEncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
asm // eax=rp edx=sp ecx=len - pipeline optimized version by AB
        push    ebx
        push    esi
        push    edi
        push    ebp
        mov     ebx, edx
        mov     esi, eax
        mov     eax, ecx
        mov     edx, 1431655766 // faster eax=len div 3 using reciprocal
        sar     ecx, 31
        imul    edx
        mov     eax, edx
        sub     eax, ecx
        mov     edi, offset b64urienc
        mov     ebp, eax
        push    eax
        jz      @z
        // edi=b64urienc[] ebx=sp esi=rp ebp=len div 3
        xor     eax, eax
@1:    // read 3 bytes from sp
        movzx   edx, byte ptr[ebx]
        shl     edx, 16
        mov     al, [ebx + 2]
        mov     ah, [ebx + 1]
        add     ebx, 3
        or      eax, edx
        // encode as Base64uri
        mov     ecx, eax
        mov     edx, eax
        shr     ecx, 6
        and     edx, $3f
        and     ecx, $3f
        mov     dh, [edi + edx]
        mov     dl, [edi + ecx]
        mov     ecx, eax
        shr     eax, 12
        shr     ecx, 18
        shl     edx, 16
        and     ecx, $3f
        and     eax, $3f
        mov     cl, [edi + ecx]
        mov     ch, [edi + eax]
        or      ecx, edx
        // write the 4 encoded bytes into rp
        mov     [esi], ecx
        add     esi, 4
        dec     ebp
        jnz     @1
@z:     pop     eax // result := len div 3
        pop     ebp
        pop     edi
        pop     esi
        pop     ebx
end;

procedure Base64uriEncodeTrailing(rp, sp: PAnsiChar; len: cardinal);
  {$ifdef HASINLINE}inline;{$endif}
var c: cardinal;
begin
  case len of
    1: begin
      c := ord(sp[0]) shl 4;
      rp[0] := b64urienc[(c shr 6) and $3f];
      rp[1] := b64urienc[c and $3f];
    end;
    2: begin
      c := ord(sp[0]) shl 10 + ord(sp[1]) shl 2;
      rp[0] := b64urienc[(c shr 12) and $3f];
      rp[1] := b64urienc[(c shr 6) and $3f];
      rp[2] := b64urienc[c and $3f];
    end;
  end;
end;

procedure Base64uriEncode(rp, sp: PAnsiChar; len: cardinal);
var main: cardinal;
begin
  main := Base64uriEncodeMain(rp,sp,len);
  Base64uriEncodeTrailing(rp+main*4,sp+main*3,len-main*3);
end;
{$endif PUREPASCAL}

function BinToBase64uriLength(len: PtrUInt): PtrUInt;
begin
  result := (len div 3)*4;
  case len-(result shr 2)*3 of // fast len mod 3
  1: inc(result,2);
  2: inc(result,3);
  end;
end;

function BinToBase64uri(const s: RawByteString): RawUTF8;
var len: integer;
begin
  result := '';
  len := length(s);
  if len=0 then
    exit;
  SetLength(result,BinToBase64uriLength(len));
  Base64uriEncode(pointer(result),pointer(s),len);
end;

function BinToBase64uri(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  result := '';
  if BinBytes<=0 then
    exit;
  SetLength(result,BinToBase64uriLength(BinBytes));
  Base64uriEncode(pointer(result),Bin,BinBytes);
end;

function BinToBase64uriShort(Bin: PAnsiChar; BinBytes: integer): shortstring;
var len: integer;
begin
  result := '';
  if BinBytes<=0 then
    exit;
  len := BinToBase64uriLength(BinBytes);
  if len>255 then
    exit;
  byte(result[0]) := len;
  Base64uriEncode(@result[1],Bin,BinBytes);
end;

function Base64uriToBinLength(len: PtrInt): PtrInt;
begin
  if len=0 then
    result := 0 else begin
    result := (len shr 2)*3;
    case len and 3 of
    1: result := 0;
    2: inc(result,1);
    3: inc(result,2);
    end;
  end;
end;

function Base64uriDecode(sp,rp: PAnsiChar; len: PtrInt): boolean;
begin
  result := Base64AnyDecode(ConvertBase64URIToBin,sp,rp,len);
end;

function Base64uriToBin(sp: PAnsiChar; len: PtrInt): RawByteString;
begin
  Base64uriToBin(sp,len,result);
end;

function Base64uriToBin(const s: RawByteString): RawByteString;
begin
  Base64uriToBin(pointer(s),length(s),result);
end;

procedure Base64uriToBin(sp: PAnsiChar; len: PtrInt; var result: RawByteString);
var resultLen: PtrInt;
begin
  resultLen := Base64uriToBinLength(len);
  if resultLen<>0 then begin
    SetString(result,nil,resultLen);
    if Base64AnyDecode(ConvertBase64URIToBin,sp,pointer(result),len) then
      exit;
  end;
  result := '';
end;

function Base64uriToBin(sp: PAnsiChar; len: PtrInt; var temp: TSynTempBuffer): boolean;
begin
  temp.Init(Base64uriToBinLength(len));
  result := (temp.len>0) and Base64AnyDecode(ConvertBase64URIToBin,sp,temp.buf,len);
end;

function Base64uriToBin(const base64: RawByteString; bin: PAnsiChar; binlen: PtrInt): boolean;
begin
  result := Base64uriToBin(pointer(base64),bin,length(base64),binlen);
end;

function Base64uriToBin(base64, bin: PAnsiChar; base64len, binlen: PtrInt): boolean;
var resultLen: PtrInt;
begin
  resultLen := Base64uriToBinLength(base64len);
  result := (resultLen=binlen) and
    Base64AnyDecode(ConvertBase64URIToBin,base64,bin,base64len);
end;

procedure Base64ToURI(var base64: RawUTF8);
var P: PUTF8Char;
begin
  P := UniqueRawUTF8(base64);
  if P<>nil then
    repeat
      case P^ of
      #0: break;
      '+': P^ := '-';
      '/': P^ := '_';
      '=': begin // trim unsignificant trailing '=' characters
        SetLength(base64,P-pointer(base64));
        break;
      end;
      end;
      inc(P);
    until false;
end;


function BinToSource(const ConstName, Comment: RawUTF8;
  Data: pointer; Len, PerLine: integer; const Suffix: RawUTF8): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  if (Data=nil) or (Len<=0) or (PerLine<=0) then
    result := '' else begin
    W := TTextWriter.CreateOwnedStream(temp,Len*5+50+length(Comment)+length(Suffix));
    try
      BinToSource(W,ConstName,Comment,Data,Len,PerLine);
      if Suffix<>'' then begin
        W.AddString(Suffix);
        W.AddCR;
      end;
      W.SetText(result);
    finally
      W.Free;
    end;
  end;
end;

procedure BinToSource(Dest: TTextWriter; const ConstName, Comment: RawUTF8;
  Data: pointer; Len, PerLine: integer);
var line,i: integer;
    P: PByte;
begin
  if (Dest=nil) or (Data=nil) or (Len<=0) or (PerLine<=0) then
    exit;
  Dest.AddShort('const');
  if Comment<>'' then
    Dest.Add(#13#10'  // %',[Comment]);
  Dest.Add(#13#10'  %: array[0..%] of byte = (',[ConstName,Len-1]);
  P := pointer(Data);
  repeat
    if len>PerLine then
      line := PerLine else
      line := Len;
    Dest.AddShort(#13#10'    ');
    for i := 0 to line-1 do begin
      Dest.Add('$');
      Dest.AddByteToHex(P^);
      inc(P);
      Dest.Add(',');
    end;
    dec(Len,line);
  until Len=0;
  Dest.CancelLastComma;
  Dest.Add(');'#13#10'  %_LEN = SizeOf(%);'#13#10,[ConstName,ConstName]);
end;

function UpperCaseUnicode(const S: RawUTF8): RawUTF8;
{$ifdef MSWINDOWS}
var tmp: RawUnicode;
    TmpLen: integer;
{$endif}
begin
{$ifdef MSWINDOWS}
  tmp := Utf8DecodeToRawUnicodeUI(S,@TmpLen);
  TmpLen := TmpLen shr 1;
  CharUpperBuffW(pointer(tmp),TmpLen);
  RawUnicodeToUtf8(pointer(tmp),TmpLen,result);
{$endif}
{$ifdef POSIX}
  result := WideStringToUTF8(WideUpperCase(UTF8ToWideString(S)));
{$endif}
end;

function LowerCaseUnicode(const S: RawUTF8): RawUTF8;
{$ifdef MSWINDOWS}
var tmp: RawUnicode;
    TmpLen: integer;
{$endif}
begin
{$ifdef MSWINDOWS}
  tmp := Utf8DecodeToRawUnicodeUI(S,@TmpLen);
  TmpLen := TmpLen shr 1;
  CharLowerBuffW(pointer(tmp),TmpLen);
  RawUnicodeToUtf8(pointer(tmp),TmpLen,result);
{$endif}
{$ifdef POSIX}
  result := WideStringToUTF8(WideLowerCase(UTF8ToWideString(S)));
{$endif}
end;

function IsCaseSensitive(const S: RawUTF8): boolean;
begin
  result := IsCaseSensitive(pointer(S),length(S));
end;

function IsCaseSensitive(P: PUTF8Char; PLen: integer): boolean;
begin
  result := true;
  if (P<>nil) and (PLen>0) then
    repeat
      if ord(P^) in [ord('a')..ord('z'), ord('A')..ord('Z')] then
        exit;
      inc(P);
      dec(PLen);
    until PLen=0;
  result := false;
end;

function UpperCase(const S: RawUTF8): RawUTF8;
var L, i: PtrInt;
begin
  L := length(S);
  FastSetString(Result,pointer(S),L);
  for i := 0 to L-1 do
    if PByteArray(result)[i] in [ord('a')..ord('z')] then
      dec(PByteArray(result)[i],32);
end;

procedure UpperCaseCopy(Text: PUTF8Char; Len: integer; var result: RawUTF8);
var i: integer;
begin
  FastSetString(result,Text,Len);
  for i := 0 to Len-1 do
    if PByteArray(result)[i] in [ord('a')..ord('z')] then
      dec(PByteArray(result)[i],32);
end;

procedure UpperCaseCopy(const Source: RawUTF8; var Dest: RawUTF8);
var L, i: PtrInt;
begin
  L := length(Source);
  FastSetString(Dest,pointer(Source),L);
  for i := 0 to L-1 do
    if PByteArray(Dest)[i] in [ord('a')..ord('z')] then
      dec(PByteArray(Dest)[i],32);
end;

procedure UpperCaseSelf(var S: RawUTF8);
var i: PtrInt;
    P: PByteArray;
begin
  P := UniqueRawUTF8(S);
  for i := 0 to length(S)-1 do
    if P[i] in [ord('a')..ord('z')] then
      dec(P[i],32);
end;

function LowerCase(const S: RawUTF8): RawUTF8;
var L, i: PtrInt;
begin
  L := length(S);
  FastSetString(result,pointer(S),L);
  for i := 0 to L-1 do
    if PByteArray(result)[i] in [ord('A')..ord('Z')] then
      inc(PByteArray(result)[i],32);
end;

procedure LowerCaseCopy(Text: PUTF8Char; Len: integer; var result: RawUTF8);
var i: integer;
begin
  FastSetString(result,Text,Len);
  for i := 0 to Len-1 do
    if PByteArray(result)[i] in [ord('A')..ord('Z')] then
      inc(PByteArray(result)[i],32);
end;

procedure LowerCaseSelf(var S: RawUTF8);
var i: PtrInt;
    P: PByteArray;
begin
  P := UniqueRawUTF8(S);
  for i := 0 to length(S)-1 do
    if P[i] in [ord('A')..ord('Z')] then
      inc(P[i],32);
end;

function TrimLeft(const S: RawUTF8): RawUTF8;
var i, l: Integer;
begin
  l := Length(S);
  i := 1;
  while (i <= l) and (S[i] <= ' ') do
    Inc(i);
  Result := Copy(S, i, Maxint);
end;

function TrimRight(const S: RawUTF8): RawUTF8;
var i: Integer;
begin
  i := Length(S);
  while (i > 0) and (S[i] <= ' ') do
    Dec(i);
  FastSetString(result,pointer(S),i);
end;

type
  TAnsiCharToWord = array[AnsiChar] of word;
  TByteToWord = array[byte] of word;
var
  /// fast lookup table for converting hexadecimal numbers from 0 to 15
  // into their ASCII equivalence
  // - is local for better code generation
  TwoDigitsHex: array[byte] of array[1..2] of AnsiChar;
  TwoDigitsHexW: TAnsiCharToWord absolute TwoDigitsHex;
  TwoDigitsHexWB: array[byte] of word absolute TwoDigitsHex;
  /// lowercase hexadecimal lookup table
  TwoDigitsHexLower: array[byte] of array[1..2] of AnsiChar;
  TwoDigitsHexWLower: TAnsiCharToWord absolute TwoDigitsHexLower;
  TwoDigitsHexWBLower: array[byte] of word absolute TwoDigitsHexLower;

procedure BinToHex(Bin, Hex: PAnsiChar; BinBytes: integer);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexW;{$endif}
  if BinBytes>0 then
    repeat
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexW{$else}tab{$endif}[Bin^];
      inc(Bin);
      inc(Hex,2);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHex(const Bin: RawByteString): RawUTF8;
var L: integer;
begin
  L := length(Bin);
  FastSetString(result,nil,L*2);
  SynCommons.BinToHex(pointer(Bin),pointer(Result),L);
end;

function BinToHex(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  FastSetString(result,nil,BinBytes*2);
  SynCommons.BinToHex(Bin,pointer(Result),BinBytes);
end;

function HexToBin(const Hex: RawUTF8): RawByteString;
var L: integer;
begin
  L := length(Hex);
  if L and 1<>0 then
    L := 0 else // hexadecimal should be in char pairs
    L := L shr 1;
  SetLength(result,L);
  if not SynCommons.HexToBin(pointer(Hex),pointer(result),L) then
    result := '';
end;

function ByteToHex(P: PAnsiChar; Value: byte): PAnsiChar;
begin
  PWord(P)^ := TwoDigitsHexWB[Value];
  result := P+2;
end;

function EscapeBuffer(s,d: PAnsiChar; len,max: integer): PAnsiChar;
var i: integer;
begin
  if len>max then
    len := max;
  for i := 1 to len do begin
    if s^ in [' '..#126] then begin
      d^ := s^;
      inc(d);
    end else begin
      d^ := '$';
      inc(d);
      PWord(d)^ := TwoDigitsHexWB[ord(s^)];
      inc(d,2);
    end;
    inc(s);
  end;
  if len=max then begin
    PCardinal(d)^ := ord('.')+ord('.')shl 8+ord('.')shl 16;
    inc(d,3);
  end else
    d^ := #0;
  result := d;
end;

function LogEscape(source: PAnsiChar; sourcelen: integer; var temp: TLogEscape;
  enabled: boolean): PAnsiChar;
begin
  if enabled then begin
    temp[0] := ' ';
    EscapeBuffer(source,@temp[1],sourcelen,LOGESCAPELEN);
  end else
    temp[0] := #0;
  result := @temp;
end;

function LogEscapeFull(const source: RawByteString): RawUTF8;
begin
  result := LogEscapeFull(pointer(source),length(source));
end;

function LogEscapeFull(source: PAnsiChar; sourcelen: integer): RawUTF8;
begin
  SetLength(result,sourcelen*3); // worse case
  if sourcelen=0 then
    exit;
  sourcelen := EscapeBuffer(source,pointer(result),sourcelen,length(result))-pointer(result);
  SetLength(result,sourcelen);
end;

function EscapeToShort(source: PAnsiChar; sourcelen: integer): shortstring;
begin
  result[0] := AnsiChar(EscapeBuffer(source,@result[1],sourcelen,80)-@result[1]);
end;

function EscapeToShort(const source: RawByteString): shortstring; overload;
begin
  result[0] := AnsiChar(EscapeBuffer(pointer(source),@result[1],length(source),80)-@result[1]);
end;

procedure BinToHexDisplay(Bin, Hex: PAnsiChar; BinBytes: integer);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexW;{$endif}
  inc(Hex,BinBytes*2);
  if BinBytes>0 then
    repeat
      dec(Hex,2);
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexW{$else}tab{$endif}[Bin^];
      inc(Bin);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHexDisplay(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  FastSetString(result,nil,BinBytes*2);
  BinToHexDisplay(Bin,pointer(result),BinBytes);
end;

procedure BinToHexLower(Bin, Hex: PAnsiChar; BinBytes: integer);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexWLower;{$endif}
  if BinBytes>0 then
    repeat
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexWLower{$else}tab{$endif}[Bin^];
      inc(Bin);
      inc(Hex,2);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHexLower(const Bin: RawByteString): RawUTF8;
begin
  BinToHexLower(pointer(Bin),length(Bin),result);
end;

procedure BinToHexLower(Bin: PAnsiChar; BinBytes: integer; var result: RawUTF8);
begin
  FastSetString(result,nil,BinBytes*2);
  BinToHexLower(Bin,pointer(result),BinBytes);
end;

function BinToHexLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  BinToHexLower(Bin,BinBytes,result);
end;

procedure BinToHexDisplayLower(Bin, Hex: PAnsiChar; BinBytes: PtrInt);
{$ifdef PUREPASCAL}var tab: ^TAnsiCharToWord;{$endif}
begin
  {$ifdef PUREPASCAL}tab := @TwoDigitsHexWLower;{$endif}
  inc(Hex,BinBytes*2);
  if BinBytes>0 then
    repeat
      dec(Hex,2);
      PWord(Hex)^ := {$ifndef PUREPASCAL}TwoDigitsHexWLower{$else}tab{$endif}[Bin^];
      inc(Bin);
      dec(BinBytes);
    until BinBytes=0;
end;

function BinToHexDisplayLower(Bin: PAnsiChar; BinBytes: integer): RawUTF8;
begin
  FastSetString(result,nil,BinBytes*2);
  BinToHexDisplayLower(Bin,pointer(result),BinBytes);
end;

function BinToHexDisplayLowerShort(Bin: PAnsiChar; BinBytes: integer): shortstring;
begin
  if BinBytes>127 then
    BinBytes := 127;
  result[0] := AnsiChar(BinBytes * 2);
  BinToHexDisplayLower(Bin,@result[1],BinBytes);
end;

function BinToHexDisplayLowerShort16(Bin: Int64; BinBytes: integer): TShort16;
begin
  if BinBytes>8 then
    BinBytes := 8;
  result[0] := AnsiChar(BinBytes * 2);
  BinToHexDisplayLower(@Bin,@result[1],BinBytes);
end;

function BinToHexDisplayFile(Bin: PAnsiChar; BinBytes: integer): TFileName;
{$ifdef UNICODE}
var temp: TSynTempBuffer;
begin
  temp.Init(BinBytes*2);
  BinToHexDisplayLower(Bin,temp.Buf,BinBytes);
  Ansi7ToString(PWinAnsiChar(temp.buf),BinBytes*2,string(result));
  temp.Done;
end;
{$else}
begin
  SetString(result,nil,BinBytes*2);
  BinToHexDisplayLower(Bin,pointer(result),BinBytes);
end;
{$endif}

procedure PointerToHex(aPointer: Pointer; var result: RawUTF8);
begin
  FastSetString(result,nil,SizeOf(Pointer)*2);
  BinToHexDisplay(@aPointer,pointer(result),SizeOf(Pointer));
end;

function PointerToHex(aPointer: Pointer): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(aPointer)*2);
  BinToHexDisplay(@aPointer,pointer(result),SizeOf(aPointer));
end;

function CardinalToHex(aCardinal: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(aCardinal)*2);
  BinToHexDisplay(@aCardinal,pointer(result),SizeOf(aCardinal));
end;

function CardinalToHexLower(aCardinal: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(aCardinal)*2);
  BinToHexDisplayLower(@aCardinal,pointer(result),SizeOf(aCardinal));
end;

function Int64ToHex(aInt64: Int64): RawUTF8;
begin
  FastSetString(result,nil,SizeOf(Int64)*2);
  BinToHexDisplay(@aInt64,pointer(result),SizeOf(Int64));
end;

procedure Int64ToHex(aInt64: Int64; var result: RawUTF8);
begin
  FastSetString(result,nil,SizeOf(Int64)*2);
  BinToHexDisplay(@aInt64,pointer(result),SizeOf(Int64));
end;

function PointerToHexShort(aPointer: Pointer): TShort16;
begin
  result[0] := AnsiChar(SizeOf(aPointer)*2);
  BinToHexDisplay(@aPointer,@result[1],SizeOf(aPointer));
end;

function CardinalToHexShort(aCardinal: Cardinal): TShort16;
begin
  result[0] := AnsiChar(SizeOf(aCardinal)*2);
  BinToHexDisplay(@aCardinal,@result[1],SizeOf(aCardinal));
end;

function Int64ToHexShort(aInt64: Int64): TShort16;
begin
  result[0] := AnsiChar(SizeOf(aInt64)*2);
  BinToHexDisplay(@aInt64,@result[1],SizeOf(aInt64));
end;

procedure Int64ToHexShort(aInt64: Int64; out result: TShort16);
begin
  result[0] := AnsiChar(SizeOf(aInt64)*2);
  BinToHexDisplay(@aInt64,@result[1],SizeOf(aInt64));
end;

function Int64ToHexString(aInt64: Int64): string;
var temp: TShort16;
begin
  Int64ToHexShort(aInt64,temp);
  Ansi7ToString(@temp[1],ord(temp[0]),result);
end;

type TDiv100Rec = packed record D, M: cardinal; end;

procedure Div100(Y: cardinal; var result: TDiv100Rec);
{$ifdef HASINLINENOTX86} inline;
begin
  result.D := Y div 100; // FPC will use fast reciprocal
  result.M := Y-(result.D*100); // avoid div twice
end;
{$else}
asm
      push    ebx
      mov     ecx, eax // ecx=Y
      mov     ebx, edx // ebx=result
      mov     edx, eax
      mov     eax, 1374389535
      mul     edx
      shr     edx, 5   // edx=Y div 100
      mov     dword ptr [ebx].TDiv100Rec.D, edx
      mov     eax, 100
      mul     edx
      sub     ecx, eax // ecx=Y-(edx*100)
      mov     dword ptr [ebx].TDiv100Rec.M, ecx
      pop     ebx
end;
{$endif HASINLINENOTX86}

function UInt3DigitsToUTF8(Value: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,3);
  PWordArray(result)[0] := TwoDigitLookupW[Value div 10];
  PByteArray(result)[2] := (Value mod 10)+48;
end;

function UInt4DigitsToUTF8(Value: Cardinal): RawUTF8;
begin
  FastSetString(result,nil,4);
  if Value>9999 then
    Value := 9999;
  YearToPChar(Value,pointer(result));
end;

function UInt4DigitsToShort(Value: Cardinal): TShort4;
begin
  result[0] := #4;
  if Value>9999 then
    Value := 9999;
  YearToPChar(Value,@result[1]);
end;

function UInt3DigitsToShort(Value: Cardinal): TShort4;
begin
  if Value>999 then
    Value := 999;
  YearToPChar(Value,@result[0]);
  result[0] := #3; // override first digit
end;

function UInt2DigitsToShort(Value: byte): TShort4;
begin
  result[0] := #2;
  if Value>99 then
    Value := 99;
  PWord(@result[1])^ := TwoDigitLookupW[Value];
end;

function UInt2DigitsToShortFast(Value: byte): TShort4;
begin
  result[0] := #2;
  PWord(@result[1])^ := TwoDigitLookupW[Value];
end;

function SameValue(const A, B: Double; DoublePrec: double): Boolean;
var AbsA,AbsB,Res: double;
begin
  if PInt64(@DoublePrec)^=0 then begin // Max(Min(Abs(A),Abs(B))*1E-12,1E-12)
    AbsA := Abs(A);
    AbsB := Abs(B);
    Res := 1E-12;
    if AbsA<AbsB then
      DoublePrec := AbsA*Res else
      DoublePrec := AbsB*Res;
    if DoublePrec<Res then
      DoublePrec := Res;
  end;
  if A<B then
    result := (B-A)<=DoublePrec else
    result := (A-B)<=DoublePrec;
end;

function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended): Boolean;
var AbsA,AbsB,Res: TSynExtended;
begin
  if DoublePrec=0 then begin // Max(Min(Abs(A),Abs(B))*1E-12,1E-12)
    AbsA := Abs(A);
    AbsB := Abs(B);
    Res := 1E-12; // also for TSynExtended (FPC uses 1E-4!)
    if AbsA<AbsB then
      DoublePrec := AbsA*Res else
      DoublePrec := AbsB*Res;
    if DoublePrec<Res then
      DoublePrec := Res;
  end;
  if A<B then
    result := (B-A)<=DoublePrec else
    result := (A-B)<=DoublePrec;
end;

function CompareFloat(const A, B: double): integer;
begin
  if A<B then
    result := -1 else
  if A>B then
    result := 1 else
    result := 0;
end;

function CompareInteger(const A, B: integer): integer;
begin
  if A<B then
    result := -1 else
  if A>B then
    result := 1 else
    result := 0;
end;

function CompareInt64(const A, B: Int64): integer;
begin
  if A<B then
    result := -1 else
  if A>B then
    result := 1 else
    result := 0;
end;

function CompareCardinal(const A, B: cardinal): integer;
begin
  if A<B then
    result := -1 else
  if A>B then
    result := 1 else
    result := 0;
end;

procedure KahanSum(const Data: double; var Sum, Carry: double);
var y, t: double;
begin
  y := Data - Carry;
  t := Sum + y;
  Carry := (t - Sum) - y;
  Sum := t;
end;

function FindRawUTF8(const Values: TRawUTF8DynArray; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer;
begin
  if CaseSensitive then begin
    for result := 0 to length(Values)-1 do
      if Values[result]=Value then
        exit;
  end else
    for result := 0 to length(Values)-1 do
      if UTF8IComp(pointer(Values[result]),pointer(Value))=0 then
        exit;
  result := -1;
end;

function FindRawUTF8(const Values: array of RawUTF8; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer;
begin
  if CaseSensitive then begin
    for result := 0 to high(Values) do
      if Values[result]=Value then
        exit;
  end else
    for result := 0 to high(Values) do
      if UTF8IComp(pointer(Values[result]),pointer(Value))=0 then
        exit;
  result := -1;
end;

function FindRawUTF8(const Values: TRawUTF8DynArray; ValuesCount: integer;
  const Value: RawUTF8; SearchPropName: boolean): integer;
begin
  if SearchPropName then begin
    for result := 0 to ValuesCount-1 do
      if IdemPropNameU(Values[result],Value) then
        exit;
  end else
    for result := 0 to ValuesCount-1 do
      if Values[result]=Value then
        exit;
  result := -1;
end;

function FindPropName(const Names: array of RawUTF8; const Name: RawUTF8): integer;
{$ifdef HASINLINE}
var NameLen: integer;
begin
  NameLen := Length(Name);
  for result := 0 to high(Names) do
    if (Length(Names[result])=NameLen) and
       IdemPropNameUSameLen(pointer(Names[result]),pointer(Name),NameLen) then
      exit;
  result := -1;
end;
{$else}
begin
  for result := 0 to high(names) do
    if IdemPropNameU(names[result],Name) then
      exit;
  result := -1;
end;
{$endif}

function AddRawUTF8(var Values: TRawUTF8DynArray; const Value: RawUTF8;
  NoDuplicates: boolean=false; CaseSensitive: boolean=true): boolean;
var i: integer;
begin
  if NoDuplicates then begin
    i := FindRawUTF8(Values,Value,CaseSensitive);
    if i>=0 then begin
      result := false;
      exit;
    end;
  end;
  i := length(Values);
  SetLength(Values,i+1);
  Values[i] := Value;
  result := true;
end;

function NextGrow(capacity: integer): integer;
begin // algorithm similar to TFPList.Expand for the increasing ranges
  result := capacity;
  if result<128 shl 20 then
    if result<8 shl 20 then
      if result<=128 then
        if result>8 then
          inc(result,16) else
          inc(result,4) else
        inc(result,result shr 2) else
      inc(result,result shr 3) else
    inc(result,16 shl 20);
end;

procedure AddRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8);
var capacity: integer;
begin
  capacity := Length(Values);
  if ValuesCount=capacity then
    SetLength(Values,NextGrow(capacity));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
end;

function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray): boolean;
var i: integer;
begin
  result := false;
  if length(A)<>length(B) then
    exit;
  for i := 0 to high(A) do
    if A[i]<>B[i] then
      exit;
  result := true;
end;

function RawUTF8DynArrayEquals(const A,B: TRawUTF8DynArray; Count: integer): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to Count - 1 do
    if A[i]<>B[i] then
      exit;
  result := true;
end;

procedure StringDynArrayToRawUTF8DynArray(const Source: TStringDynArray;
  var Result: TRawUTF8DynArray);
var i: Integer;
begin
  SetLength(Result,length(Source));
  for i := 0 to high(Source) do
    StringToUTF8(Source[i],Result[i]);
end;

procedure StringListToRawUTF8DynArray(Source: TStringList; var Result: TRawUTF8DynArray);
var i: Integer;
begin
  SetLength(Result,Source.Count);
  for i := 0 to Source.Count-1 do
    StringToUTF8(Source[i],Result[i]);
end;

function FindSectionFirstLine(var source: PUTF8Char; search: PAnsiChar): boolean;
{$ifdef PUREPASCAL}
begin
  result := false;
  if source=nil then
    exit;
  repeat
    if source^='[' then begin
      inc(source);
      result := IdemPChar(source,search);
    end;
    while source^ in ANSICHARNOT01310 do inc(source);
    while source^ in [#10,#13] do inc(source);
    if result then
      exit; // found
  until source^=#0;
  source := nil;
end;
{$else}
asm // eax=source edx=search
        push    eax       // save source var
        mov     eax, [eax]  // eax=source
        test    eax, eax
        jz      @z
        push    ebx
        mov     ebx, edx    // save search
        cmp     byte ptr[eax], '['
        lea     eax, [eax + 1]
        jne     @s
@i:     push    eax
        mov     edx, ebx   // edx=search
        call    IdemPChar
        pop     ecx       // ecx=source
        jmp     @1
@s:     mov     ecx, eax
        xor     eax, eax   // result := false
@1:     mov     dl, [ecx]  // while not (source^ in [#0,#10,#13]) do inc(source);
        inc     ecx
        cmp     dl, 13
        ja      @1
        je      @e
        or      dl, dl
        jz      @0
        cmp     dl, 10
        jne     @1
        cmp     byte[ecx], 13
        jbe     @1
        jmp     @4
@e:     cmp     byte ptr[ecx], 10 // jump #13#10
        jne     @4
        inc     ecx
@4:     test    al, al
        jnz     @x         // exit if IdemPChar returned true
        cmp     byte ptr[ecx], '['
        lea     ecx, [ecx + 1]
        jne     @1
        mov     eax, ecx
        jmp     @i
@0:     xor     ecx, ecx    // set source=nil
@x:     pop     ebx
        pop     edx         // restore source var
        mov     [edx], ecx  // update source var
        ret
@z:     pop     edx         // ignore source var, result := false
end;
{$endif}

{$ifdef USENORMTOUPPER}
{$ifdef PUREPASCAL}
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;
begin
  result := false;
  if (p=nil) or (up=nil) then
    exit;
  while up^<>#0 do begin
    if (p^>#255) or (up^<>AnsiChar(NormToUpperByte[ord(p^)])) then
      exit;
    inc(up);
    inc(p);
  end;
  result := true;
end;
{$else}
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;
asm // eax=p edx=up
        test    eax, eax
        jz      @e // P=nil -> false
        test    edx, edx
        push    ebx
        push    esi
        jz      @z // up=nil -> true
        mov     esi, offset NormToUpper
        xor     ebx, ebx
        xor     ecx, ecx
@1:     mov     bx, [eax]  // bl=p^
        mov     cl, [edx]  // cl=up^
        test    bh, bh     // p^ > #255 -> FALSE
        jnz     @n
        test    cl, cl
        mov     bl, [ebx + esi] // bl=NormToUpper[p^]
        jz      @z              // up^=#0 -> OK
        inc     edx
        add     eax, 2
        cmp     bl, cl
        je      @1
@n:     pop     esi
        pop     ebx
@e:     xor     eax, eax
        ret
@z:     mov     al, 1 // up^=#0 -> OK
        pop     esi
        pop     ebx
end;
{$endif PUREPASCAL}
{$else}
function IdemPCharW(p: PWideChar; up: PUTF8Char): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
begin
  result := false;
  if (p=nil) or (up=nil) then
    exit;
  while up^<>#0 do begin
    if (p^>#255) or (up^<>AnsiChar(NormToUpperByteAnsi7[ord(p^)])) then
      exit;
    inc(up);
    inc(p);
  end;
  result := true;
end;
{$endif USENORMTOUPPER}

function FindSectionFirstLineW(var source: PWideChar; search: PUTF8Char): boolean;
{$ifdef PUREPASCAL}
begin
  result := false;
  if source=nil then
    exit;
  repeat
    if source^='[' then begin
      inc(source);
      result := IdemPCharW(source,search);
    end;
    while not (cardinal(source^) in [0,10,13]) do inc(source);
    while cardinal(source^) in [10,13] do inc(source);
    if result then
      exit; // found
  until source^=#0;
  source := nil;
end;
{$else}
asm // eax=source edx=search
        push    eax        // save source var
        mov     eax, [eax] // eax=source
        test    eax, eax
        jz      @z
        push    ebx
        mov     ebx, edx   // save search
        cmp     word ptr[eax], '['
        lea     eax, [eax + 2]
        jne     @s
@i:     push    eax
        mov     edx, ebx   // edx=search
        call    IdemPCharW
        pop     ecx        // ecx=source
        jmp     @1
@s:     mov     ecx, eax
        xor     eax, eax   // result := false
@1:     mov     dx, [ecx]  // while not (source^ in [#0,#10,#13]) do inc(source)
        add     ecx, 2
        cmp     dx, 13
        ja      @1
        je      @e
        or      dx, dx
        jz      @0
        cmp     dx, 10
        jne     @1
        jmp     @4
@e:     cmp     word ptr[ecx], 10 // jump #13#10
        jne     @4
        add     ecx, 2
@4:     test    al, al
        jnz     @x         // exit if IdemPChar returned true
        cmp     word ptr[ecx], '['
        lea     ecx, [ecx + 2]
        jne     @1
        mov     eax, ecx
        jmp     @i
@0:     xor     ecx, ecx    // set source=nil
@x:     pop     ebx
        pop     edx         // restore source var
        mov     [edx], ecx  // update source var
        ret
@z:     pop     edx         // ignore source var, result := false
end;
{$endif PUREPASCAL}

function FindIniNameValue(P: PUTF8Char; UpperName: PAnsiChar): RawUTF8;
var u, PBeg: PUTF8Char;
    by4: cardinal;
    table: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin // expect UpperName as 'NAME='
  if (P<>nil) and (P^<>'[') and (UpperName<>nil) then begin
    {$ifndef CPUX86NOTPIC}table := @NormToUpperAnsi7;{$endif}
    PBeg := nil;
    u := P;
    repeat
      while u^=' ' do inc(u); // trim left ' '
      if u^=#0 then
        break;
      if table[u^]=UpperName[0] then
        PBeg := u;
      repeat
        by4 := PCardinal(u)^;
        if ToByte(by4)>13 then
          if ToByte(by4 shr 8)>13 then
            if ToByte(by4 shr 16)>13 then
              if by4 shr 24>13 then begin
                inc(u,4);
                continue;
              end else
              inc(u,3) else
            inc(u,2) else
          inc(u);
        if u^ in [#0,#10,#13] then
          break else
          inc(u);
      until false;
      if PBeg<>nil then begin
        inc(PBeg);
        P := u;
        u := pointer(UpperName+1);
        repeat
          if u^<>#0 then
            if table[PBeg^]<>u^ then
              break else begin
              inc(u);
              inc(PBeg);
            end else begin
            FastSetString(result,PBeg,P-PBeg);
            exit;
          end;
        until false;
        PBeg := nil;
        u := P;
      end;
      if u^=#13 then inc(u);
      if u^=#10 then inc(u);
    until u^ in [#0,'['];
  end;
  result := '';
end;

function ExistsIniName(P: PUTF8Char; UpperName: PAnsiChar): boolean;
var table: PNormTable;
begin
  result := false;
  table := @NormToUpperAnsi7;
  if (P<>nil) and (P^<>'[') then
    repeat
      if P^=' ' then begin
        repeat inc(P) until P^<>' '; // trim left ' '
        if P^=#0 then
          break;
      end;
      if IdemPChar2(table,P,UpperName) then begin
        result := true;
        exit;
      end;
      repeat
        if P[0]>#13 then
          if P[1]>#13 then
            if P[2]>#13 then
              if P[3]>#13 then begin
                inc(P,4);
                continue;
              end else
              inc(P,3) else
            inc(P,2) else
          inc(P);
        case P^ of
        #0: exit;
        #10: begin inc(P); break; end;
        #13: begin if P[1]=#10 then inc(P,2) else inc(P); break; end;
        else inc(P);
        end;
      until false;
    until P^='[';
end;

function ExistsIniNameValue(P: PUTF8Char; const UpperName: RawUTF8;
  const UpperValues: array of PAnsiChar): boolean;
var PBeg: PUTF8Char;
begin
  result := true;
  if high(UpperValues)>=0 then
    while (P<>nil) and (P^<>'[') do begin
      if P^=' ' then repeat inc(P) until P^<>' ';   // trim left ' '
      PBeg := P;
      if IdemPChar(PBeg,pointer(UpperName)) then begin
        inc(PBeg,length(UpperName));
        if IdemPCharArray(PBeg,UpperValues)>=0 then
          exit; // found one value
        break;
      end;
      P := GotoNextLine(P);
    end;
  result := false;
end;

function GetSectionContent(SectionFirstLine: PUTF8Char): RawUTF8;
var PBeg: PUTF8Char;
begin
  PBeg := SectionFirstLine;
  while (SectionFirstLine<>nil) and (SectionFirstLine^<>'[') do
    SectionFirstLine := GotoNextLine(SectionFirstLine);
  if SectionFirstLine=nil then
    result := PBeg else
    FastSetString(result,PBeg,SectionFirstLine-PBeg);
end;

function GetSectionContent(const Content, SectionName: RawUTF8): RawUTF8;
var P: PUTF8Char;
    UpperSection: array[byte] of AnsiChar;
begin
  P := pointer(Content);
  PWord(UpperCopy255(UpperSection,SectionName))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then
    result := GetSectionContent(P) else
    result := '';
end;

function DeleteSection(var Content: RawUTF8; const SectionName: RawUTF8;
  EraseSectionHeader: boolean=true): boolean;
var P: PUTF8Char;
    UpperSection: array[byte] of AnsiChar;
begin
  result := false; // no modification
  P := pointer(Content);
  PWord(UpperCopy255(UpperSection,SectionName))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then
    result := DeleteSection(P,Content,EraseSectionHeader);
end;

function DeleteSection(SectionFirstLine: PUTF8Char; var Content: RawUTF8;
  EraseSectionHeader: boolean=true): boolean;
var PEnd: PUTF8Char;
    IndexBegin: PtrInt;
begin
  result := false;
  PEnd := SectionFirstLine;
  if EraseSectionHeader then // erase [Section] header line
    while (PtrUInt(SectionFirstLine)>PtrUInt(Content)) and (SectionFirstLine^<>'[') do dec(SectionFirstLine);
  while (PEnd<>nil) and (PEnd^<>'[') do
    PEnd := GotoNextLine(PEnd);
  IndexBegin := SectionFirstLine-pointer(Content);
  if IndexBegin=0 then
    exit; // no modification
  if PEnd=nil then
    SetLength(Content,IndexBegin) else
    delete(Content,IndexBegin+1,PEnd-SectionFirstLine);
  result := true; // Content was modified
end;

procedure ReplaceSection(SectionFirstLine: PUTF8Char;
  var Content: RawUTF8; const NewSectionContent: RawUTF8);
var PEnd: PUTF8Char;
    IndexBegin: PtrInt;
begin
  if SectionFirstLine=nil then
    exit;
  // delete existing [Section] content
  PEnd := SectionFirstLine;
  while (PEnd<>nil) and (PEnd^<>'[') do
    PEnd := GotoNextLine(PEnd);
  IndexBegin := SectionFirstLine-pointer(Content);
  if PEnd=nil then
    SetLength(Content,IndexBegin) else
    delete(Content,IndexBegin+1,PEnd-SectionFirstLine);
  // insert section content
  insert(NewSectionContent,Content,IndexBegin+1);
end;

procedure ReplaceSection(var Content: RawUTF8; const SectionName,
  NewSectionContent: RawUTF8);
var UpperSection: array[byte] of AnsiChar;
    P: PUTF8Char;
begin
  P := pointer(Content);
  PWord(UpperCopy255(UpperSection,SectionName))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then
    ReplaceSection(P,Content,NewSectionContent) else
    Content := Content+'['+SectionName+']'#13#10+NewSectionContent;
end;

function FindIniNameValueInteger(P: PUTF8Char; UpperName: PAnsiChar): PtrInt;
begin
  result := GetInteger(pointer(FindIniNameValue(P,UpperName)));
end;

function FindIniEntry(const Content, Section, Name: RawUTF8): RawUTF8;
var P: PUTF8Char;
    UpperSection, UpperName: array[byte] of AnsiChar;
    // possible GPF if length(Section/Name)>255, but should const in code
begin
  result := '';
  P := pointer(Content);
  if P=nil then exit;
  // UpperName := UpperCase(Name)+'=';
  PWord(UpperCopy255(UpperName,Name))^ := ord('=');
  if Section='' then
     // find the Name= entry before any [Section]
    result := FindIniNameValue(P,UpperName) else begin
     // find the Name= entry in the specified [Section]
    PWord(UpperCopy255(UpperSection,Section))^ := ord(']');
    if FindSectionFirstLine(P,UpperSection) then
      result := FindIniNameValue(P,UpperName);
  end;
end;

function FindWinAnsiIniEntry(const Content, Section,Name: RawUTF8): RawUTF8;
begin
  result := WinAnsiToUtf8(WinAnsiString(FindIniEntry(Content,Section,Name)));
end;

function FindIniEntryInteger(const Content,Section,Name: RawUTF8): integer;
begin
  result := GetInteger(pointer(FindIniEntry(Content,Section,Name)));
end;

function FindIniEntryFile(const FileName: TFileName; const Section,Name: RawUTF8): RawUTF8;
var Content: RawUTF8;
begin
  Content := StringFromFile(FileName);
  if Content='' then
    result := '' else
    result := FindIniEntry(Content,Section,Name);
end;

function UpdateIniNameValueInternal(var Content: RawUTF8;
  const NewValue, NewValueCRLF: RawUTF8; var P: PUTF8Char;
  UpperName: PAnsiChar; UpperNameLength: integer): boolean;
var PBeg: PUTF8Char;
    i: integer;
begin
  while (P<>nil) and (P^<>'[') do begin
    while P^=' ' do inc(P);   // trim left ' '
    PBeg := P;
    P := GotoNextLine(P);
    if IdemPChar(PBeg,UpperName) then begin
     // update Name=Value entry
     result := true;
     inc(PBeg,UpperNameLength);
     i := (PBeg-pointer(Content))+1;
     if (i=length(NewValue)) and CompareMem(PBeg,pointer(NewValue),i) then
       exit; // new Value is identical to the old one -> no change
     if P=nil then // avoid last line (P-PBeg) calculation error
       SetLength(Content,i-1) else
       delete(Content,i,P-PBeg); // delete old Value
     insert(NewValueCRLF,Content,i); // set new value
     exit;
    end;
  end;
  result := false;
end;

function UpdateIniNameValue(var Content: RawUTF8; const Name, UpperName, NewValue: RawUTF8): boolean;
var P: PUTF8Char;
begin
  if UpperName='' then
    result := false else begin
    P := pointer(Content);
    result := UpdateIniNameValueInternal(Content,NewValue,NewValue+#13#10,P,
      pointer(UpperName),length(UpperName));
    if result or (Name='') then
      exit;
    if Content<>'' then
      Content := Content+#13#10;
    Content := Content+Name+NewValue;
    result := true;
  end;
end;

procedure UpdateIniEntry(var Content: RawUTF8; const Section,Name,Value: RawUTF8);
const CRLF = #13#10;
var P: PUTF8Char;
    SectionFound: boolean;
    i, UpperNameLength: PtrInt;
    V: RawUTF8;
    UpperSection, UpperName: array[byte] of AnsiChar;
label Sec;
begin
  UpperNameLength := length(Name);
  PWord(UpperCopy255Buf(UpperName,pointer(Name),UpperNameLength))^ := ord('=');
  inc(UpperNameLength);
  V := Value+CRLF;
  P := pointer(Content);
  // 1. find Section, and try update within it
  if Section='' then
    goto Sec; // find the Name= entry before any [Section]
  SectionFound := false;
  PWord(UpperCopy255(UpperSection,Section))^ := ord(']');
  if FindSectionFirstLine(P,UpperSection) then begin
Sec:SectionFound := true;
    if UpdateIniNameValueInternal(Content,Value,V,P,@UpperName,UpperNameLength) then
      exit;
    // we reached next [Section] without having found Name=
   end;
  // 2. section or Name= entry not found: add Name=Value
  V := Name+'='+V;
  if not SectionFound then
    // create not existing [Section]
    V := '['+Section+(']'+CRLF)+V;
  // insert Name=Value at P^ (end of file or end of [Section])
  if P=nil then
    // insert at end of file
    Content := Content+V else begin
    // insert at end of [Section]
    i := (P-pointer(Content))+1;
    insert(V,Content,i);
  end;
end;

procedure UpdateIniEntryFile(const FileName: TFileName; const Section,Name,Value: RawUTF8);
var Content: RawUTF8;
begin
  Content := StringFromFile(FileName);
  UpdateIniEntry(Content,Section,Name,Value);
  FileFromString(Content,FileName);
end;

function StringFromFile(const FileName: TFileName; HasNoSize: boolean): RawByteString;
var F: THandle;
    Read, Size: integer;
    tmp: array[0..$7fff] of AnsiChar;
begin
  result := '';
  if FileName='' then
    exit;
  F := FileOpenSequentialRead(FileName);
  if PtrInt(F)>=0 then begin
    if HasNoSize then begin
      Size := 0;
      repeat
        Read := FileRead(F,tmp,SizeOf(tmp));
        if Read<=0 then
          break;
        SetLength(result,Size+Read);
        {$ifdef FPC}Move{$else}MoveFast{$endif}(tmp,PByteArray(result)^[Size],Read);
        inc(Size,Read);
      until false;
    end else begin
      Size := GetFileSize(F,nil);
      if Size>0 then begin
        SetLength(result,Size);
        if FileRead(F,pointer(result)^,Size)<>Size then
          result := '';
      end;
    end;
    FileClose(F);
  end;
end;

function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean; FileDate: TDateTime): boolean;
var F: THandle;
    P: PByte;
    L,written: integer;
begin
  result := false;
  if FileName='' then
    exit;
  F := FileCreate(FileName);
  if PtrInt(F)<0 then
    exit;
  L := length(Content);
  P := pointer(Content);
  while L>0 do begin
    written := FileWrite(F,P^,L);
    if written<0 then begin
      FileClose(F);
      exit;
    end;
    dec(L,written);
    inc(P,written);
  end;
  if FlushOnDisk then
    FlushFileBuffers(F);
  {$ifdef MSWINDOWS}
  if FileDate<>0 then
    FileSetDate(F,DateTimeToFileDate(FileDate));
  FileClose(F);
  {$else}
  FileClose(F);
  if FileDate<>0 then
    FileSetDate(FileName,DateTimeToFileDate(FileDate));
  {$endif}
  result := true;
end;

type
  TTextFileKind = (isUnicode, isUTF8, isAnsi);

function TextFileKind(const Map: TMemoryMap): TTextFileKind;
begin
  result := isAnsi;
  if (Map.Buffer<>nil) and (Map.Size>3) then
    if PWord(Map.Buffer)^=$FEFF then
      result := isUnicode else
    if (PWord(Map.Buffer)^=$BBEF) and (PByteArray(Map.Buffer)[2]=$BF) then
      result := isUTF8;
end;

function AnyTextFileToSynUnicode(const FileName: TFileName; ForceUTF8: boolean): SynUnicode;
var Map: TMemoryMap;
begin
  result := '';
  if Map.Map(FileName) then
  try
    if ForceUTF8 then
      UTF8ToSynUnicode(PUTF8Char(Map.Buffer),Map.Size,Result) else
    case TextFileKind(Map) of
    isUnicode:
      SetString(result,PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      UTF8ToSynUnicode(PUTF8Char(pointer(PtrUInt(Map.Buffer)+3)),Map.Size-3,Result);
    isAnsi:
      result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer, Map.Size);
    end;
  finally
    Map.UnMap;
  end;
end;

function AnyTextFileToRawUTF8(const FileName: TFileName; AssumeUTF8IfNoBOM: boolean): RawUTF8;
var Map: TMemoryMap;
begin
  result := '';
  if Map.Map(FileName) then
  try
    case TextFileKind(Map) of
    isUnicode:
      RawUnicodeToUtf8(PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1,Result);
    isUTF8:
      FastSetString(result,pointer(PtrUInt(Map.Buffer)+3),Map.Size-3);
    isAnsi:
      if AssumeUTF8IfNoBOM then
        FastSetString(result,Map.Buffer,Map.Size) else
        result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Map.Buffer, Map.Size);
    end;
  finally
    Map.UnMap;
  end;
end;

function AnyTextFileToString(const FileName: TFileName; ForceUTF8: boolean): string;
var Map: TMemoryMap;
begin
  result := '';
  if Map.Map(FileName) then
  try
    if ForceUTF8 then
{$ifdef UNICODE}
      UTF8DecodeToString(PUTF8Char(Map.Buffer),Map.Size,result) {$else}
      result := CurrentAnsiConvert.UTF8BufferToAnsi(PUTF8Char(Map.Buffer),Map.Size)
{$endif} else
    case TextFileKind(Map) of
{$ifdef UNICODE}
    isUnicode:
      SetString(result,PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      UTF8DecodeToString(pointer(PtrUInt(Map.Buffer)+3),Map.Size-3,result);
    isAnsi:
      result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer,Map.Size);
{$else}
    isUnicode:
      result := CurrentAnsiConvert.UnicodeBufferToAnsi(PWideChar(PtrUInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(PtrUInt(Map.Buffer)+3),Map.Size-3);
    isAnsi:
      SetString(result,PAnsiChar(Map.Buffer),Map.Size);
{$endif}
    end;
  finally
    Map.UnMap;
  end;
end;

function StreamToRawByteString(aStream: TStream): RawByteString;
var current, size: Int64;
begin
  result := '';
  if aStream=nil then
    exit;
  current := aStream.Position;
  if (current=0) and aStream.InheritsFrom(TRawByteStringStream) then begin
    result := TRawByteStringStream(aStream).DataString; // fast COW
    exit;
  end;
  size := aStream.Size-current;
  if (size=0) or (size>maxInt) then
    exit;
  SetLength(result,size);
  aStream.Read(pointer(result)^,size);
  aStream.Position := current;
end;

function RawByteStringToStream(const aString: RawByteString): TStream;
begin
  result := TRawByteStringStream.Create(aString);
end;

function ReadStringFromStream(S: TStream; MaxAllowedSize: integer): RawUTF8;
var L: integer;
begin
  result := '';
  L := 0;
  if (S.Read(L,4)<>4) or (L<=0) or (L>MaxAllowedSize) then
    exit;
  SetLength(result,L);
  if S.Read(pointer(result)^,L)<>L then
    result := '';
end;

function WriteStringToStream(S: TStream; const Text: RawUTF8): boolean;
var L: integer;
begin
  L := length(Text);
  if L=0 then
    result := S.Write(L,4)=4 else
    {$ifdef FPC}
    result := (S.Write(L,4)=4) and (S.Write(pointer(Text)^,L)=L);
    {$else}
    result := S.Write(pointer(PtrInt(Text)-SizeOf(integer))^,L+4)=L+4;
    {$endif}
end;

function GetFileNameWithoutExt(const FileName: TFileName;
  Extension: PFileName): TFileName;
var i, max: PtrInt;
begin
  i := length(FileName);
  max := i-16;
  while (i>0) and not(cardinal(FileName[i]) in [ord('\'),ord('/'),ord('.')])
    and (i>=max) do dec(i);
  if (i=0) or (FileName[i]<>'.') then begin
    result := FileName;
    if Extension<>nil then
      Extension^ := '';
  end else begin
    result := copy(FileName,1,i-1);
    if Extension<>nil then
      Extension^ := copy(FileName,i,20);
  end;
end;

function GetFileNameExtIndex(const FileName, CSVExt: TFileName): integer;
var Ext: TFileName;
    P: PChar;
begin
  result := -1;
  P := pointer(CSVExt);
  Ext := ExtractFileExt(FileName);
  if (P=nil) or (Ext='') or (Ext[1]<>'.') then
    exit;
  delete(Ext,1,1);
  repeat
    inc(result);
    if SameText(GetNextItemString(P),Ext) then
      exit;
  until P=nil;
  result := -1;
end;

function FileSize(const FileName: TFileName): Int64;
{$ifdef MSWINDOWS}
var FA: WIN32_FILE_ATTRIBUTE_DATA;
begin // 5 times faster than CreateFile, GetFileSizeEx, CloseHandle
  if GetFileAttributesEx(pointer(FileName),GetFileExInfoStandard,@FA) then begin
    PInt64Rec(@result)^.Lo := FA.nFileSizeLow;
    PInt64Rec(@result)^.Hi := FA.nFileSizeHigh;
  end else
    result := 0;
end;
{$else}
var f: THandle;
    res: Int64Rec absolute result;
begin
  result := 0;
  f := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(f)>0 then begin
    res.Lo := GetFileSize(f,@res.Hi); // from SynKylix/SynFPCLinux
    FileClose(f);
  end;
end;
{$endif}

function FileSize(F: THandle): Int64;
var res: Int64Rec absolute result;
begin
  result := 0;
  if PtrInt(F)>0 then
    res.Lo := GetFileSize(F,@res.Hi); // from WinAPI or SynKylix/SynFPCLinux
end;

function FileInfoByHandle(aFileHandle: THandle; out FileId, FileSize,
  LastWriteAccess, FileCreateDateTime: Int64): Boolean;
var
 lastreadaccess: TUnixMSTime;
 {$ifdef MSWINDOWS}
 lp: TByHandleFileInformation;
 {$else}
 lp: {$ifdef FPC}stat{$else}TStatBuf64{$endif};
 r: integer;
 {$endif MSWINDOWS}
begin
{$ifdef MSWINDOWS}
  result := GetFileInformationByHandle(aFileHandle,lp);
  if not result then
    exit;
  LastWriteAccess := FileTimeToUnixMSTime(lp.ftLastWriteTime);
  FileCreateDateTime := FileTimeToUnixMSTime(lp.ftCreationTime);
  lastreadaccess := FileTimeToUnixMSTime(lp.ftLastAccessTime);
  PInt64Rec(@FileSize).lo := lp.nFileSizeLow;
  PInt64Rec(@FileSize).hi := lp.nFileSizeHigh;
  PInt64Rec(@FileId).lo := lp.nFileIndexLow;
  PInt64Rec(@FileId).hi := lp.nFileIndexHigh;
{$else}
  r := {$ifdef FPC}FpFStat{$else}fstat64{$endif}(aFileHandle, lp);
  result := r >= 0;
  if not result then
    exit;
  FileId := lp.st_ino;
  FileSize := lp.st_size;
  lastreadaccess := lp.st_atime * MSecsPerSec;
  LastWriteAccess := lp.st_mtime * MSecsPerSec;
  {$ifdef OPENBSD}
  if (lp.st_birthtime <> 0) and (lp.st_birthtime < lp.st_ctime) then
    lp.st_ctime:= lp.st_birthtime;
  {$endif}
  FileCreateDateTime := lp.st_ctime * MSecsPerSec;
{$endif MSWINDOWS}
  if LastWriteAccess <> 0 then
    if (FileCreateDateTime = 0) or (FileCreateDateTime > LastWriteAccess) then
      FileCreateDateTime:= LastWriteAccess;
  if lastreadaccess <> 0 then
    if (FileCreateDateTime = 0) or (FileCreateDateTime > lastreadaccess) then
      FileCreateDateTime:= lastreadaccess;
end;

function FileAgeToDateTime(const FileName: TFileName): TDateTime;
{$ifdef MSWINDOWS}
var FA: WIN32_FILE_ATTRIBUTE_DATA;
    ST,LT: TSystemTime;
begin // 5 times faster than CreateFile, GetFileSizeEx, CloseHandle
  if GetFileAttributesEx(pointer(FileName),GetFileExInfoStandard,@FA) and
     FileTimeToSystemTime(FA.ftLastWriteTime,ST) and
     SystemTimeToTzSpecificLocalTime(nil,ST,LT) then
    result := SystemTimeToDateTime(LT) else
    result := 0;
end;
{$else}
{$ifdef HASNEWFILEAGE}
begin
  if not FileAge(FileName,result) then
{$else}
var Age: integer;
begin
  Age := FileAge(FileName);
  if Age<>-1 then
    result := FileDateToDateTime(Age) else
{$endif HASNEWFILEAGE}
    result := 0;
end;
{$endif MSWINDOWS}

function CopyFile(const Source, Target: TFileName; FailIfExists: boolean): boolean;
{$ifdef MSWINDOWS}
begin
  result := Windows.CopyFile(pointer(Source),pointer(Target),FailIfExists);
end;
{$else}
var SourceF, DestF: TFileStream;
begin
  result := false;
  if FailIfExists then
    if FileExists(Target) then
      exit else
      DeleteFile(Target);
  try
    SourceF := TFileStream.Create(Source,fmOpenRead);
    try
      DestF := TFileStream.Create(Target,fmCreate);
      try
        DestF.CopyFrom(SourceF, SourceF.Size);
      finally
        DestF.Free;
      end;
      FileSetDateFrom(Target,SourceF.Handle);
    finally
      SourceF.Free;
    end;
    result := true;
  except
    result := false;
  end;
end;
{$endif}

function SearchRecToDateTime(const F: TSearchRec): TDateTime;
begin
  {$ifdef ISDELPHIXE}
  result := F.Timestamp;
  {$else}
  result := FileDateToDateTime(F.Time);
  {$endif}
end;

function SearchRecValidFile(const F: TSearchRec): boolean; 
begin
  {$ifndef DELPHI5OROLDER}
  {$WARN SYMBOL_DEPRECATED OFF} // for faVolumeID
  {$endif}
  result := (F.Name<>'') and (F.Attr and (faDirectory
    {$ifdef MSWINDOWS}+faVolumeID+faSysFile+faHidden)=0) and (F.Name[1]<>'.')
    {$else})=0){$endif};
  {$ifndef DELPHI5OROLDER}
  {$WARN SYMBOL_DEPRECATED ON}
  {$endif}
end;

function DirectoryDelete(const Directory: TFileName; const Mask: TFileName;
  DeleteOnlyFilesNotDirectory: Boolean; DeletedCount: PInteger): Boolean;
var F: TSearchRec;
    Dir: TFileName;
    n: integer;
begin
  n := 0;
  result := true;
  if DirectoryExists(Directory) then begin
    Dir := IncludeTrailingPathDelimiter(Directory);
    if FindFirst(Dir+Mask,faAnyFile-faDirectory,F)=0 then begin
      repeat
        if SearchRecValidFile(F) then
          if DeleteFile(Dir+F.Name) then
            inc(n) else
            result := false;
      until FindNext(F)<>0;
      FindClose(F);
    end;
    if not DeleteOnlyFilesNotDirectory and not RemoveDir(Dir) then
      result := false;
  end;
  if DeletedCount<>nil then
    DeletedCount^ := n;
end;

function DirectoryDeleteOlderFiles(const Directory: TFileName; TimePeriod: TDateTime;
   const Mask: TFileName; Recursive: Boolean; TotalSize: PInt64): Boolean;
var F: TSearchRec;
    Dir: TFileName;
    old: TDateTime;
begin
  if not Recursive and (TotalSize<>nil) then
    TotalSize^ := 0;
  result := true;
  if (Directory='') or not DirectoryExists(Directory) then
    exit;
  Dir := IncludeTrailingPathDelimiter(Directory);
  if FindFirst(Dir+Mask,faAnyFile,F)=0 then begin
    old := Now - TimePeriod;
    repeat
      if F.Name[1]<>'.' then
        if Recursive and (F.Attr and faDirectory<>0) then
          DirectoryDeleteOlderFiles(Dir+F.Name,TimePeriod,Mask,true,TotalSize) else
        if SearchRecValidFile(F) and (SearchRecToDateTime(F) < old) then
          if not DeleteFile(Dir+F.Name) then
            result := false else
            if TotalSize<>nil then
              inc(TotalSize^,F.Size);
    until FindNext(F)<>0;
    FindClose(F);
  end;
end;

procedure TFindFiles.FromSearchRec(const Directory: TFileName; const F: TSearchRec);
begin
  Name := Directory+F.Name;
  {$ifdef MSWINDOWS}
  {$ifdef HASINLINE} // FPC or Delphi 2006+
  Size := F.Size;
  {$else} // F.Size was limited to 32-bit on older Delphi
  PInt64Rec(@Size)^.Lo := F.FindData.nFileSizeLow;
  PInt64Rec(@Size)^.Hi := F.FindData.nFileSizeHigh;
  {$endif}
  {$else}
  Size := F.Size;
  {$endif}
  Attr := F.Attr;
  Timestamp := SearchRecToDateTime(F);
end;

function TFindFiles.ToText: shortstring;
begin
  FormatShort('% % %',[Name,KB(Size),DateTimeToFileShort(Timestamp)],result);
end;

function FindFiles(const Directory,Mask,IgnoreFileName: TFileName;
  SortByName,IncludesDir,SubFolder: boolean): TFindFilesDynArray;
var m,count: integer;
    Dir: TFileName;
    da: TDynArray;
    masks: TRawUTF8DynArray;
    masked: TFindFilesDynArray;
  procedure SearchFolder(const folder : TFileName);
  var
    F: TSearchRec;
    ff: TFindFiles;
  begin
    if FindFirst(Dir+folder+Mask,faAnyfile-faDirectory,F)=0 then begin
      repeat
        if SearchRecValidFile(F) and ((IgnoreFileName='') or
            (AnsiCompareFileName(F.Name,IgnoreFileName)<>0)) then begin
          if IncludesDir then
            ff.FromSearchRec(Dir+folder,F) else
            ff.FromSearchRec(folder,F);
          da.Add(ff);
        end;
      until FindNext(F)<>0;
      FindClose(F);
    end;
    if SubFolder and (FindFirst(Dir+folder+'*',faDirectory,F)=0) then begin
      repeat
        if (F.Name<>'.') and (F.Name<>'..') and ((IgnoreFileName='') or
            (AnsiCompareFileName(F.Name,IgnoreFileName)<>0)) then
          SearchFolder(IncludeTrailingPathDelimiter(folder+F.Name));
      until FindNext(F)<>0;
      FindClose(F);
    end;
  end;
begin
  result := nil;
  da.Init(TypeInfo(TFindFilesDynArray),result,@count);
  if Pos(';',Mask)>0 then
    CSVToRawUTF8DynArray(pointer(StringToUTF8(Mask)),masks,';');
  if masks<>nil then begin
    if SortByName then
      QuickSortRawUTF8(masks,length(masks),nil,{$ifdef MSWINDOWS}@StrIComp{$else}@StrComp{$endif});
    for m := 0 to high(masks) do begin // masks[] recursion
      masked := FindFiles(Directory,UTF8ToString(masks[m]),
        IgnoreFileName,SortByName,IncludesDir,SubFolder);
      da.AddArray(masked);
    end;
  end else begin
    if Directory<>'' then
      Dir := IncludeTrailingPathDelimiter(Directory);
    SearchFolder('');
    if SortByName and (da.Count>0) then
      da.Sort(SortDynArrayFileName);
  end;
  da.Capacity := count; // trim result[]
end;

function FindFilesDynArrayToFileNames(const Files: TFindFilesDynArray): TFileNameDynArray;
var i,n: integer;
begin
  n := length(Files);
  SetLength(result,n);
  for i := 0 to n-1 do
    result[i] := Files[i].Name;
end;

function EnsureDirectoryExists(const Directory: TFileName;
  RaiseExceptionOnCreationFailure: boolean=false): TFileName;
begin
  result := IncludeTrailingPathDelimiter(ExpandFileName(Directory));
  if not DirectoryExists(result) then
    if not CreateDir(result) then
      if not RaiseExceptionOnCreationFailure then
        result := '' else
        raise ESynException.CreateUTF8('Impossible to create folder %',[result]);
end;

var
  TemporaryFileNameRandom: integer;

function TemporaryFileName: TFileName;
var folder: TFileName;
begin // fast cross-platform implementation
  folder := GetSystemPath(spTempFolder);
  if TemporaryFileNameRandom=0 then
    TemporaryFileNameRandom := Random32;
  repeat // thread-safe unique file name generation
    FormatString('%%_%.tmp',[folder,ExeVersion.ProgramName,
      CardinalToHexShort(InterlockedIncrement(TemporaryFileNameRandom))],string(result));
  until not FileExists(result);
end;

function IsDirectoryWritable(const Directory: TFileName): boolean;
var fn: TFileName;
begin
  fn := ExcludeTrailingPathDelimiter(Directory);
  result := {$ifndef DELPHI5OROLDER}not FileIsReadOnly{$else}DirectoryExists{$endif}(fn);
  if not result then
    exit;
  fn := FormatString('%%.%%',[fn,PathDelim,CardinalToHexShort(integer(GetCurrentThreadID)),
    BinToBase64uriShort(@ExeVersion.Hash,SizeOf(ExeVersion.Hash))]);
  result := FileFromString('tobedeleted',fn); // actually try to write something
  DeleteFile(fn);
end;

{$ifdef DELPHI5OROLDER}

function DirectoryExists(const Directory: string): boolean;
var Code: Integer;
begin
  Code := GetFileAttributes(pointer(Directory));
  result := (Code<>-1) and (FILE_ATTRIBUTE_DIRECTORY and Code<>0);
end;

function SameFileName(const S1, S2: TFileName): Boolean;
begin
  result := AnsiCompareFileName(S1,S2)=0;
end;

function GetEnvironmentVariable(const Name: string): string;
var Len: Integer;
    Buffer: array[0..1023] of Char;
begin
  Result := '';
  Len := Windows.GetEnvironmentVariable(pointer(Name),@Buffer,SizeOf(Buffer));
  if Len<SizeOf(Buffer) then
    SetString(result,Buffer,Len) else begin
    SetLength(result,Len-1);
    Windows.GetEnvironmentVariable(pointer(Name),pointer(result),Len);
  end;
end;

function GetModuleName(Module: HMODULE): TFileName;
var tmp: array[byte] of char;
begin
  SetString(Result,tmp,GetModuleFileName(Module,tmp,SizeOf(tmp)));
end;

function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin
  if (Hour<24) and (Min<60) and (Sec<60) and (MSec<1000) then begin
    Time := (Hour*3600000+Min*60000+Sec*1000+MSec)/MSecsPerDay;
    result := true;
  end else
    result := false;
end;

function ExcludeTrailingPathDelimiter(const FileName: TFileName): TFileName;
begin
  result := ExcludeTrailingBackslash(FileName);
end;

function IncludeTrailingPathDelimiter(const FileName: TFileName): TFileName;
begin
  result := IncludeTrailingBackslash(FileName);
end;

procedure RaiseLastOSError;
var LastError: Integer;
    Error: EOSError;
begin
  LastError := GetLastError;
  if LastError <> 0 then
    Error := EOSError.CreateFmt('System Error.  Code: %d.'#13#10'%s',
      [LastError,SysErrorMessage(LastError)]) else
    Error := EOSError.Create('A call to an OS function failed');
  Error.ErrorCode := LastError;
  raise Error;
end;

{$endif DELPHI5OROLDER}

{$ifdef DELPHI6OROLDER}
procedure VarCastError;
begin
  raise EVariantError.Create('Variant Type Cast Error');
end;
{$endif}

{$ifdef MSWINDOWS}
function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;
var FileTime: TFileTime;
    D: THandle;
begin
  D := FileOpen(Dest,fmOpenWrite);
  if D<>THandle(-1) then begin
    result := GetFileTime(SourceHandle,nil,nil,@FileTime) and
              SetFileTime(D,nil,nil,@FileTime);
    FileClose(D);
  end else
    result := false;
end;
{$else}
function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;
begin
  result := FileSetDate(Dest,FileGetDate(SourceHandle))=0;
end;
{$endif}

{$IFDEF PUREPASCAL}
{$IFNDEF HASCODEPAGE}
function Pos(const substr, str: RawUTF8): Integer; overload;
begin // the RawByteString version is fast enough
  Result := PosEx(substr,str,1);
end;
{$ENDIF}
{$ENDIF}

function FindObjectEntry(const Content, Name: RawUTF8): RawUTF8;
var L: integer;
begin
  result := Trim(FindIniEntry(Content,'',Name+' ')); // 'Name = Value' format
  if (result<>'') and (result[1]='''') then begin
    L := length(result);
    if result[L]='''' then
      result := copy(result,2,L-2); // 'testDI6322.IAS' -> testDI6322.IAS
  end;
end;

function FindObjectEntryWithoutExt(const Content, Name: RawUTF8): RawUTF8;
begin
  result := RawUTF8(GetFileNameWithoutExt(
    ExtractFileName(TFileName(FindObjectEntry(Content,Name)))));
end;

procedure TPropNameList.Init;
begin
  Count := 0;
end;

function TPropNameList.FindPropName(const Value: RawUTF8): Integer;
begin
  for result := 0 to Count-1 do
    if IdemPropNameU(Values[result],Value) then
      exit;
  result := -1;
end;

function TPropNameList.AddPropName(const Value: RawUTF8): Boolean;
begin
  if FindPropName(Value)<0 then begin
    if Count=length(Values) then
      SetLength(Values,Count+16);
    Values[Count] := Value;
    inc(Count);
    result := true;
  end else
    result := false;
end;

function Int64ScanExists(P: PInt64Array; Count: PtrInt; const Value: Int64): boolean;
var i: PtrInt;
begin
  if P<>nil then begin
    result := true;
    for i := 1 to (Count shr 2) do   // 4 QWORD by loop - aligned read
      if (P^[0]=Value) or (P^[1]=Value) or
         (P^[2]=Value) or (P^[3]=Value) then
        exit else
        inc(PByte(P),SizeOf(P^[0])*4);
    for i := 0 to (Count and 3)-1 do // last 0..3 QWORD
      if P^[i]=Value then
        exit;
  end;
  result := false;
end;

function Int64Scan(P: PInt64Array; Count: PtrInt; const Value: Int64): PInt64;
var i: PtrInt;
begin
  if P<>nil then begin
    for i := 1 to Count shr 2 do      // 4 QWORD by loop - aligned read
      if P^[0]<>Value then
      if P^[1]<>Value then
      if P^[2]<>Value then
      if P^[3]=Value then begin
        result := @P^[3];
        exit;
      end else
        inc(PByte(P),SizeOf(P^[0])*4) else begin
        result := @P^[2];
        exit;
      end else begin
        result := @P^[1];
        exit;
      end else begin
        result := pointer(P);
        exit;
      end;
    for i := 0 to (Count and 3)-1 do  // last 0..3 QWORD
      if P^[i]=Value then begin
        result := @P^[i];
        exit;
      end;
  end;
  result := nil;
end;

function AddInteger(var Values: TIntegerDynArray; Value: integer;
  NoDuplicates: boolean=false): boolean;
var n: PtrInt;
begin
  n := Length(Values);
  if NoDuplicates and IntegerScanExists(pointer(Values),n,Value) then begin
    result := false;
    exit;
  end;
  SetLength(Values,n+1);
  Values[n] := Value;
  result := true
end;

procedure AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer);
begin
  if ValuesCount=length(Values) then
    SetLength(Values,NextGrow(ValuesCount));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
end;

function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; NoDuplicates: boolean): boolean;
begin
  if NoDuplicates and IntegerScanExists(pointer(Values),ValuesCount,Value) then begin
    result := false;
    exit;
  end;
  if ValuesCount=length(Values) then
    SetLength(Values,NextGrow(ValuesCount));
  Values[ValuesCount] := Value;
  inc(ValuesCount);
  result := true;
end;

function AddInteger(var Values: TIntegerDynArray; const Another: TIntegerDynArray): PtrInt;
var v,a: PtrInt;
begin
  v := length(Values);
  a := length(Another);
  if a>0 then begin
    SetLength(Values,v+a);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Another[0],Values[v],a*SizeOf(Integer));
  end;
  result := v+a;
end;

function AddWord(var Values: TWordDynArray; var ValuesCount: integer; Value: Word): PtrInt;
begin
  result := ValuesCount;
  if result=length(Values) then
    SetLength(Values,NextGrow(result));
  Values[result] := Value;
  inc(ValuesCount);
end;

function AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: Int64): PtrInt;
begin
  result := ValuesCount;
  if result=length(Values) then
    SetLength(Values,NextGrow(result));
  Values[result] := Value;
  inc(ValuesCount);
end;

function AddInt64(var Values: TInt64DynArray; Value: Int64): PtrInt;
begin
  result := length(Values);
  SetLength(Values,result+1);
  Values[result] := Value;
end;

function AddInt64(var Values: TInt64DynArray; const Another: TInt64DynArray): PtrInt;
var v,a: PtrInt;
begin
  v := length(Values);
  a := length(Another);
  if a>0 then begin
    SetLength(Values,v+a);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Another[0],Values[v],a*SizeOf(Int64));
  end;
  result := v+a;
end;

procedure AddInt64Sorted(var Values: TInt64DynArray; Value: Int64);
var last: integer;
begin
  last := high(Values);
  if FastFindInt64Sorted(pointer(Values),last,Value)<0 then begin
    inc(last);
    SetLength(Values,last+1);
    Values[last] := Value;
    QuickSortInt64(pointer(Values),0,last);
  end;
end;

function AddInt64Once(var Values: TInt64DynArray; Value: Int64): PtrInt;
begin
  result := Int64ScanIndex(pointer(Values),length(Values),Value);
  if result<0 then
    result := AddInt64(Values,Value);
end;

procedure DeleteWord(var Values: TWordDynArray; Index: PtrInt);
var n: PtrInt;
begin
  n := Length(Values);
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n);
  if n>Index then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Values[Index+1],Values[Index],(n-Index)*SizeOf(Word));
  SetLength(Values,n);
end;

procedure DeleteInteger(var Values: TIntegerDynArray; Index: PtrInt);
var n: PtrInt;
begin
  n := Length(Values);
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n);
  if n>Index then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Values[Index+1],Values[Index],(n-Index)*SizeOf(Integer));
  SetLength(Values,n);
end;

procedure DeleteInteger(var Values: TIntegerDynArray; var ValuesCount: Integer; Index: PtrInt);
var n: PtrInt;
begin
  n := ValuesCount;
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n,Index+1);
  if n>0 then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Values[Index+1],Values[Index],n*SizeOf(Integer));
  dec(ValuesCount);
end;

procedure DeleteInt64(var Values: TInt64DynArray; Index: PtrInt);
var n: PtrInt;
begin
  n := Length(Values);
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n);
  if n>Index then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Values[Index+1],Values[Index],(n-Index)*SizeOf(Int64));
  SetLength(Values,n);
end;

procedure DeleteInt64(var Values: TInt64DynArray; var ValuesCount: Integer; Index: PtrInt);
var n: PtrInt;
begin
  n := ValuesCount;
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n,Index+1);
  if n>0 then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Values[Index+1],Values[Index],n*SizeOf(Int64));
  dec(ValuesCount);
end;

procedure ExcludeInteger(var Values, Excluded: TIntegerDynArray; ExcludedSortSize: integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Excluded=nil) then
    exit; // nothing to exclude
  v := length(Values);
  n := 0;
  x := Length(Excluded);
  if (x>ExcludedSortSize) or (v>ExcludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInteger(pointer(Excluded),0,x);
    for i := 0 to v-1 do
      if FastFindIntegerSorted(pointer(Excluded),x,Values[i])<0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if not IntegerScanExists(pointer(Excluded),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure IncludeInteger(var Values, Included: TIntegerDynArray;
  IncludedSortSize: Integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Included=nil) then begin
    Values := nil;
    exit;
  end;
  v := length(Values);
  n := 0;
  x := Length(Included);
  if (x>IncludedSortSize) or (v>IncludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInteger(pointer(Included),0,x);
    for i := 0 to v-1 do
      if FastFindIntegerSorted(pointer(Included),x,Values[i])>=0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if IntegerScanExists(pointer(Included),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure ExcludeInt64(var Values, Excluded: TInt64DynArray; ExcludedSortSize: Integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Excluded=nil) then
    exit; // nothing to exclude
  v := length(Values);
  n := 0;
  x := Length(Excluded);
  if (x>ExcludedSortSize) or (v>ExcludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInt64(pointer(Excluded),0,x);
    for i := 0 to v-1 do
      if FastFindInt64Sorted(pointer(Excluded),x,Values[i])<0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if not Int64ScanExists(pointer(Excluded),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure IncludeInt64(var Values, Included: TInt64DynArray;
  IncludedSortSize: integer);
var i,v,x,n: PtrInt;
begin
  if (Values=nil) or (Included=nil) then begin
    Values := nil;
    exit;
  end;
  v := length(Values);
  n := 0;
  x := Length(Included);
  if (x>IncludedSortSize) or (v>IncludedSortSize) then begin // sort if worth it
    dec(x);
    QuickSortInt64(pointer(Included),0,x);
    for i := 0 to v-1 do
      if FastFindInt64Sorted(pointer(Included),x,Values[i])>=0 then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  end else
    for i := 0 to v-1 do
      if Int64ScanExists(pointer(Included),x,Values[i]) then begin
        if n<>i then
          Values[n] := Values[i];
        inc(n);
      end;
  if n<>v then
    SetLength(Values,n);
end;

procedure DeduplicateInteger(var Values: TIntegerDynArray);
begin
  DeduplicateInteger(Values, length(Values));
end;

function DeduplicateIntegerSorted(val: PIntegerArray; last: PtrInt): PtrInt;
var i: PtrInt;
begin // sub-function for better code generation
  i := 0;
  repeat // here last>0 so i<last
    if val[i]=val[i+1] then
      break;
    inc(i);
    if i<>last then
      continue;
    result := i;
    exit;
  until false;
  result := i;
  inc(i);
  if i<>last then begin
    repeat
      if val[i]<>val[i+1] then begin
        val[result] := val[i];
        inc(result);
      end;
      inc(i);
    until i=last;
    val[result] := val[i];
  end;
end;

function DeduplicateInteger(var Values: TIntegerDynArray; Count: integer): integer;
begin
  result := Count;
  dec(Count);
  if Count>0 then begin
    QuickSortInteger(pointer(Values),0,Count);
    result := DeduplicateIntegerSorted(pointer(Values),Count)+1;
  end;
  if result<>length(Values) then
    SetLength(Values,result);
end;

procedure DeduplicateInt64(var Values: TInt64DynArray);
begin
  DeduplicateInt64(Values, length(Values));
end;

function DeduplicateInt64Sorted(val: PInt64Array; last: PtrInt): PtrInt;
var i: PtrInt;
begin // sub-function for better code generation
  i := 0;
  repeat // here last>0 so i<last
    if val[i]=val[i+1] then
      break;
    inc(i);
    if i<>last then
      continue;
    result := i;
    exit;
  until false;
  result := i;
  inc(i);
  if i<>last then begin
    repeat
      if val[i]<>val[i+1] then begin
        val[result] := val[i];
        inc(result);
      end;
      inc(i);
    until i=last;
    val[result] := val[i];
  end;
end;

function DeduplicateInt64(var Values: TInt64DynArray; Count: integer): integer;
begin
  result := Count;
  dec(Count);
  if Count>0 then begin
    QuickSortInt64(pointer(Values),0,Count);
    result := DeduplicateInt64Sorted(pointer(Values),Count)+1;
  end;
  if result<>length(Values) then
    SetLength(Values,result);
end;

procedure CopyInteger(const Source: TIntegerDynArray; out Dest: TIntegerDynArray);
var n: integer;
begin
  n := length(Source);
  SetLength(Dest,n);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Source[0],Dest[0],n*SizeOf(Integer));
end;

procedure CopyInt64(const Source: TInt64DynArray; out Dest: TInt64DynArray);
var n: integer;
begin
  n := length(Source);
  SetLength(Dest,n);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Source[0],Dest[0],n*SizeOf(Int64));
end;

function MaxInteger(const Values: TIntegerDynArray; ValuesCount, MaxStart: integer): Integer;
var i: integer;
begin
  result := MaxStart;
  for i := 0 to ValuesCount-1 do
    if Values[i]>result then
      result := Values[i];
end;

function SumInteger(const Values: TIntegerDynArray; ValuesCount: integer): Integer;
var i: integer;
begin
  result := 0;
  for i := 0 to ValuesCount-1 do
    inc(result,Values[i]);
end;

procedure Reverse(const Values: TIntegerDynArray; ValuesCount: integer;
  Reversed: PIntegerArray);
var i: integer;
begin
  i := 0;
  if ValuesCount>=4 then begin
    dec(ValuesCount,4);
    while i<ValuesCount do begin // faster pipelined version
      Reversed[Values[i]] := i;
      Reversed[Values[i+1]] := i+1;
      Reversed[Values[i+2]] := i+2;
      Reversed[Values[i+3]] := i+3;
      inc(i,4);
    end;
    inc(ValuesCount,4);
  end;
  while i<ValuesCount do begin
    Reversed[Values[i]] := i;
    inc(i);
  end;
  //for i := 0 to Count-1 do Assert(Reverse[Orig[i]]=i);
end;

procedure FillIncreasing(Values: PIntegerArray; StartValue: integer; Count: PtrUInt);
var i: PtrUInt;
begin
  if Count>0 then
    if StartValue=0 then
      for i := 0 to Count-1 do
        Values[i] := i else
      for i := 0 to Count-1 do begin
        Values[i] := StartValue;
        inc(StartValue);
      end;
end;

procedure Int64ToUInt32(Values64: PInt64Array; Values32: PCardinalArray; Count: integer);
var i: integer;
begin
  for i := 0 to Count-1 do
    Values32[i] := Values64[i];
end;

procedure CSVToIntegerDynArray(CSV: PUTF8Char; var Result: TIntegerDynArray; Sep: AnsiChar);
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInteger(CSV,Sep);
  end;
end;

procedure CSVToInt64DynArray(CSV: PUTF8Char; var Result: TInt64DynArray; Sep: AnsiChar);
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInt64(CSV,Sep);
  end;
end;

function CSVToInt64DynArray(CSV: PUTF8Char; Sep: AnsiChar): TInt64DynArray;
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInt64(CSV,Sep);
  end;
end;

function IntegerDynArrayToCSV(Values: PIntegerArray; ValuesCount: integer;
  const Prefix, Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
type
  TInts16 = packed array[word] of string[15]; // shortstring are faster (no heap allocation)
var i, L, Len: PtrInt;
    tmp: array[0..15] of AnsiChar;
    ints: ^TInts16;
    P: PAnsiChar;
    tmpbuf: TSynTempBuffer;
begin
  result := '';
  if ValuesCount=0 then
    exit;
  if InlinedValue then
    Len := 4*ValuesCount else
    Len := 0;
  tmpbuf.Init(ValuesCount*SizeOf(ints[0])+Len); // faster than a dynamic array
  try
    ints := tmpbuf.buf;
     // compute whole result length at once
    dec(ValuesCount);
    inc(Len,length(Prefix)+length(Suffix));
    tmp[15] := ',';
    for i := 0 to ValuesCount do begin
      P := StrInt32(@tmp[15],Values[i]);
      L := @tmp[15]-P;
      if i<ValuesCount then
        inc(L); // append tmp[15]=','
      inc(Len,L);
      SetString(ints[i],P,L);
    end;
    // create result
    SetLength(result,Len);
    P := pointer(result);
    if Prefix<>'' then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Prefix)^,P^,length(Prefix));
      inc(P,length(Prefix));
    end;
    for i := 0 to ValuesCount do begin
      if InlinedValue then begin
        PWord(P)^ := ord(':')+ord('(')shl 8;
        inc(P,2);
      end;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(ints[i][1],P^,ord(ints[i][0]));
      inc(P,ord(ints[i][0]));
      if InlinedValue then begin
        PWord(P)^ := ord(')')+ord(':')shl 8;
        inc(P,2);
      end;
    end;
    if Suffix<>'' then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Suffix)^,P^,length(Suffix));
  finally
    tmpbuf.Done;
  end;
end;

function Int64DynArrayToCSV(Values: PInt64Array; ValuesCount: integer;
  const Prefix, Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
type
  TInt = packed record
    Len: byte;
    Val: array[0..19] of AnsiChar; // Int64: 19 digits, then - sign
  end;
var i, L, Len: PtrInt;
    int: ^TInt;
    P: PAnsiChar;
    tmp: TSynTempBuffer;
begin
  result := '';
  if ValuesCount=0 then
    exit;
  if InlinedValue then
    Len := 4*ValuesCount else
    Len := 0;
  int := tmp.Init(ValuesCount*SizeOf(TInt)+Len); // faster than a dynamic array
  try
     // compute whole result length at once
    dec(ValuesCount);
    inc(Len,length(Prefix)+length(Suffix));
    for i := 0 to ValuesCount do begin
      P := StrInt64(PAnsiChar(int)+21,Values[i]);
      L := PAnsiChar(int)+21-P;
      int^.Len := L;
      if i<ValuesCount then
        inc(L); // for ,
      inc(Len,L);
      inc(int);
    end;
    // create result
    SetLength(result,Len);
    P := pointer(result);
    if Prefix<>'' then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Prefix)^,P^,length(Prefix));
      inc(P,length(Prefix));
    end;
    int := tmp.buf;
    repeat
      if InlinedValue then begin
        PWord(P)^ := ord(':')+ord('(')shl 8;
        inc(P,2);
      end;
      L := int^.Len;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(PAnsiChar(int)[21-L],P^,L);
      inc(P,L);
      if InlinedValue then begin
        PWord(P)^ := ord(')')+ord(':')shl 8;
        inc(P,2);
      end;
      if ValuesCount=0 then
        break;
      inc(int);
      P^ := ',';
      inc(P);
      dec(ValuesCount);
    until false;
    if Suffix<>'' then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Suffix)^,P^,length(Suffix));
  finally
    tmp.Done;
  end;
end;

function IntegerDynArrayToCSV(const Values: TIntegerDynArray;
  const Prefix, Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
begin
  result := IntegerDynArrayToCSV(pointer(Values),length(Values),Prefix,Suffix,InlinedValue);
end;

function Int64DynArrayToCSV(const Values: TInt64DynArray;
  const Prefix: RawUTF8; const Suffix: RawUTF8; InlinedValue: boolean): RawUTF8;
begin
  result := Int64DynArrayToCSV(pointer(Values),length(Values),Prefix,Suffix,InlinedValue);
end;

function Int64ScanIndex(P: PInt64Array; Count: PtrInt; const Value: Int64): PtrInt;
var i: PtrInt; // optimized code for speed
begin
  if P<>nil then begin
    result := 0;
    for i := 1 to Count shr 2 do // 4 PtrUInt by loop - aligned read
      if P^[0]<>Value then
      if P^[1]<>Value then
      if P^[2]<>Value then
      if P^[3]<>Value then begin
        inc(PByte(P),SizeOf(P^[0])*4);
        inc(result,4);
      end else begin
        inc(result,3);
        exit;
      end else begin
        inc(result,2);
        exit;
      end else begin
        inc(result,1);
        exit;
      end else
        exit;
    for i := 0 to (Count and 3)-1 do // last 0..3 Int64
      if P^[i]=Value then
        exit else
        inc(result);
  end;
  result := -1;
end;

function QWordScanIndex(P: PQWordArray; Count: PtrInt; const Value: QWord): PtrInt;
begin
  result := Int64ScanIndex(pointer(P),Count,Value); // this is the very same code
end;

function PtrUIntScanExists(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): boolean;
{$ifdef HASINLINE}
begin
  result := {$ifdef CPU64}Int64ScanExists{$else}IntegerScanExists{$endif}(pointer(P),Count,Value);
end;
{$else}
asm
  jmp IntegerScanExists;
end;
{$endif HASINLINE}

function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
{$ifdef HASINLINE}
begin
  result := {$ifdef CPU64}Int64ScanIndex{$else}IntegerScanIndex{$endif}(pointer(P),Count,Value);
end;
{$else}
asm // identical to IntegerScanIndex() asm stub
        push    eax
        call    IntegerScan
        pop     edx
        test    eax, eax
        jnz     @e
        dec     eax // returns -1
        ret
@e:     sub     eax, edx
        shr     eax, 2
end;
{$endif HASINLINE}

function ByteScanIndex(P: PByteArray; Count: PtrInt; Value: Byte): integer;
begin
{$ifdef FPC}
  result := IndexByte(P^,Count,Value); // will use fast FPC SSE version
{$else}
  for result := 0 to Count-1 do
    if P^[result]=Value then
      exit;
  result := -1;
{$endif FPC}
end;

function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): integer;
begin
{$ifdef FPC}
  result := IndexWord(P^,Count,Value); // will use fast FPC SSE version
{$else}
  for result := 0 to Count-1 do
    if P^[result]=Value then
      exit;
  result := -1;
{$endif FPC}
end;

procedure QuickSortInteger(ID: PIntegerArray; L,R: PtrInt);
var I, J, P: PtrInt;
    tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      tmp := ID^[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInteger(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInteger(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortInteger(var ID: TIntegerDynArray);
begin
  QuickSortInteger(pointer(ID),0,high(ID));
end;

procedure QuickSortInteger(ID,CoValues: PIntegerArray; L,R: PtrInt);
var I, J, P: PtrInt;
    tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      tmp := ID[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        tmp := CoValues[J]; CoValues[J] := CoValues[I]; CoValues[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInteger(ID, CoValues, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInteger(ID, CoValues, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortWord(ID: PWordArray; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: word;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      tmp := ID[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortWord(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortWord(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortInt64(ID: PInt64Array; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: Int64;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      {$ifdef CPU64}
      tmp := ID^[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      {$else}
      while ID[I]<ID[P] do inc(I);
      while ID[J]>ID[P] do dec(J);
      {$endif}
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInt64(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInt64(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortQWord(ID: PQWordArray; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: QWord;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      {$ifdef CPUX86} // circumvent QWord comparison slowness (and bug)
      while SortDynArrayQWord(ID[I],ID[P])<0 do inc(I);
      while SortDynArrayQWord(ID[J],ID[P])>0 do dec(J);
      {$else}
      tmp := ID[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      {$endif}
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortQWord(ID, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortQWord(ID, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortInt64(ID,CoValues: PInt64Array; L, R: PtrInt);
var I, J, P: PtrInt;
    tmp: Int64;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      {$ifdef CPU64}
      tmp := ID^[P];
      if ID[I]<tmp then repeat inc(I) until ID[I]>=tmp;
      if ID[J]>tmp then repeat dec(J) until ID[J]<=tmp;
      {$else}
      while ID[I]<ID[P] do inc(I);
      while ID[J]>ID[P] do dec(J);
      {$endif}
      if I <= J then begin
        tmp := ID[J]; ID[J] := ID[I]; ID[I] := tmp;
        tmp := CoValues[J]; CoValues[J] := CoValues[I]; CoValues[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortInt64(ID, CoValues, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortInt64(ID, CoValues, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortPtrInt(P: PPtrIntArray; L, R: PtrInt);
begin
  {$ifdef CPU64}
  QuickSortInt64(PInt64Array(P),L,R);
  {$else}
  QuickSortInteger(PIntegerArray(P),L,R);
  {$endif}
end;

function FastFindPtrIntSorted(P: PPtrIntArray; R: PtrInt; Value: PtrInt): PtrInt;
begin
  {$ifdef CPU64}
  result := FastFindInt64Sorted(PInt64Array(P),R,Value);
  {$else}
  result := FastFindIntegerSorted(PIntegerArray(P),R,Value);
  {$endif}
end;

procedure QuickSortPointer(P: PPointerArray; L, R: PtrInt);
begin
  {$ifdef CPU64}
  QuickSortInt64(PInt64Array(P),L,R);
  {$else}
  QuickSortInteger(PIntegerArray(P),L,R);
  {$endif}
end;

function FastFindPointerSorted(P: PPointerArray; R: PtrInt; Value: pointer): PtrInt;
begin
  {$ifdef CPU64}
  result := FastFindInt64Sorted(PInt64Array(P),R,Int64(Value));
  {$else}
  result := FastFindIntegerSorted(PIntegerArray(P),R,integer(Value));
  {$endif}
end;

procedure NotifySortedIntegerChanges(old, new: PIntegerArray; oldn, newn: PtrInt;
  const added, deleted: TOnNotifySortedIntegerChange; const sender);
var o, n: PtrInt;
begin
  o := 0;
  n := 0;
  repeat
    while (n<newn) and (o<oldn) and (old[o]=new[n]) do begin
      inc(o);
      inc(n);
    end;
    while (o<oldn) and ((n>=newn) or (old[o]<new[n])) do begin
      if Assigned(deleted) then
        deleted(sender,old[o]);
      inc(o);
    end;
    while (n<newn) and ((o>=oldn) or (new[n]<old[o])) do begin
      if Assigned(added) then
        added(sender,new[n]);
      inc(n);
    end;
  until (o>=oldn) and (n>=newn);
end;

procedure CopyAndSortInteger(Values: PIntegerArray; ValuesCount: integer;
  var Dest: TIntegerDynArray);
begin
  if ValuesCount>length(Dest) then
    SetLength(Dest,ValuesCount);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Values^[0],Dest[0],ValuesCount*SizeOf(Integer));
  QuickSortInteger(pointer(Dest),0,ValuesCount-1);
end;

procedure CopyAndSortInt64(Values: PInt64Array; ValuesCount: integer;
  var Dest: TInt64DynArray);
begin
  if ValuesCount>length(Dest) then
    SetLength(Dest,ValuesCount);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Values^[0],Dest[0],ValuesCount*SizeOf(Int64));
  QuickSortInt64(pointer(Dest),0,ValuesCount-1);
end;

function FastFindIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
var L: PtrInt;
    cmp: integer;
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      cmp := P^[result]-Value;
      if cmp=0 then
        exit;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;

function FastFindIntegerSorted(const Values: TIntegerDynArray; Value: integer): PtrInt;
begin
  result := FastFindIntegerSorted(pointer(Values),length(Values)-1,Value);
end;

function FastFindInt64Sorted(P: PInt64Array; R: PtrInt; const Value: Int64): PtrInt;
var L: PtrInt;
    {$ifdef CPUX86}
    cmp: Integer;
    {$endif}
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      {$ifndef CPUX86}
      if P^[result]=Value then
        exit else
      if P^[result]<Value then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$else} // circumvent Int64 comparison slowness
      cmp := SortDynArrayInt64(P^[result],Value);
      if cmp=0 then
        exit else
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$endif}
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;

function FastFindQWordSorted(P: PQWordArray; R: PtrInt; const Value: QWord): PtrInt;
var L: PtrInt;
    {$ifdef CPUX86}
    cmp: Integer;
    {$endif}
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      {$ifndef CPUX86}
      if P^[result]=Value then
        exit else
      if P^[result]<Value then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$else} // circumvent QWord comparison slowness (and bug)
      cmp := SortDynArrayQWord(P^[result],Value);
      if cmp=0 then
        exit else
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      {$endif}
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;

function FastLocateIntegerSorted(P: PIntegerArray; R: PtrInt; Value: integer): PtrInt;
var L,i: PtrInt;
    cmp: integer;
begin
  if R<0 then
    result := 0 else begin
    L := 0;
    result := -1; // return -1 if found
    repeat
      i := (L + R) shr 1;
      cmp := P^[i]-Value;
      if cmp=0 then
        exit;
      if cmp<0 then
        L := i + 1 else
        R := i - 1;
    until L > R;
    while (i>=0) and (P^[i]>=Value) do dec(i);
    result := i+1; // return the index where to insert
  end;
end;

function AddSortedInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; CoValues: PIntegerDynArray=nil): PtrInt;
begin
  result := FastLocateIntegerSorted(pointer(Values),ValuesCount-1,Value);
  if result>=0 then // if Value exists -> fails
    result := InsertInteger(Values,ValuesCount,Value,result,CoValues);
end;

function AddSortedInteger(var Values: TIntegerDynArray;
  Value: integer; CoValues: PIntegerDynArray=nil): PtrInt;
var ValuesCount: integer;
begin
  ValuesCount := length(Values);
  result := FastLocateIntegerSorted(pointer(Values),ValuesCount-1,Value);
  if result>=0 then begin // if Value exists -> fails
    SetLength(Values,ValuesCount+1); // manual size increase
    result := InsertInteger(Values,ValuesCount,Value,result,CoValues);
  end;
end;

function InsertInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: Integer; Index: PtrInt; CoValues: PIntegerDynArray=nil): PtrInt;
var n: PtrInt;
begin
  result := Index;
  n := Length(Values);
  if ValuesCount=n then begin
    n := NextGrow(n);
    SetLength(Values,n);
    if CoValues<>nil then
      SetLength(CoValues^,n);
  end;
  n := ValuesCount;
  if PtrUInt(result)<PtrUInt(n) then begin
    n := (n-result)*SizeOf(Integer);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Values[result],Values[result+1],n);
    if CoValues<>nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(CoValues^[result],CoValues^[result+1],n);
  end else
    result := n;
  Values[result] := Value;
  inc(ValuesCount);
end;

function TIntegerDynArrayFrom(const Values: array of integer): TIntegerDynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function TIntegerDynArrayFrom64(const Values: TInt64DynArray;
  raiseExceptionOnOverflow: boolean=true): TIntegerDynArray;
var i: integer;
const MinInt = -MaxInt-1;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    if Values[i]>MaxInt then
      if raiseExceptionOnOverflow then
        raise ESynException.CreateUTF8('TIntegerDynArrayFrom64: Values[%]=%>%',
          [i,Values[i],MaxInt]) else
        result[i] := MaxInt else
    if Values[i]<MinInt then
      if raiseExceptionOnOverflow then
        raise ESynException.CreateUTF8('TIntegerDynArrayFrom64: Values[%]=%<%',
          [i,Values[i],MinInt]) else
        result[i] := MinInt else
    result[i] := Values[i];
end;

function TInt64DynArrayFrom(const Values: TIntegerDynArray): TInt64DynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function TQwordDynArrayFrom(const Values: TCardinalDynArray): TQwordDynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromI32(const Values: array of integer): TIntegerDynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromU32(const Values: array of cardinal): TCardinalDynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromI64(const Values: array of Int64): TInt64DynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function FromU64(const Values: array of QWord): TQWordDynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

function GetInteger(P: PUTF8Char): PtrInt;
var c: PtrUInt;
    minus: boolean;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+PtrInt(c);
      inc(P);
    until false;
    if minus then
      result := -result;
  end;
end;

function GetInteger(P,PEnd: PUTF8Char): PtrInt;
var c: PtrUInt;
    minus: boolean;
begin
  result := 0;
  if (P=nil) or (P>=PEnd) then
    exit;
  while (P^<=' ') and (P^<>#0) do begin
    inc(P);
    if P=PEnd then
      exit;
  end;
  if P^='-' then begin
    minus := true;
    repeat inc(P); if P=PEnd then exit; until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P); if P=PEnd then exit; until P^<>' ';
  end;
  c := byte(P^)-48;
  if c<=9 then begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+PtrInt(c);
      inc(P);
    until P=PEnd;
    if minus then
      result := -result;
  end;
end;

function GetInteger(P: PUTF8Char; var err: integer): PtrInt;
var c: PtrUInt;
    minus: boolean;
begin
  if P=nil then begin
    result := 0;
    err := 1;
    exit;
  end else
    err := 0;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  c := byte(P^)-48;
  if c>9 then begin
    err := 1;
    result := 0;
    exit;
  end else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then begin
        if byte(P^)<>0 then
          err := 1; // always return 1 as err code -> don't care about char index
        break;
      end else
        result := result*10+PtrInt(c);
      inc(P);
    until false;
  end;
  if minus then
    result := -result;
end;

function GetIntegerDef(P: PUTF8Char; Default: PtrInt): PtrInt;
var err: integer;
begin
  result := GetInteger(P,err);
  if err<>0 then
    result := Default;
end;

function UTF8ToInteger(const value: RawUTF8; Default: PtrInt=0): PtrInt;
var err: integer;
begin
  result := GetInteger(pointer(value),err);
  if err<>0 then
    result := Default;
end;

function UTF8ToInteger(const value: RawUTF8; Min,max: PtrInt; Default: PtrInt=0): PtrInt;
var err: integer;
begin
  result := GetInteger(pointer(value),err);
  if (err<>0) or (result<Min) or (result>max) then
    result := Default;
end;

function ToInteger(const text: RawUTF8; out value: integer): boolean;
var err: integer;
begin
  value := GetInteger(pointer(text),err);
  result := err=0;
end;

function ToCardinal(const text: RawUTF8; out value: cardinal; minimal: cardinal): boolean;
begin
  value := GetCardinalDef(pointer(text),cardinal(-1));
  result := (value<>cardinal(-1)) and (value>=minimal);
end;

function ToInt64(const text: RawUTF8; out value: Int64): boolean;
var err: integer;
begin
  value := GetInt64(pointer(text),err);
  result := err=0;
end;

function UTF8ToInt64(const text: RawUTF8; const default: Int64): Int64;
var err: integer;
begin
  result := GetInt64(pointer(text),err);
  if err<>0 then
    result := default;
end;

function GetBoolean(P: PUTF8Char): boolean;
begin
  if P<>nil then
    case PInteger(P)^ of
      TRUE_LOW:  result := true;
      FALSE_LOW: result := false;
      else result := PWord(P)^<>ord('0');
    end else
    result := false;
end;

function GetCardinalDef(P: PUTF8Char; Default: PtrUInt): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := Default;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  c := byte(P^)-48;
  if c>9 then
    result := Default else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+PtrUInt(c);
      inc(P);
    until false;
  end;
end;

function GetCardinal(P: PUTF8Char): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+PtrUInt(c);
      inc(P);
    until false;
  end;
end;

function GetCardinalW(P: PWideChar): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  if ord(P^) in [1..32] then repeat inc(P) until not(ord(P^) in [1..32]);
  c := word(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := word(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
end;

{$ifdef CPU64}
procedure SetInt64(P: PUTF8Char; var result: Int64);
begin // PtrInt is already int64 -> call PtrInt version
  result := GetInteger(P);
end;
{$else}
procedure SetInt64(P: PUTF8Char; var result: Int64);
var c: cardinal;
    minus: boolean;
begin
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^)-48;
    if c>9 then
      break else
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
    inc(P);
    if PCardinal(@result)^>=high(cardinal)div 10 then begin
      repeat // 64-bit loop
        c := byte(P^)-48;
        if c>9 then
          break;
        result := result shl 3+result+result; // fast result := result*10
        inc(result,c);
        inc(P);
      until false;
      break;
    end;
  until false;
  if minus then
    result := -result;
end;
{$endif}

{$ifdef CPU64}
procedure SetQWord(P: PUTF8Char; var result: QWord);
begin // PtrUInt is already QWord -> call PtrUInt version
  result := GetCardinal(P);
end;
{$else}
procedure SetQWord(P: PUTF8Char; var result: QWord);
var c: cardinal;
begin
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='+' then
    repeat inc(P) until P^<>' ';
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^)-48;
    if c>9 then
      break else
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
    inc(P);
    if PCardinal(@result)^>=high(cardinal)div 10 then begin
      repeat // 64-bit loop
        c := byte(P^)-48;
        if c>9 then
          break;
        result := result shl 3+result+result; // fast result := result*10
        inc(result,c);
        inc(P);
      until false;
      break;
    end;
  until false;
end;
{$endif}

{$ifdef CPU64}
function GetInt64(P: PUTF8Char): Int64;
begin // PtrInt is already int64 -> call previous version
  result := GetInteger(P);
end;
{$else}
function GetInt64(P: PUTF8Char): Int64;
begin
  SetInt64(P,result);
end;
{$endif}

function GetInt64Def(P: PUTF8Char; const Default: Int64): Int64;
var err: integer;
begin
  result := GetInt64(P,err);
  if err>0 then
    result := Default;
end;

{$ifdef CPU64}
function GetInt64(P: PUTF8Char; var err: integer): Int64;
begin // PtrInt is already int64 -> call previous version
  result := GetInteger(P,err);
end;
{$else}
function GetInt64(P: PUTF8Char; var err: integer): Int64;
var c: cardinal;
    minus: boolean;
begin
  err := 0;
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  inc(err);
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^);
    if c<>0 then begin
      dec(c,48);
      inc(err);
      if c>9 then
        exit;
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
      inc(P);
      if PCardinal(@result)^>=high(cardinal)div 10 then begin
        repeat // 64-bit loop
          c := byte(P^);
          if c=0 then begin
            err := 0; // conversion success without error
            break;
          end;
          dec(c,48);
          inc(err);
          if c>9 then
            exit else
            {$ifdef CPU32DELPHI}
            result := result shl 3+result+result;
            {$else}
            result := result*10;
            {$endif}
          inc(result,c);
          if result<0 then
            exit; // overflow (>$7FFFFFFFFFFFFFFF)
          inc(P);
        until false;
        break;
      end;
    end else begin
      err := 0; // reached P^=#0 -> conversion success without error
      break;
    end;
  until false;
  if minus then
    result := -result;
end;
{$endif}

function GetQWord(P: PUTF8Char; var err: integer): QWord;
var c: PtrUInt;
begin
  err := 1; // error
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  c := byte(P^)-48;
  if c>9 then
    exit;
  {$ifdef CPU64}
  result := c;
  inc(P);
  repeat
    c := byte(P^);
    if c=0 then
      break;
    dec(c,48);
    if c>9 then
      exit;
    result := result*10+c;
    inc(P);
  until false;
  err := 0; // success
  {$else}
  PByte(@result)^ := c;
  inc(P);
  repeat // fast 32-bit loop
    c := byte(P^);
    if c<>0 then begin
      dec(c,48);
      inc(err);
      if c>9 then
        exit;
      PCardinal(@result)^ := PCardinal(@result)^*10+c;
      inc(P);
      if PCardinal(@result)^>=high(cardinal)div 10 then begin
        repeat // 64-bit loop
          c := byte(P^);
          if c=0 then begin
            err := 0; // conversion success without error
            break;
          end;
          dec(c,48);
          inc(err);
          if c>9 then
            exit else
            {$ifdef CPU32DELPHI}
            result := result shl 3+result+result;
            {$else}
            result := result*10;
            {$endif}
          inc(result,c);
          inc(P);
        until false;
        break;
      end;
    end else begin
      err := 0; // reached P^=#0 -> conversion success without error
      break;
    end;
  until false;
  {$endif CPU64}
end;

function GetExtended(P: PUTF8Char): TSynExtended;
var err: integer;
begin
  result := GetExtended(P,err);
  if err<>0 then
    result := 0;
end;

function HugePower10(exponent: integer): TSynExtended; {$ifdef HASINLINE}inline;{$endif}
var pow10: TSynExtended;
begin
  result := 1.0;
  if exponent<0 then begin
    pow10 := 0.1;
    exponent := -exponent;
  end else
    pow10 := 10;
  repeat
    while exponent and 1=0 do begin
      exponent := exponent shr 1;
      pow10 := sqr(pow10);
    end;
    result := result*pow10;
    dec(exponent);
  until exponent=0;
end;

function GetExtended(P: PUTF8Char; out err: integer): TSynExtended;
{$ifndef CPU32DELPHI} // inspired from ValExt_JOH_PAS_8_a by John O'Harrow
const POW10: array[-31..31] of TSynExtended = (
  1E-31,1E-30,1E-29,1E-28,1E-27,1E-26,1E-25,1E-24,1E-23,1E-22,1E-21,1E-20,
  1E-19,1E-18,1E-17,1E-16,1E-15,1E-14,1E-13,1E-12,1E-11,1E-10,1E-9,1E-8,1E-7,
  1E-6,1E-5,1E-4,1E-3,1E-2,1E-1,1E0,1E1,1E2,1E3,1E4,1E5,1E6,1E7,1E8,1E9,1E10,
  1E11,1E12,1E13,1E14,1E15,1E16,1E17,1E18,1E19,1E20,1E21,1E22,1E23,1E24,1E25,
  1E26,1E27,1E28,1E29,1E30,1E31);
var digits, exp: PtrInt;
    ch: byte;
    flags: set of (fNeg, fNegExp, fValid);
    U: PByte; // Delphi Win64 doesn't like if P^ is used directly
{$ifndef CPUX86}ten: TSynExtended;{$endif} // stored in (e.g. xmm2) register
begin
  {$ifndef CPUX86} ten := 10.0; {$endif}
  result := 0;
  if P=nil then begin
    err := 1;
    exit;
  end;
  byte(flags) := 0;
  U := pointer(P);
  if P^=' ' then
    repeat
      inc(U)
    until U^<>32; // trailing spaces
  ch := U^;
  if ch=ord('+') then
    inc(U) else
  if ch=ord('-') then begin
    inc(U);
    include(flags,fNeg);
  end;
  repeat
    ch := U^;
    inc(U);
    if (ch<ord('0')) or (ch>ord('9')) then
      break;
    dec(ch,ord('0'));
    {$ifdef CPUX86}
    result := (result*10.0)+ch;
    {$else}
    result := result*ten; // better FPC+Delphi64 code generation in two steps
    result := result+ch;
    {$endif}
    include(flags,fValid);
  until false;
  digits := 0;
  if ch=ord('.') then
    repeat
      ch := U^;
      inc(U);
      if (ch<ord('0')) or (ch>ord('9')) then begin
        if not(fValid in flags) then // starts with '.'
          if ch=0 then
            dec(U); // U^='.'
        break;
      end;
      dec(ch,ord('0'));
      {$ifdef CPUX86}
      result := (result*10.0)+ch;
      {$else}
      result := result*ten;
      result := result+ch;
      {$endif}
      dec(digits);
      include(flags,fValid);
    until false;
  if (ch=ord('E')) or (ch=ord('e')) then begin
    exp := 0;
    exclude(flags,fValid);
    ch := U^;
    if ch=ord('+') then
      inc(U) else
    if ch=ord('-') then begin
      inc(U);
      include(flags,fNegExp);
    end;
    repeat
      ch := U^;
      inc(U);
      if (ch<ord('0')) or (ch>ord('9')) then
        break;
      dec(ch,ord('0'));
      exp := (exp*10)+PtrInt(ch);
      include(flags,fValid);
    until false;
    if fNegExp in flags then
      dec(digits,exp) else
      inc(digits,exp);
  end;
  if digits<>0 then
    if (digits>=low(POW10)) and (digits<=high(POW10)) then
      result := result*POW10[digits] else
      result := result*HugePower10(digits);
  if fNeg in flags then
    result := -result;
  if (fValid in flags) and (ch=0) then
    err := 0 else
    err := PUTF8Char(U)-P+1;
end;
{$else}
const Ten: double = 10.0;
asm     // in: eax=text, edx=@err  out: st(0)=result
        push    ebx                 // save used registers
        push    esi
        push    edi
        mov     esi, eax            // string pointer
        push    eax                 // save for error condition
        xor     ebx, ebx
        push    eax                 // allocate local storage for loading fpu
        test    esi, esi
        jz      @nil                // nil string
@trim:  movzx   ebx, byte ptr[esi]  // strip leading spaces
        inc     esi
        cmp     bl, ' '
        je      @trim
        xor     ecx, ecx            // clear sign flag
        fld     qword[Ten]          // load 10 into fpu
        xor     eax, eax            // zero number of decimal places
        fldz                        // zero result in fpu
        cmp     bl, '0'
        jl      @chksig             // check for sign character
@dig1:  xor     edi, edi            // zero exponent value
@digl:  sub     bl, '0'
        cmp     bl, 9
        ja      @frac               // non-digit
        mov     cl, 1               // set digit found flag
        mov     [esp], ebx          // store for fpu use
        fmul    st(0), st(1)        // multply by 10
        fiadd   dword ptr[esp]      // add next digit
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        test    bl, bl              // end reached?
        jnz     @digl               // no,get next digit
        jmp     @finish             // yes,finished
@chksig:cmp     bl, '-'
        je      @minus
        cmp     bl, '+'
        je      @sigset
@gdig1: test    bl, bl
        jz      @error              // no digits found
        jmp     @dig1
@minus: mov     ch, 1               // set sign flag
@sigset:movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        jmp     @gdig1
@frac:  cmp     bl, '.' - '0'
        jne     @exp                // no decimal point
        movzx   ebx, byte ptr[esi]  // get next char
        test    bl, bl
        jz      @dotend             // string ends with '.'
        inc     esi
@fracl: sub     bl, '0'
        cmp     bl, 9
        ja      @exp                // non-digit
        mov     [esp], ebx
        dec     eax                 // -(number of decimal places)
        fmul    st(0), st(1)        // multply by 10
        fiadd   dword ptr[esp]      // add next digit
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        test    bl, bl              // end reached?
        jnz     @fracl              // no, get next digit
        jmp     @finish             // yes, finished (no exponent)
@dotend:test    cl, cl              // any digits found before '.'?
        jnz     @finish             // yes, valid
        jmp     @error              // no,invalid
@exp:   or      bl, $20
        cmp     bl, 'e' - '0'
        jne     @error              // not 'e' or 'e'
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        mov     cl, 0               // clear exponent sign flag
        cmp     bl, '-'
        je      @minexp
        cmp     bl, '+'
        je      @expset
        jmp     @expl
@minexp:mov     cl, 1               // set exponent sign flag
@expset:movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
@expl:  sub     bl, '0'
        cmp     bl, 9
        ja      @error              // non-digit
        lea     edi, [edi + edi * 4]// multiply by 10
        add     edi, edi
        add     edi, ebx            // add next digit
        movzx   ebx, byte ptr[esi]  // get next char
        inc     esi
        test    bl, bl              // end reached?
        jnz     @expl               // no, get next digit
@endexp:test    cl, cl              // positive exponent?
        jz      @finish             // yes, keep exponent value
        neg     edi                 // no, negate exponent value
@finish:add     eax, edi            // exponent value - number of decimal places
        mov     [edx], ebx          // result code = 0
        jz      @pow                // no call to _pow10 needed
        mov     edi, ecx            // save decimal sign flag
        call    System.@Pow10       // raise to power of 10
        mov     ecx, edi            // restore decimal sign flag
@pow:   test    ch, ch              // decimal sign flag set?
        jnz     @negate             // yes, negate value
@ok:    add     esp, 8              // dump local storage and string pointer
@exit:  ffree   st(1)               // remove ten value from fpu
        pop     edi                 // restore used registers
        pop     esi
        pop     ebx
        ret                         // finished
@negate:fchs                        // negate result in fpu
        jmp     @ok
@nil:   inc     esi                 // force result code = 1
        fldz                        // result value = 0
@error: pop     ebx                 // dump local storage
        pop     eax                 // string pointer
        sub     esi, eax            // error offset
        mov     [edx], esi          // set result code
        test    ch, ch              // decimal sign flag set?
        jz      @exit               // no,exit
        fchs                        // yes. negate result in fpu
        jmp     @exit               // exit setting result code
end;
{$endif CPU32DELPHI}

function GetUTF8Char(P: PUTF8Char): cardinal;
begin
  if P<>nil then begin
    result := ord(P[0]);
    if result and $80<>0 then begin
      result := GetHighUTF8UCS4(P);
      if result>$ffff then
        result := ord('?'); // do not handle surrogates now
    end;
  end else
    result := PtrUInt(P);
end;

function NextUTF8UCS4(var P: PUTF8Char): cardinal;
begin
  if P<>nil then begin
    result := byte(P[0]);
    if result<=127 then
      inc(P) else begin
      if result and $20=0  then begin
        result := result shl 6+byte(P[1])-$3080; // fast direct process $0..$7ff
        inc(P,2);
      end else
        result := GetHighUTF8UCS4(P); // handle even surrogates
    end;
  end else
    result := 0;
end;

function ContainsUTF8(p, up: PUTF8Char): boolean;
var u: PByte;
begin
  if (p<>nil) and (up<>nil) and (up^<>#0) then begin
    result := true;
    repeat
      u := pointer(up);
      repeat
        if GetNextUTF8Upper(p)<>u^ then
          break else
          inc(u);
        if u^=0 then
          exit; // up^ was found inside p^
      until false;
      p := FindNextUTF8WordBegin(p);
    until p=nil;
  end;
  result := false;
end;

function IdemFileExt(p: PUTF8Char; extup: PAnsiChar; sepChar: AnsiChar): Boolean;
var ext: PUTF8Char;
begin
  if (p<>nil) and (extup<>nil) then begin
    ext := nil;
    repeat
      if p^=sepChar then
        ext := p; // get last '.' position from p into ext
      inc(p);
    until p^=#0;
    if ext<>nil then
      result := IdemPChar(ext,extup) else
      result := false;
  end else
    result := false;
end;

function IdemPCharWithoutWhiteSpace(p: PUTF8Char; up: PAnsiChar): boolean;
begin
  result := False;
  if p=nil then
    exit;
  if up<>nil then
    while up^<>#0 do begin
      while p<=' ' do // trim white space
        if p^=#0 then
          exit else
        inc(p);
      if up^<>NormToUpperAnsi7[p^] then
        exit;
      inc(up);
      inc(p);
    end;
  result := true;
end;

function IdemPCharArray(p: PUTF8Char; const upArray: array of PAnsiChar): integer;
var w: word;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperAnsi7{$else}PNormTableByte{$endif};
    up: ^PAnsiChar;
begin
  if p<>nil then begin
    {$ifndef CPUX86NOTPIC}tab := @NormToUpperAnsi7;{$endif} // faster on PIC and x86_64
    w := tab[ord(p[0])]+tab[ord(p[1])]shl 8;
    up := @upArray[0];
    for result := 0 to high(upArray) do
      if (PWord(up^)^=w) and
        {$ifdef CPUX86NOTPIC}IdemPChar({$else}IdemPChar2(pointer(tab),{$endif}p+2,up^+2) then
        exit else
        inc(up);
  end;
  result := -1;
end;

function IdemPCharArray(p: PUTF8Char; const upArrayBy2Chars: RawUTF8): integer;
var w: word;
begin
  if p<>nil then begin
    w := NormToUpperAnsi7Byte[ord(p[0])]+NormToUpperAnsi7Byte[ord(p[1])]shl 8;
    for result := 0 to pred(length(upArrayBy2Chars) shr 1) do
      if PWordArray(upArrayBy2Chars)[result]=w then
        exit;
  end;
  result := -1;
end;

function IdemPCharU(p, up: PUTF8Char): boolean;
begin
  result := false;
  if (p=nil) or (up=nil) then
    exit;
  while up^<>#0 do begin
    if GetNextUTF8Upper(p)<>ord(up^) then
      exit;
    inc(up);
  end;
  result := true;
end;

function EndWith(const text, upText: RawUTF8): boolean;
var o: PtrInt;
begin
  o := length(text)-length(upText);
  result := (o>=0) and IdemPChar(PUTF8Char(pointer(text))+o,pointer(upText));
end;

function EndWithArray(const text: RawUTF8; const upArray: array of RawUTF8): integer;
var t,o: PtrInt;
begin
  t := length(text);
  if t>0 then
    for result := 0 to high(upArray) do begin
      o := t-length(UpArray[result]);
      if (o>=0) and IdemPChar(PUTF8Char(pointer(text))+o,pointer(upArray[result])) then
        exit;
    end;
  result := -1;
end;

function UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
begin
  if source<>'' then
    result := UpperCopy255Buf(dest,pointer(source),
      {$ifdef FPC}_LStrLen(source){$else}PInteger(PtrInt(source)-4)^{$endif}) else
    result := dest;
end;

function UpperCopy255BufPas(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
var i,c,d{$ifdef CPU64},_80,_61,_7b{$endif}: PtrUInt;
begin
  if sourceLen>0 then begin
    if sourceLen>248 then
      sourceLen := 248; // avoid buffer overflow
    // we allow to copy up to 3/7 more chars in Dest^ since its size is 255
    {$ifdef CPU64} // unbranched uppercase conversion of 8 chars blocks
    _80 := PtrUInt($8080808080808080); // use registers for constants
    _61 := $6161616161616161;
    _7b := $7b7b7b7b7b7b7b7b;
    for i := 0 to sourceLen shr 3 do begin
      c := PPtrUIntArray(source)^[i];
      d := c or _80;
      PPtrUIntArray(dest)^[i] := c-((d-PtrUInt(_61)) and not(d-_7b)) and
        ((not c) and _80)shr 2;
    end;
    {$else} // unbranched uppercase conversion of 4 chars blocks
    for i := 0 to sourceLen shr 2 do begin
      c := PPtrUIntArray(source)^[i];
      d := c or $80808080;
      PPtrUIntArray(dest)^[i] := c-((d-$61616161) and not(d-$7b7b7b7b)) and
        ((not c) and $80808080)shr 2;
    end;
    {$endif}
    result := dest+sourceLen; // but we always return the exact size
  end else
    result := dest;
end;

function UpperCopyWin255(dest: PWinAnsiChar; const source: RawUTF8): PWinAnsiChar;
var i, L: integer;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute NormToUpperByte{$else}PNormTableByte{$endif};
begin
  L := {$ifdef FPC}_LStrLen(source){$else}PInteger(PtrInt(source)-SizeOf(integer))^{$endif};
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := dest+L;
    {$ifndef CPUX86NOTPIC}tab := @NormToUpperByte;{$endif} // faster on PIC and x86_64
    for i := 0 to L-1 do
      dest[i] := AnsiChar(tab[PByteArray(source)[i]]);
  end else
    result := dest;
end;

function UTF8UpperCopy(Dest, Source: PUTF8Char; SourceChars: Cardinal): PUTF8Char;
var c: PtrUInt;
    endSource, endSourceBy4, S: PUTF8Char;
    extra,i: PtrInt;
label By1, By4, set1; // ugly but faster
begin
  if (Source<>nil) and (Dest<>nil) then begin
    // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
    endSource := Source+SourceChars;
    endSourceBy4 := endSource-4;
    if (PtrUInt(Source) and 3=0) and (Source<=endSourceBy4) then
    repeat
  By4:c := PCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      inc(Source,4);
      Dest[0] := AnsiChar(NormToUpperByte[ToByte(c)]);
      Dest[1] := AnsiChar(NormToUpperByte[ToByte(c shr 8)]);
      Dest[2] := AnsiChar(NormToUpperByte[ToByte(c shr 16)]);
      Dest[3] := AnsiChar(NormToUpperByte[c shr 24]);
      inc(Dest,4);
    until Source>endSourceBy4;
    // generic loop, handling one UCS4 char per iteration
    if Source<endSource then
    repeat
  By1:c := byte(Source^);
      inc(Source);
      if c<=127 then begin
        Dest^ := AnsiChar(NormToUpperByte[c]);
Set1:   inc(Dest);
        if (PtrUInt(Source) and 3=0) and (Source<EndSourceBy4) then goto By4 else
        if Source<endSource then continue else break;
      end else begin
        extra := UTF8_EXTRABYTES[c];
        if (extra=0) or (Source+extra>endSource) then break;
        for i := 0 to extra-1 do
          c := c shl 6+byte(Source[i]);
        with UTF8_EXTRA[extra] do begin
          dec(c,offset);
          if c<minimum then
            break; // invalid input content
        end;
        if (c<=255) and (NormToUpperByte[c]<=127) then begin
          Dest^ := AnsiChar(NormToUpperByte[c]);
          inc(Source,extra);
          goto set1;
        end;
        S := Source-1; // leave UTF-8 encoding untouched
        inc(Source,extra);
        inc(extra);
        {$ifdef FPC}Move{$else}MoveFast{$endif}(S^,Dest^,extra);
        inc(Dest,extra);
        if (PtrUInt(Source) and 3=0) and (Source<EndSourceBy4) then goto By4 else
        if Source<endSource then continue else break;
      end;
    until false;
  end;
  result := Dest;
end;

function UTF8UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PUTF8Char;
var L: integer;
begin
  L := length(source);
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := UTF8UpperCopy(pointer(dest),pointer(source),L);
  end else
    result := pointer(dest);
end;

function UpperCopy255W(dest: PAnsiChar; const source: SynUnicode): PAnsiChar;
var c: cardinal;
    i,L: integer;
begin
  L := length(source);
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := dest+L;
    for i := 0 to L-1 do begin
      c := PWordArray(source)[i];
      if c<255 then
        dest[i] := AnsiChar(NormToUpperAnsi7Byte[c]) else
        dest[i] := '?';
    end;
  end else
    result := dest;
end;

function UpperCopy255W(dest: PAnsiChar; source: PWideChar; L: integer): PAnsiChar;
var c: cardinal;
    i: integer;
begin
  if L>0 then begin
    if L>250 then
      L := 250; // avoid buffer overflow
    result := dest+L;
    for i := 0 to L-1 do begin
      c := PWordArray(source)[i];
      if c<255 then
        dest[i] := AnsiChar(NormToUpperAnsi7Byte[c]) else
        dest[i] := '?';
    end;
  end else
    result := dest;
end;

function GetNextLine(source: PUTF8Char; out next: PUTF8Char): RawUTF8;
var beg: PUTF8Char;
begin
  if source=nil then begin
    {$ifdef FPC}Finalize(result){$else}result := ''{$endif};
    next := source;
    exit;
  end;
  beg := source;
  repeat
    if source[0]>#13 then
      if source[1]>#13 then
        if source[2]>#13 then
          if source[3]>#13 then begin
            inc(source,4);
            continue;
          end else
          inc(source,3) else
        inc(source,2) else
      inc(source);
    case source^ of
      #0: next := nil;
      #10: next := source+1;
      #13: if source[1]=#10 then next := source+2 else next := source+1;
      else begin
        inc(source);
        continue;
      end;
    end;
    FastSetString(result,beg,source-beg);
    exit;
  until false;
end;

{$ifdef UNICODE}
function GetNextLineW(source: PWideChar; out next: PWideChar): string;
begin
  next := source;
  if source=nil then begin
    result := '';
    exit;
  end;
  while not (cardinal(source^) in [0,10,13]) do inc(source);
  SetString(result,PChar(next),source-next);
  if source^=#13 then inc(source);
  if source^=#10 then inc(source);
  if source^=#0 then
    next := nil else
    next := source;
end;

function FindIniNameValueW(P: PWideChar; UpperName: PUTF8Char): string;
var PBeg: PWideChar;
    L: PtrInt;
begin
  while (P<>nil) and (P^<>'[') do begin
    PBeg := P;
    while not (cardinal(P^) in [0,10,13]) do inc(P);
    while cardinal(P^) in [10,13] do inc(P);
    if P^=#0 then P := nil;
    if PBeg^=' ' then repeat inc(PBeg) until PBeg^<>' ';   // trim left ' '
    if IdemPCharW(PBeg,UpperName) then begin
      inc(PBeg,StrLen(UpperName));
      L := 0; while PBeg[L]>=' ' do inc(L); // get line length
      SetString(result,PBeg,L);
      exit;
    end;
  end;
  result := '';
end;

function FindIniEntryW(const Content: string; const Section, Name: RawUTF8): string;
var P: PWideChar;
    UpperSection, UpperName: array[byte] of AnsiChar;
    // possible GPF if length(Section/Name)>255, but should const in code
begin
  result := '';
  P := pointer(Content);
  if P=nil then exit;
  // UpperName := UpperCase(Name)+'=';
  PWord(UpperCopy255(UpperName,Name))^ := ord('=');
  if Section='' then
     // find the Name= entry before any [Section]
    result := FindIniNameValueW(P,UpperName) else begin
     // find the Name= entry in the specified [Section]
    PWord(UpperCopy255(UpperSection,Section))^ := ord(']');
    if FindSectionFirstLineW(P,UpperSection) then
      result := FindIniNameValueW(P,UpperName);
  end;
end;

{$endif UNICODE}

function IdemPCharAndGetNextItem(var source: PUTF8Char; const searchUp: RawUTF8;
  var Item: RawUTF8; Sep: AnsiChar): boolean;
begin
  if source=nil then
    result := false else begin
    result := IdemPChar(source,Pointer(searchUp));
    if result then begin
      inc(source,Length(searchUp));
      GetNextItem(source,Sep,Item);
    end;
  end;
end;

{$ifdef FPC}{$push}{$endif}
{$WARNINGS OFF} // some Delphi compilers do not analyze well code below
function GotoNextLine(source: PUTF8Char): PUTF8Char;
begin
  if source<>nil then
    repeat
      if source[0]>#13 then
        if source[1]>#13 then
          if source[2]>#13 then
            if source[3]>#13 then begin
              inc(source,4);
              continue;
            end else
            inc(source,3) else
          inc(source,2) else
        inc(source);
      case source^ of
        #0: result := nil;
        #10: result := source+1;
        #13: if source[1]=#10 then result := source+2 else result := source+1;
        else begin
          inc(source);
          continue;
        end;
      end;
      exit;
    until false else
    result := source;
end;
{$ifdef FPC}{$pop}{$else}{$WARNINGS ON}{$endif}

function BufferLineLength(Text, TextEnd: PUTF8Char): PtrInt;
{$ifdef CPUX64}
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .NOFRAME {$endif}
{$ifdef MSWINDOWS} // Win64 ABI to System-V ABI
        push    rsi
        push    rdi
        mov     rdi, rcx
        mov     rsi, rdx
{$endif}mov     r8, rsi
        sub     r8, rdi // rdi=Text, rsi=TextEnd, r8=TextLen
        jz      @fail
        mov     ecx, edi
        movdqa  xmm0, [rip + @for10]
        movdqa  xmm1, [rip + @for13]
        and     rdi, -16 // check first aligned 16 bytes
        and     ecx, 15  // lower 4 bits indicate misalignment
        movdqa  xmm2, [rdi]
        movdqa  xmm3, xmm2
        pcmpeqb xmm2, xmm0
        pcmpeqb xmm3, xmm1
        por     xmm3, xmm2
        pmovmskb eax, xmm3
        shr     eax, cl  // shift out unaligned bytes
        test    eax, eax
        jz      @main
        bsf     eax, eax
        add     rax, rcx
        add     rax, rdi
        sub     rax, rsi
        jae     @fail   // don't exceed TextEnd
        add     rax, r8 // rax = TextFound - TextEnd + (TextEnd - Text) = offset
{$ifdef MSWINDOWS}
        pop     rdi
        pop     rsi
{$endif}ret
@main:  add     rdi, 16
        sub     rdi, rsi
        jae     @fail
        jmp     @by16
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@for10: dq      $0a0a0a0a0a0a0a0a
        dq      $0a0a0a0a0a0a0a0a
@for13: dq      $0d0d0d0d0d0d0d0d
        dq      $0d0d0d0d0d0d0d0d
@by16:  movdqa  xmm2, [rdi + rsi] // check 16 bytes per loop
        movdqa  xmm3, xmm2
        pcmpeqb xmm2, xmm0
        pcmpeqb xmm3, xmm1
        por     xmm3, xmm2
        pmovmskb eax, xmm3
        test    eax, eax
        jnz     @found
        add     rdi, 16
        jnc     @by16
@fail:  mov     rax, r8 // returns TextLen if no CR/LF found
{$ifdef MSWINDOWS}
        pop     rdi
        pop     rsi
{$endif}ret
@found: bsf     eax, eax
        add     rax, rdi
        jc      @fail
        add     rax, r8
{$ifdef MSWINDOWS}
        pop     rdi
        pop     rsi
{$endif}
end;
{$else} {$ifdef FPC}inline;{$endif}
var c: cardinal;
begin
  result := 0;
  dec(PtrInt(TextEnd),PtrInt(Text)); // compute TextLen
  if TextEnd<>nil then
    repeat
      c := ord(Text[result]);
      if c>13 then begin
        inc(result);
        if result>=PtrInt(PtrUInt(TextEnd)) then
          break;
        continue;
      end;
      if (c=10) or (c=13) then
        break;
      inc(result);
      if result>=PtrInt(PtrUInt(TextEnd)) then
        break;
    until false;
end;
{$endif CPUX64}

function GetLineSize(P,PEnd: PUTF8Char): PtrUInt;
var c: cardinal;
begin
  if PEnd=nil then
    dec(PtrUInt(PEnd));
  result := PtrUInt(P);
  if P<>nil then
    repeat
      c := ord(P^);
      if c>13 then begin
        inc(P);
        if P>=PEnd then
          break;
        continue;
      end;
      if (c=0) or (c=10) or (c=13) then
        break;
      inc(P);
      if P>=PEnd then
        break;
    until false;
  result := PtrUInt(P)-result;
end;

function GetNextItem(var P: PUTF8Char; Sep: AnsiChar): RawUTF8;
begin
  GetNextItem(P,Sep,result);
end;

procedure GetNextItem(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8);
var S: PUTF8Char;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    FastSetString(result,P,S-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

procedure GetNextItem(var P: PUTF8Char; Sep, Quote: AnsiChar; var result: RawUTF8);
begin
  if P=nil then
    result := ''
  else if P^=Quote then begin
    P := UnQuoteSQLStringVar(P,result);
    if P=nil then
      result := ''
    else if P^<>#0 then
      inc(P);
  end else
    GetNextItem(P,Sep,result);
end;

procedure GetNextItemTrimed(var P: PUTF8Char; Sep: AnsiChar; var result: RawUTF8);
var S,E: PUTF8Char;
begin
  if (P=nil) or (Sep<=' ') then
    result := '' else begin
    while (P^<=' ') and (P^<>#0) do inc(P); // trim left
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    E := S;
    while (E>P) and (E[-1] in [#1..' ']) do dec(E); // trim right
    FastSetString(result,P,E-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

procedure GetNextItemTrimedCRLF(var P: PUTF8Char; var result: RawUTF8);
var S,E: PUTF8Char;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while (S^<>#0) and (S^<>#10) do
      inc(S);
    E := S;
    if (E>P) and (E[-1]=#13) then
      dec(E);
    FastSetString(result,P,E-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

function GetNextItemString(var P: PChar; Sep: Char= ','): string;
// this function will compile into AnsiString or UnicodeString, depending
// of the compiler version
var S: PChar;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    SetString(result,P,S-P);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

function GetNextStringLineToRawUnicode(var P: PChar): RawUnicode;
var S: PChar;
begin
  if P=nil then
    result := '' else begin
    S := P;
    while S^>=' ' do
      inc(S);
    result := StringToRawUnicode(P,S-P);
    while (S^<>#0) and (S^<' ') do inc(S); // ignore e.g. #13 or #10
    if S^<>#0 then
      P := S else
      P := nil;
  end;
end;

procedure AppendCSVValues(const CSV: string; const Values: array of string;
  var Result: string; const AppendBefore: string);
var Caption: string;
    i, bool: integer;
    P: PChar;
    first: Boolean;
begin
  P := pointer(CSV);
  if P=nil then
    exit;
  first := True;
  for i := 0 to high(Values) do begin
    Caption := GetNextItemString(P);
    if Values[i]<>'' then begin
      if first then begin
        Result := Result+#13#10;
        first := false;
      end else
        Result := Result+AppendBefore;
      bool := FindCSVIndex('0,-1',RawUTF8(Values[i]));
      Result := Result+Caption+': ';
      if bool<0 then
        Result := Result+Values[i] else
        Result := Result+GetCSVItemString(pointer(GetNextItemString(P)),bool,'/');
    end;
  end;
end;

procedure GetNextItemShortString(var P: PUTF8Char; out Dest: ShortString; Sep: AnsiChar= ',');
var S: PUTF8Char;
    len: integer;
begin
  if P=nil then
    Dest[0] := #0 else begin
    while (P^<=' ') and (P^<>#0) do inc(P);
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    len := S-P;
    while (P[len-1] in [#1..' ']) and (len>0) do dec(len); // trim right spaces
    SetString(Dest,P,len);
    if S^<>#0 then
      P := S+1 else
      P := nil;
  end;
end;

function GetNextItemHexDisplayToBin(var P: PUTF8Char; Bin: PByte; BinBytes: integer;
  Sep: AnsiChar= ','): boolean;
var S: PUTF8Char;
    len: integer;
begin
  result := false;
  FillCharFast(Bin^,BinBytes,0);
  if P=nil then
    exit;
  if P^ = ' ' then repeat inc(P) until P^ <> ' ';
  S := P;
  if Sep=#0 then
    while S^>' ' do
      inc(S) else
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
  len := S-P;
  while (P[len-1] in [#1..' ']) and (len>0) do dec(len); // trim right spaces
  if len<>BinBytes*2 then
    exit;
  if not HexDisplayToBin(PAnsiChar(P),Bin,BinBytes) then
    FillCharFast(Bin^,BinBytes,0) else begin
    if S^=#0 then
      P := nil else
      if Sep<>#0 then
        P := S+1 else
        P := S;
    result := true;
  end;
end;

function GetNextItemCardinal(var P: PUTF8Char; Sep: AnsiChar): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  if P^ = ' ' then repeat inc(P) until P^ <> ' ';
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
  if Sep<>#0 then
    while (P^<>#0) and (P^<>Sep) do // go to end of CSV item (ignore any decimal)
      inc(P);
  if P^=#0 then
    P := nil else
    if Sep<>#0 then
      inc(P);
end;

function GetNextItemCardinalStrict(var P: PUTF8Char): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  c := byte(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := byte(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
  if P^=#0 then
    P := nil;
end;

function CSVOfValue(const Value: RawUTF8; Count: cardinal; const Sep: RawUTF8): RawUTF8;
var ValueLen, SepLen: cardinal;
    i: cardinal;
    P: PAnsiChar;
begin // CSVOfValue('?',3)='?,?,?'
  result := '';
  if Count=0 then
    exit;
  ValueLen := length(Value);
  SepLen := Length(Sep);
  Setlength(result,ValueLen*Count+SepLen*pred(Count));
  P := pointer(result);
  i := 1;
  repeat
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Pointer(Value)^,P^,ValueLen);
    inc(P,ValueLen);
    if i=Count then
      break;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Pointer(Sep)^,P^,SepLen);
    inc(P,SepLen);
    inc(i);
  until false;
//  assert(P-pointer(result)=length(result));
end;

procedure SetBitCSV(var Bits; BitsCount: integer; var P: PUTF8Char);
var bit,last: cardinal;
begin
  while P<>nil do begin
    bit := GetNextItemCardinalStrict(P)-1; // '0' marks end of list
    if bit>=cardinal(BitsCount) then
      break; // avoid GPF
    if (P=nil) or (P^=',') then
      SetBitPtr(@Bits,bit) else
    if P^='-' then begin
      inc(P);
      last := GetNextItemCardinalStrict(P)-1; // '0' marks end of list
      if last>=Cardinal(BitsCount) then
        exit;
      while bit<=last do begin
        SetBitPtr(@Bits,bit);
        inc(bit);
      end;
    end;
    if (P<>nil) and (P^=',') then
      inc(P);
  end;
  if (P<>nil) and (P^=',') then
    inc(P);
end;

function GetBitCSV(const Bits; BitsCount: integer): RawUTF8;
var i,j: integer;
begin
  result := '';
  i := 0;
  while i<BitsCount do
  if GetBitPtr(@Bits,i) then begin
    j := i;
    while (j+1<BitsCount) and GetBitPtr(@Bits,j+1) do
      inc(j);
    result := result+UInt32ToUtf8(i+1);
    if j=i then
      result := result+',' else
    if j=i+1 then
      result := result+','+UInt32ToUtf8(j+1)+',' else
      result := result+'-'+UInt32ToUtf8(j+1)+',';
    i := j+1;
  end else
    inc(i);
  result := result+'0'; // '0' marks end of list
end;

function GetNextItemCardinalW(var P: PWideChar; Sep: WideChar= ','): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  c := word(P^)-48;
  if c>9 then
    result := 0 else begin
    result := c;
    inc(P);
    repeat
      c := word(P^)-48;
      if c>9 then
        break else
        result := result*10+c;
      inc(P);
    until false;
  end;
  while (P^<>#0) and (P^<>Sep) do // go to end of CSV item (ignore any decimal)
    inc(P);
  if P^=#0 then
    P := nil else
    inc(P);
end;

function GetNextItemInteger(var P: PUTF8Char; Sep: AnsiChar= ','): PtrInt;
var minus: boolean;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  if (P^ in ['+','-']) then begin
    minus := P^='-';
    inc(P);
  end else
    minus := false;
  result := PtrInt(GetNextItemCardinal(P,Sep));
  if minus then
    result := -result;
end;

function GetNextTChar64(var P: PUTF8Char; Sep: AnsiChar; out Buf: TChar64): PtrInt;
begin
  result := 0;
  if P=nil then
    exit;
  if Sep=#0 then // store up to next whitespace
    while P[result]>' ' do begin
      Buf[result] := P[result];
      inc(result);
      if result>=SizeOf(Buf) then
        exit; // avoid buffer overflow
    end else
    while (P[result]<>#0) and (P[result]<>Sep) do begin
      Buf[result] := P[result];
      inc(result);
      if result>=SizeOf(Buf) then
        exit; // avoid buffer overflow
    end;
  Buf[result] := #0; // make asciiz
  inc(P,result); // P[result]=Sep or #0
  if P^=#0 then
    P := nil else
    if Sep<>#0 then
      inc(P);
end;

function GetNextItemInt64(var P: PUTF8Char; Sep: AnsiChar): Int64;
{$ifdef CPU64}
begin
  result := GetNextItemInteger(P,Sep); // PtrInt=Int64
end;
{$else}
var tmp: TChar64;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then
    SetInt64(tmp,result) else
    result := 0;
end;
{$endif}

function GetNextItemQWord(var P: PUTF8Char; Sep: AnsiChar): QWord;
{$ifdef CPU64}
begin
  result := GetNextItemCardinal(P,Sep); // PtrUInt=QWord
end;
{$else}
var tmp: TChar64;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then
    SetQWord(tmp,result) else
    result := 0;
end;
{$endif}

function GetNextItemHexa(var P: PUTF8Char; Sep: AnsiChar): QWord;
var tmp: TChar64;
    L: integer;
begin
  result := 0;
  L := GetNextTChar64(P,Sep,tmp);
  if (L>0) and (L and 1=0) then
    if not HexDisplayToBin(@tmp,@result,L shr 1) then
      result := 0;
end;

function GetNextItemDouble(var P: PUTF8Char; Sep: AnsiChar): double;
var tmp: TChar64;
    err: integer;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then begin
    result := GetExtended(tmp,err);
    if err<>0 then
      result := 0;
  end else
    result := 0;
end;

function GetNextItemCurrency(var P: PUTF8Char; Sep: AnsiChar): currency;
begin
  GetNextItemCurrency(P,result,Sep);
end;

procedure GetNextItemCurrency(var P: PUTF8Char; out result: currency; Sep: AnsiChar);
var tmp: TChar64;
begin
  if GetNextTChar64(P,Sep,tmp)>0 then
    PInt64(@result)^ := StrToCurr64(tmp) else
    result := 0;
end;

function GetCSVItem(P: PUTF8Char; Index: PtrUInt; Sep: AnsiChar): RawUTF8;
var i: PtrUInt;
begin
  if P=nil then
    result := '' else
    for i := 0 to Index do
      GetNextItem(P,Sep,result);
end;

function GetUnQuoteCSVItem(P: PUTF8Char; Index: PtrUInt; Sep, Quote: AnsiChar): RawUTF8;
var i: PtrUInt;
begin
  if P=nil then
    result := '' else
    for i := 0 to Index do
      GetNextItem(P,Sep,Quote,result);
end;

function GetLastCSVItem(const CSV: RawUTF8; Sep: AnsiChar): RawUTF8;
var i: integer;
begin
  for i := length(CSV) downto 1 do
    if CSV[i]=Sep then begin
      result := copy(CSV,i+1,maxInt);
      exit;
    end;
  result := CSV;
end;

function GetCSVItemString(P: PChar; Index: PtrUInt; Sep: Char): string;
var i: PtrUInt;
begin
  if P=nil then
    result := '' else
    for i := 0 to Index do
      result := GetNextItemString(P,Sep);
end;

function FindCSVIndex(CSV: PUTF8Char; const Value: RawUTF8; Sep: AnsiChar;
  CaseSensitive,TrimValue: boolean): integer;
var s: RawUTF8;
begin
  result := 0;
  while CSV<>nil do begin
    GetNextItem(CSV,Sep,s);
    if TrimValue then
      s := trim(s);
    if CaseSensitive then begin
      if s=Value then
        exit;
    end else
     if SameTextU(s,Value) then
       exit;
    inc(result);
  end;
  result := -1; // not found
end;

procedure CSVToRawUTF8DynArray(CSV: PUTF8Char; var Result: TRawUTF8DynArray;
  Sep: AnsiChar; TrimItems, AddVoidItems: boolean);
var s: RawUTF8;
    n: integer;
begin
  n := length(Result);
  while CSV<>nil do begin
    if TrimItems then
      GetNextItemTrimed(CSV,Sep,s) else
      GetNextItem(CSV,Sep,s);
    if (s<>'') or AddVoidItems then
      AddRawUTF8(Result,n,s);
  end;
  if n<>length(Result) then
    SetLength(Result,n);
end;

procedure CSVToRawUTF8DynArray(const CSV,Sep,SepEnd: RawUTF8; var Result: TRawUTF8DynArray);
var offs,i: integer;
begin
  offs := 1;
  while offs<length(CSV) do begin
    SetLength(Result,length(Result)+1);
    i := PosEx(Sep,CSV,offs);
    if i=0 then begin
      i := PosEx(SepEnd,CSV,offs);
      if i=0 then
        i := MaxInt else
        dec(i,offs);
      Result[high(Result)] := Copy(CSV,offs,i);
      exit;
    end;
    Result[high(Result)] := Copy(CSV,offs,i-offs);
    offs := i+length(sep);
  end;
end;

function AddPrefixToCSV(CSV: PUTF8Char; const Prefix: RawUTF8; Sep: AnsiChar): RawUTF8;
var s: RawUTF8;
begin
  GetNextItem(CSV,Sep,result);
  if result='' then
    exit;
  result := Prefix+result;
  while CSV<>nil do begin
    GetNextItem(CSV,Sep,s);
    if s<>'' then
      result := result+','+Prefix+s;
  end;
end;

procedure AddToCSV(const Value: RawUTF8; var CSV: RawUTF8; const Sep: RawUTF8);
begin
  if CSV='' then
    CSV := Value else
    CSV := CSV+Sep+Value;
end;

function RenameInCSV(const OldValue, NewValue: RawUTF8; var CSV: RawUTF8;
  const Sep: RawUTF8): boolean;
var pattern: RawUTF8;
    i,j: integer;
begin
  result := OldValue=NewValue;
  i := length(OldValue);
  if result or (length(Sep)<>1) or (length(CSV)<i) or
     (PosEx(Sep,OldValue)>0) or (PosEx(Sep,NewValue)>0) then
    exit;
  if CompareMem(pointer(OldValue),pointer(CSV),i) and // first (or unique) item
     ((CSV[i+1]=Sep[1]) or (CSV[i+1]=#0)) then
    i := 1 else begin
    j := 1;
    pattern := Sep+OldValue;
    repeat
      i := PosEx(pattern,CSV,j);
      if i=0 then
        exit;
      j := i+length(pattern);
    until (CSV[j]=Sep[1]) or (CSV[j]=#0);
    inc(i);
  end;
  delete(CSV,i,length(OldValue));
  insert(NewValue,CSV,i);
  result := true;
end;

function RawUTF8ArrayToCSV(const Values: array of RawUTF8; const Sep: RawUTF8): RawUTF8;
var i, len, seplen, L: Integer;
    P: PAnsiChar;
begin
  result := '';
  if high(Values)<0 then
    exit;
  seplen := length(Sep);
  len := seplen*high(Values);
  for i := 0 to high(Values) do
    inc(len,length(Values[i]));
  SetLength(result,len);
  P := pointer(result);
  i := 0;
  repeat
    L := length(Values[i]);
    if L>0 then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Values[i])^,P^,L);
      inc(P,L);
    end;
    if i=high(Values) then
      Break;
    if seplen>0 then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Sep)^,P^,seplen);
      inc(P,seplen);
    end;
    inc(i);
  until false;
end;

function RawUTF8ArrayToQuotedCSV(const Values: array of RawUTF8; const Sep: RawUTF8;
  Quote: AnsiChar): RawUTF8;
var i: integer;
    tmp: TRawUTF8DynArray;
begin
  SetLength(tmp,length(Values));
  for i := 0 to High(Values) do
    tmp[i] := QuotedStr(Values[i],Quote);
  result := RawUTF8ArrayToCSV(tmp,Sep);
end;

function TRawUTF8DynArrayFrom(const Values: array of RawUTF8): TRawUTF8DynArray;
var i: integer;
begin
  SetLength(result,length(Values));
  for i := 0 to high(Values) do
    result[i] := Values[i];
end;

procedure AddArrayOfConst(var Dest: TTVarRecDynArray; const Values: array of const);
var i,n: Integer;
begin
  n := length(Dest);
  SetLength(Dest,n+length(Values));
  for i := 0 to high(Values) do
    Dest[i+n] := Values[i];
end;

var
  DefaultTextWriterJSONClass: TTextWriterClass = TTextWriter;
  DefaultTextWriterTrimEnum: boolean;

function ObjectToJSON(Value: TObject; Options: TTextWriterWriteObjectOptions): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  if Value=nil then
    result := NULL_STR_VAR else
    with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
    try
      include(fCustomOptions,twoForceJSONStandard);
      WriteObject(Value,Options);
      SetText(result);
    finally
      Free;
    end;
end;

function ObjectsToJSON(const Names: array of RawUTF8; const Values: array of TObject;
  Options: TTextWriterWriteObjectOptions=[woDontStoreDefault]): RawUTF8;
var i,n: integer;
    temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
  try
    n := length(Names);
    Add('{');
    for i := 0 to high(Values) do
    if Values[i]<>nil then begin
      if i<n then
        AddFieldName(Names[i]) else
        AddPropName(ClassNameShort(Values[i])^);
      WriteObject(Values[i],Options);
      Add(',');
    end;
    CancelLastComma;
    Add('}');
    SetText(result);
  finally
    Free;
  end;
end;

function UrlEncode(const svar: RawUTF8): RawUTF8;
begin
  result := UrlEncode(pointer(svar));
end;

function UrlEncode(Text: PUTF8Char): RawUTF8;
  function Enc(s, p: PUTF8Char): PUTF8Char;
  var c: PtrInt;
  begin
    repeat
      c := ord(s^);
      case c of
      0: break;
      ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z'),
      ord('_'),ord('-'),ord('.'),ord('~'): begin
        // cf. rfc3986 2.3. Unreserved Characters
        p^ := AnsiChar(c);
        inc(p);
        inc(s);
        continue;
      end;
      ord(' '): p^ := '+';
      else begin
        p^ := '%'; inc(p);
        PWord(p)^ := TwoDigitsHexWB[c]; inc(p);
      end;
      end; // case c of
      inc(p);
      inc(s);
    until false;
    result := p;
  end;
  function Size(s: PUTF8Char): PtrInt;
  begin
    result := 0;
    if s<>nil then
    repeat
      case s^ of
        #0: exit;
        '0'..'9','a'..'z','A'..'Z','_','-','.','~',' ': begin
          inc(result);
          inc(s);
          continue;
        end;
        else inc(result,3);
      end;
      inc(s);
    until false;
  end;
begin
  result := '';
  if Text=nil then
    exit;
  SetLength(result,Size(Text)); // reserve exact memory count
  Enc(Text,pointer(result));
end;

function UrlEncode(const NameValuePairs: array of const): RawUTF8;
// (['select','*','where','ID=12','offset',23,'object',aObject]);
var A, n: PtrInt;
    name, value: RawUTF8;
begin
  result := '';
  n := high(NameValuePairs);
  if n>0 then begin
    for A := 0 to n shr 1 do begin
      VarRecToUTF8(NameValuePairs[A*2],name);
      if not IsUrlValid(pointer(name)) then
        continue; // just skip invalid names
      with NameValuePairs[A*2+1] do
        if VType=vtObject then
          value := ObjectToJSON(VObject,[]) else
          VarRecToUTF8(NameValuePairs[A*2+1],value);
      result := result+'&'+name+'='+UrlEncode(value);
    end;
    result[1] := '?';
  end;
end;

function IsUrlValid(P: PUTF8Char): boolean;
begin
  result := false;
  if P<>nil then begin
    repeat // cf. rfc3986 2.3. Unreserved Characters
      if ord(P^) in IsURIUnreserved then
        inc(P) else
        exit;
    until P^=#0;
    result := true;
  end;
end;

function AreUrlValid(const Url: array of RawUTF8): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to high(Url) do
    if not IsUrlValid(pointer(Url[i])) then
      exit;
  result := true;
end;

function IncludeTrailingURIDelimiter(const URI: RawByteString): RawByteString;
begin
  if (URI<>'') and (URI[length(URI)]<>'/') then
    result := URI+'/' else
    result := URI;
end;

function UrlEncodeJsonObject(const URIName: RawUTF8; ParametersJSON: PUTF8Char;
  const PropNamesToIgnore: array of RawUTF8): RawUTF8;
var i,j: integer;
    sep: AnsiChar;
    Params: TNameValuePUTF8CharDynArray;
    temp: TTextWriterStackBuffer;
begin
  if ParametersJSON=nil then
    result := URIName else
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddString(URIName);
      if (JSONDecode(ParametersJSON,Params,true)<>nil) and (Params<>nil) then begin
        sep := '?';
        for i := 0 to High(Params) do
        with Params[i] do begin
          for j := 0 to high(PropNamesToIgnore) do
            if IdemPropNameU(PropNamesToIgnore[j],Name,NameLen) then begin
              NameLen := 0;
              break;
            end;
          if NameLen=0 then
            continue;
          Add(sep);
          AddNoJSONEscape(Name,NameLen);
          Add('=');
          AddString(UrlEncode(Value));
          sep := '&';
        end;
      end;
      SetText(result);
    finally
      Free;
    end;
end;

function UrlDecode(const s: RawUTF8; i: PtrInt = 1; len: PtrInt = -1): RawUTF8;
var L: PtrInt;
    P: PUTF8Char;
begin
  result := '';
  if s='' then
    exit;
  L := PStrRec(Pointer(PtrInt(s)-STRRECSIZE))^.length;
  if len<0 then
    len := L;
  if i>L then
    exit;
  dec(i);
  if len=i then
    exit;
  Setlength(result,len-i); // reserve enough space for result
  P := pointer(result);
  while i<len do begin
    case s[i+1] of
      #0:  break; // reached end of s
      '%': if not HexToChar(PAnsiChar(pointer(s))+i+1,P) then
             P^ := s[i+1] else
             inc(i,2); // browsers may not follow the RFC (e.g. encode % as % !)
      '+': P^  := ' ';
    else
      P^ := s[i+1];
    end; // case s[i] of
    inc(i);
    inc(P);
  end;
  Setlength(result,P-pointer(Result)); // fast with FastMM4/SynScaleMM (in-place realloc)
end;

function UrlDecode(U: PUTF8Char): RawUTF8;
var P,Dest: PUTF8Char;
    L: integer;
    tmp: array[byte] of AnsiChar;
begin
result := '';
  L := StrLen(U);
  if L=0 then
    exit;
  if L>SizeOf(tmp) then begin
    SetLength(result,L);
    Dest := pointer(result);
  end else
    Dest := @tmp;
  P := Dest;
  repeat
    case U^ of
      #0:  break; // reached end of URI
      '%': if not HexToChar(PAnsiChar(U+1),P) then
             P^ := U^ else
             inc(U,2); // browsers may not follow the RFC (e.g. encode % as % !)
      '+': P^  := ' ';
    else
      P^ := U^;
    end; // case s[i] of
    inc(U);
    inc(P);
  until false;
  if Dest=@tmp then
    FastSetString(result,@tmp,P-Dest) else
    SetLength(result,P-Dest);
end;

function UrlDecodeNextValue(U: PUTF8Char; out Value: RawUTF8): PUTF8Char;
var Beg,V: PUTF8Char;
    len, i: PtrInt;
begin
  if U<>nil then begin
    // compute resulting length of value
    Beg := U;
    len := 0;
    while (U^<>#0) and (U^<>'&') do begin
      if (U^='%') and HexToCharValid(PAnsiChar(U+1)) then
        inc(U,3) else
        inc(U);
      inc(len);
    end;
    // decode value content
    SetLength(Value,len);
    V := pointer(Value);
    U := Beg;
    for i := 1 to len do
      if (U^='%') and HexToChar(PAnsiChar(U+1),V) then begin
        inc(V);
        inc(U,3);
      end else begin
        if U^='+' then
          V^ := ' ' else
          V^ := U^;
        inc(V);
        inc(U);
      end;
  end;
  result := U;
end;

function UrlDecodeNextName(U: PUTF8Char; out Name: RawUTF8): PUTF8Char;
var Beg, V: PUTF8Char;
    len, i: PtrInt;
begin
  result := nil;
  if U=nil then
    exit;
  // compute resulting length of name
  Beg := U;
  len := 0;
  repeat
    case U^ of
    #0:  exit;
    '=': begin
      result := U+1;
      break;
    end;
    '%': if (U[1]='3') and (U[2] in ['D','d']) then begin
           result := U+3;
           break;  // %3d means = according to the RFC
         end else
         if HexToCharValid(PAnsiChar(U+1)) then
           inc(U,3) else
           inc(U);
    else inc(U);
    end;
    inc(len);
  until false;
  // decode name content
  SetLength(Name,len);
  V := pointer(Name);
  U := Beg;
  for i := 1 to len do
    if (U^='%') and HexToChar(PAnsiChar(U+1),V) then begin
      inc(V);
      inc(U,3);
    end else begin
      if U^='+' then
        V^ := ' ' else
        V^ := U^;
      inc(V);
      inc(U);
    end;
end;

function UrlDecodeNextNameValue(U: PUTF8Char; var Name,Value: RawUTF8): PUTF8Char;
begin
  result := nil;
  if U=nil then
    exit;
  U := UrlDecodeNextName(U,Name);
  if U=nil then
    exit;
  U := UrlDecodeNextValue(U,Value);
  if U^=#0 then
    result := U else
    result := U+1; // jump '&' to let decode the next name=value pair
end;

function UrlDecodeValue(U: PUTF8Char; const Upper: RawUTF8; var Value: RawUTF8;
  Next: PPUTF8Char): boolean;
begin
  // UrlDecodeValue('select=%2A&where=LastName%3D%27M%C3%B4net%27','SELECT=',V,@U)
  // -> U^='where=...' and V='*'
  result := false; // mark value not modified by default
  if U=nil then begin
    if Next<>nil then
      Next^ := U;
    exit;
  end;
  if IdemPChar(U,pointer(Upper)) then begin
    result := true;
    inc(U,length(Upper));
    U := UrlDecodeNextValue(U,Value);
  end;
  if Next=nil then
    exit;
  while not(U^ in [#0,'&']) do inc(U);
  if U^=#0 then
    Next^ := nil else
    Next^ := U+1; // jump '&'
end;

function UrlDecodeInteger(U: PUTF8Char; const Upper: RawUTF8;
  var Value: integer; Next: PPUTF8Char): boolean;
var V: PtrInt;
    SignNeg: boolean;
begin
  // UrlDecodeInteger('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
  // -> Next^='where=...' and O=20
  result := false; // mark value not modified by default
  if U=nil then begin
    if Next<>nil then
      Next^ := U;
    exit;
  end;
  if IdemPChar(U,pointer(Upper)) then begin
    inc(U,length(Upper));
    if U^='-' then begin
      SignNeg := True;
      Inc(U);
    end else
      SignNeg := false;
    if U^ in ['0'..'9'] then begin
      V := 0;
      repeat
        V := (V*10)+ord(U^)-48;
        inc(U);
      until not (U^ in ['0'..'9']);
      if SignNeg then
        Value := -V else
        Value := V;
      result := true;
    end;
  end;
  if Next=nil then
    exit;
  while not(U^ in [#0,'&']) do inc(U);
  if U^=#0 then
    Next^ := nil else
    Next^ := U+1; // jump '&'
end;

function UrlDecodeCardinal(U: PUTF8Char; const Upper: RawUTF8;
  var Value: Cardinal; Next: PPUTF8Char): boolean;
var V: PtrInt;
begin
  // UrlDecodeInteger('offset=20&where=LastName%3D%27M%C3%B4net%27','OFFSET=',O,@Next)
  // -> Next^='where=...' and O=20
  result := false; // mark value not modified by default
  if U=nil then begin
    if Next<>nil then
      Next^ := U;
    exit;
  end;
  if IdemPChar(U,pointer(Upper)) then begin
    inc(U,length(Upper));
    if U^ in ['0'..'9'] then begin
      V := 0;
      repeat
        V := (V*10)+ord(U^)-48;
        inc(U);
      until not (U^ in ['0'..'9']);
      Value := V;
      result := true;
    end;
  end;
  if Next=nil then
    exit;
  while not(U^ in [#0,'&']) do inc(U);
  if U^=#0 then
    Next^ := nil else
    Next^ := U+1; // jump '&'
end;

function UrlDecodeInt64(U: PUTF8Char; const Upper: RawUTF8;
  var Value: Int64; Next: PPUTF8Char): boolean;
var tmp: RawUTF8;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then
    SetInt64(pointer(tmp),Value);
end;

function UrlDecodeExtended(U: PUTF8Char; const Upper: RawUTF8;
  var Value: TSynExtended; Next: PPUTF8Char=nil): boolean;
var tmp: RawUTF8;
    err: integer;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then begin
    Value := GetExtended(pointer(tmp),err);
    if err<>0 then
      result := false;
  end;
end;

function UrlDecodeDouble(U: PUTF8Char; const Upper: RawUTF8; var Value: double;
  Next: PPUTF8Char=nil): boolean;
var tmp: RawUTF8;
    err: integer;
begin
  result := UrlDecodeValue(U,Upper,tmp,Next);
  if result then begin
    Value := GetExtended(pointer(tmp),err);
    if err<>0 then
      result := false;
  end;
end;

function UrlDecodeNeedParameters(U, CSVNames: PUTF8Char): boolean;
var tmp: array[byte] of AnsiChar;
    L: integer;
    Beg: PUTF8Char;
// UrlDecodeNeedParameters('price=20.45&where=LastName%3D','price,where') will
// return TRUE
begin
  result := (CSVNames=nil);
  if result then
    exit; // no parameter to check -> success
  if U=nil then
    exit; // no input data -> error
  repeat
    L := 0;
    while (CSVNames^<>#0) and (CSVNames^<>',') do begin
      tmp[L] := NormToUpper[CSVNames^];
      if L=high(tmp) then
        exit else // invalid CSV parameter
        inc(L);
      inc(CSVNames);
    end;
    if L=0 then
      exit; // invalid CSV parameter
    PWord(@tmp[L])^ := ord('=');
    Beg := U;
    repeat
      if IdemPChar(U,tmp) then
        break;
      while not(U^ in [#0,'&']) do inc(U);
      if U^=#0 then
        exit else // didn't find tmp in U
        inc(U); // Jump &
    until false;
    U := Beg;
    if CSVNames^=#0 then
      Break else // no more parameter to check
      inc(CSVNames); // jump &
  until false;
  result := true; // all parameters found
end;

function CSVEncode(const NameValuePairs: array of const;
  const KeySeparator, ValueSeparator: RawUTF8): RawUTF8;
var i: integer;
    temp: TTextWriterStackBuffer;
begin
  if length(NameValuePairs)<2 then
    result := '' else
    with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
    try
      for i := 1 to length(NameValuePairs) shr 1 do begin
        Add(NameValuePairs[i*2-2],twNone);
        AddNoJSONEscape(pointer(KeySeparator),length(KeySeparator));
        Add(NameValuePairs[i*2-1],twNone);
        AddNoJSONEscape(pointer(ValueSeparator),length(ValueSeparator));
      end;
      SetText(result);
    finally
      Free;
    end;
end;

function ArrayOfConstValueAsText(const NameValuePairs: array of const;
  const aName: RawUTF8): RawUTF8;
var i: integer;
    name: RawUTF8;
begin
  for i := 1 to length(NameValuePairs) shr 1 do
    if VarRecToUTF8IsString(NameValuePairs[i*2-2],name) and
       IdemPropNameU(name,aName) then begin
      VarRecToUTF8(NameValuePairs[i*2-1],result);
      exit;
    end;
  result := '';
end;

function IsZero(P: pointer; Length: integer): boolean;
var i: integer;
begin
  result := false;
  for i := 1 to Length shr 4 do // 16 bytes (4 DWORD) by loop - aligned read
    {$ifdef CPU64}
    if (PInt64Array(P)^[0]<>0) or (PInt64Array(P)^[1]<>0) then
    {$else}
    if (PCardinalArray(P)^[0]<>0) or (PCardinalArray(P)^[1]<>0) or
       (PCardinalArray(P)^[2]<>0) or (PCardinalArray(P)^[3]<>0) then
    {$endif}
      exit else
      inc(PByte(P),16);
  for i := 1 to (Length shr 2)and 3 do // 4 bytes (1 DWORD) by loop
    if PCardinal(P)^<>0 then
      exit else
      inc(PByte(P),4);
  for i := 1 to Length and 3 do // remaining content
    if PByte(P)^<>0 then
      exit else
      inc(PByte(P));
  result := true;
end;

function IsZero(const Values: TRawUTF8DynArray): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to length(Values)-1 do
    if Values[i]<>'' then
      exit;
  result := true;
end;

function IsZero(const Values: TIntegerDynArray): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to length(Values)-1 do
    if Values[i]<>0 then
      exit;
  result := true;
end;

function IsZero(const Values: TInt64DynArray): boolean;
var i: integer;
begin
  result := false;
  for i := 0 to length(Values)-1 do
    if Values[i]<>0 then
      exit;
  result := true;
end;

procedure FillZero(var Values: TRawUTF8DynArray);
var i: integer;
begin
  for i := 0 to length(Values)-1 do
    {$ifdef FPC}Finalize(Values[i]){$else}Values[i] := ''{$endif};
end;

procedure FillZero(var Values: TIntegerDynArray);
begin
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(Values[0],length(Values)*SizeOf(integer),0);
end;

procedure FillZero(var Values: TInt64DynArray);
begin
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(Values[0],length(Values)*SizeOf(Int64),0);
end;


function crc16(Data: PAnsiChar; Len: integer): cardinal;
var i, j: Integer;
begin
  result := $ffff;
  for i := 0 to Len-1 do begin
    result := result xor (ord(Data[i]) shl 8);
    for j := 1 to 8 do
      if result and $8000<>0 then
        result := (result shl 1) xor $1021 else
        result := result shl 1;
  end;
  result := result and $ffff;
end;

function Hash32(const Text: RawByteString): cardinal;
begin
  result := Hash32(pointer(Text),length(Text));
end;

function Hash32(Data: PCardinalArray; Len: integer): cardinal;
var s1,s2: cardinal;
    i: integer;
begin
  if Data<>nil then begin
    s1 := 0;
    s2 := 0;
    for i := 1 to Len shr 4 do begin // 16 bytes (128-bit) loop - aligned read
      inc(s1,Data[0]);
      inc(s2,s1);
      inc(s1,Data[1]);
      inc(s2,s1);
      inc(s1,Data[2]);
      inc(s2,s1);
      inc(s1,Data[3]);
      inc(s2,s1);
      Data := @Data[4];
    end;
    for i := 1 to (Len shr 2)and 3 do begin // 4 bytes (DWORD) by loop
      inc(s1,Data[0]);
      inc(s2,s1);
      Data := @Data[1];
    end;
    case Len and 3 of // remaining 0..3 bytes
    1: inc(s1,PByte(Data)^);
    2: inc(s1,PWord(Data)^);
    3: inc(s1,PWord(Data)^ or (PByteArray(Data)^[2] shl 16));
    end;
    inc(s2,s1);
    result := s1 xor (s2 shl 16);
  end else
    result := 0;
end;

procedure OrMemory(Dest,Source: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Dest)^ or PPtrInt(Source)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Dest[size] or Source[size];
  end;
end;

procedure XorMemory(Dest,Source: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Dest)^ xor PPtrInt(Source)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Dest[size] xor Source[size];
  end;
end;

procedure XorMemory(Dest,Source1,Source2: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Source1)^ xor PPtrInt(Source2)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source1));
    inc(PPtrInt(Source2));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Source1[size] xor Source2[size];
  end;
end;

procedure AndMemory(Dest,Source: PByteArray; size: PtrInt);
begin
  while size>=SizeOf(PtrInt) do begin
    dec(size,SizeOf(PtrInt));
    PPtrInt(Dest)^ := PPtrInt(Dest)^ and PPtrInt(Source)^;
    inc(PPtrInt(Dest));
    inc(PPtrInt(Source));
  end;
  while size>0 do begin
    dec(size);
    Dest[size] := Dest[size] and Source[size];
  end;
end;

{$ifdef CPUINTEL} // use optimized x86/x64 asm versions for xxHash32

{$ifdef CPUX86}
function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        xchg    edx, ecx
        push    ebp
        push    edi
        lea     ebp, [ecx+edx]
        push    esi
        push    ebx
        sub     esp, 8
        mov     ebx, eax
        mov     dword ptr [esp], edx
        lea     eax, [ebx+165667B1H]
        cmp     edx, 15
        jbe     @2
        lea     eax, [ebp-10H]
        lea     edi, [ebx+24234428H]
        lea     esi, [ebx-7A143589H]
        mov     dword ptr [esp+4H], ebp
        mov     edx, eax
        lea     eax, [ebx+61C8864FH]
        mov     ebp, edx
@1:     mov     edx, dword ptr [ecx]
        imul    edx, -2048144777
        add     edi, edx
        rol     edi, 13
        imul    edi, -1640531535
        mov     edx, dword ptr [ecx+4]
        imul    edx, -2048144777
        add     esi, edx
        rol     esi, 13
        imul    esi, -1640531535
        mov     edx, dword ptr [ecx+8]
        imul    edx, -2048144777
        add     ebx, edx
        rol     ebx, 13
        imul    ebx, -1640531535
        mov     edx, dword ptr [ecx+12]
        lea     ecx, [ecx+16]
        imul    edx, -2048144777
        add     eax, edx
        rol     eax, 13
        imul    eax, -1640531535
        cmp     ebp, ecx
        jnc     @1
        rol     edi, 1
        rol     esi, 7
        rol     ebx, 12
        add     esi, edi
        mov     ebp, dword ptr [esp+4H]
        ror     eax, 14
        add     ebx, esi
        add     eax, ebx
@2:     lea     esi, [ecx+4H]
        add     eax, dword ptr [esp]
        cmp     ebp, esi
        jc      @4
        mov     ebx, esi
        nop
@3:     imul    edx, dword ptr [ebx-4H], -1028477379
        add     ebx, 4
        add     eax, edx
        ror     eax, 15
        imul    eax, 668265263
        cmp     ebp, ebx
        jnc     @3
        lea     edx, [ebp-4H]
        sub     edx, ecx
        mov     ecx, edx
        and     ecx, 0FFFFFFFCH
        add     ecx, esi
@4:     cmp     ebp, ecx
        jbe     @6
@5:     movzx   edx, byte ptr [ecx]
        add     ecx, 1
        imul    edx, 374761393
        add     eax, edx
        rol     eax, 11
        imul    eax, -1640531535
        cmp     ebp, ecx
        jnz     @5
        nop
@6:     mov     edx, eax
        add     esp, 8
        shr     edx, 15
        xor     eax, edx
        imul    eax, -2048144777
        pop     ebx
        pop     esi
        mov     edx, eax
        shr     edx, 13
        xor     eax, edx
        imul    eax, -1028477379
        pop     edi
        pop     ebp
        mov     edx, eax
        shr     edx, 16
        xor     eax, edx
end;
{$endif CPUX86}

{$ifdef CPUX64}
function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe{$endif}
        {$ifdef LINUX} // crc=rdi P=rsi len=rdx
        mov     r8, rdi
        mov     rcx, rsi
        {$else} // crc=r8 P=rcx len=rdx
        mov     r10, r8
        mov     r8, rcx
        mov     rcx, rdx
        mov     rdx, r10
        push    rsi   // Win64 expects those registers to be preserved
        push    rdi
        {$endif}
        // P=r8 len=rcx crc=rdx
        push    r12
        push    rbx
        mov     r12d, -1640531535
        lea     r10, [rcx+rdx]
        lea     eax, [r8+165667B1H]
        cmp     rdx, 15
        jbe     @2
        lea     rsi, [r10-10H]
        lea     ebx, [r8+24234428H]
        lea     edi, [r8-7A143589H]
        lea     eax, [r8+61C8864FH]
@1:     imul    r9d, dword ptr [rcx], -2048144777
        add     rcx, 16
        imul    r11d, dword ptr [rcx-0CH], -2048144777
        add     ebx, r9d
        lea     r9d, [r11+rdi]
        rol     ebx, 13
        rol     r9d, 13
        imul    ebx, r12d
        imul    edi, r9d, -1640531535
        imul    r9d, dword ptr [rcx-8H], -2048144777
        add     r8d, r9d
        imul    r9d, dword ptr [rcx-4H], -2048144777
        rol     r8d, 13
        imul    r8d, r12d
        add     eax, r9d
        rol     eax, 13
        imul    eax, r12d
        cmp     rsi, rcx
        jnc     @1
        rol     edi, 7
        rol     ebx, 1
        rol     r8d, 12
        mov     r9d, edi
        ror     eax, 14
        add     r9d, ebx
        add     r8d, r9d
        add     eax, r8d
@2:     lea     r9, [rcx+4H]
        add     eax, edx
        cmp     r10, r9
        jc      @4
        mov     r8, r9
@3:     imul    edx, dword ptr [r8-4H], -1028477379
        add     r8, 4
        add     eax, edx
        ror     eax, 15
        imul    eax, 668265263
        cmp     r10, r8
        jnc     @3
        lea     rdx, [r10-4H]
        sub     rdx, rcx
        mov     rcx, rdx
        and     rcx, 0FFFFFFFFFFFFFFFCH
        add     rcx, r9
@4:     cmp     r10, rcx
        jbe     @6
@5:     movzx   edx, byte ptr [rcx]
        add     rcx, 1
        imul    edx, 374761393
        add     eax, edx
        rol     eax, 11
        imul    eax, r12d
        cmp     r10, rcx
        jnz     @5
@6:     mov     edx, eax
        shr     edx, 15
        xor     eax, edx
        imul    eax, -2048144777
        mov     edx, eax
        shr     edx, 13
        xor     eax, edx
        imul    eax, -1028477379
        mov     edx, eax
        shr     edx, 16
        xor     eax, edx
        pop     rbx
        pop     r12
        {$ifndef LINUX}
        pop     rdi
        pop     rsi
        {$endif}
end;
{$endif CPUX64}

{$else not CPUINTEL}

const
  PRIME32_1 = 2654435761;
  PRIME32_2 = 2246822519;
  PRIME32_3 = 3266489917;
  PRIME32_4 = 668265263;
  PRIME32_5 = 374761393;

{$ifdef FPC} // RolDWord is an intrinsic function under FPC :)
function Rol13(value: cardinal): cardinal; inline;
begin
  result := RolDWord(value, 13);
end;
{$else}
{$ifdef HASINLINENOTX86}
function RolDWord(value: cardinal; count: integer): cardinal; inline;
begin
  result := (value shl count) or (value shr (32-count));
end;

function Rol13(value: cardinal): cardinal; inline;
begin
  result := (value shl 13) or (value shr 19);
end;
{$else}
function RolDWord(value: cardinal; count: integer): cardinal;
asm
      mov     cl, dl
      rol     eax, cl
end;

function Rol13(value: cardinal): cardinal;
asm
      rol     eax, 13
end;
{$endif HASINLINENOTX86}
{$endif FPC}

function xxHash32(crc: cardinal; P: PAnsiChar; len: integer): cardinal;
var c1, c2, c3, c4: cardinal;
    PLimit, PEnd: PAnsiChar;
begin
  PEnd := P + len;
  if len >= 16 then begin
    PLimit := PEnd - 16;
    c3 := crc;
    c2 := c3 + PRIME32_2;
    c1 := c2 + PRIME32_1;
    c4 := c3 - PRIME32_1;
    repeat
      c1 := PRIME32_1 * Rol13(c1 + PRIME32_2 * PCardinal(P)^);
      c2 := PRIME32_1 * Rol13(c2 + PRIME32_2 * PCardinal(P+4)^);
      c3 := PRIME32_1 * Rol13(c3 + PRIME32_2 * PCardinal(P+8)^);
      c4 := PRIME32_1 * Rol13(c4 + PRIME32_2 * PCardinal(P+12)^);
      inc(P, 16);
    until not (P <= PLimit);
    result := RolDWord(c1, 1) + RolDWord(c2, 7) + RolDWord(c3, 12) + RolDWord(c4, 18);
  end else
    result := crc + PRIME32_5;
  inc(result, len);
  while P + 4 <= PEnd do begin
    inc(result, PCardinal(P)^ * PRIME32_3);
    result := RolDWord(result, 17) * PRIME32_4;
    inc(P, 4);
  end;
  while P < PEnd do begin
    inc(result, PByte(P)^ * PRIME32_5);
    result := RolDWord(result, 11) * PRIME32_1;
    inc(P);
  end;
  result := result xor (result shr 15);
  result := result * PRIME32_2;
  result := result xor (result shr 13);
  result := result * PRIME32_3;
  result := result xor (result shr 16);
end;

{$endif CPUINTEL}

type
 TRegisters = record
   eax,ebx,ecx,edx: cardinal;
 end;

{$ifdef CPUINTEL}
{$ifdef CPU64}
procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // ecx=param, rdx=Registers (Linux: edi,rsi)
{$endif FPC}
        {$ifdef win64}
        mov     eax, ecx
        mov     r9, rdx
        {$else}
        mov     eax, edi
        mov     r9, rsi
        {$endif win64}
        mov     r10, rbx // preserve rbx
        xor     ebx, ebx
        xor     ecx, ecx
        xor     edx, edx
        cpuid
        mov     TRegisters(r9).&eax, eax
        mov     TRegisters(r9).&ebx, ebx
        mov     TRegisters(r9).&ecx, ecx
        mov     TRegisters(r9).&edx, edx
        mov     rbx, r10
end;

const
  CMP_RANGES = $44; // see https://msdn.microsoft.com/en-us/library/bb531425
  _UpperCopy255BufSSE42: array[0..31] of AnsiChar =
    'azazazazazazazaz                ';

function UpperCopy255BufSSE42(dest: PAnsiChar; source: PUTF8Char; sourceLen: PtrInt): PAnsiChar;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=dest, rdx=source, r8=len (Linux: rdi,rsi,rdx)
{$endif FPC}
       {$ifdef win64}
       mov     rax, rcx
       mov     r9, rdx
       mov     rdx, r8
       {$else}
       mov     rax, rdi
       mov     r9, rsi
       {$endif}
       lea     rcx, [rip + _UpperCopy255BufSSE42]
       test    rdx, rdx
       jz      @z
       movdqu  xmm1, dqword ptr [rcx]
       movdqu  xmm3, dqword ptr [rcx + 16]
       cmp     rdx, 16
       ja      @big
       // optimize the common case of sourceLen<=16
       movdqu  xmm2, [r9]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES // find in range a-z, return mask in xmm0
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movdqu  [rax], xmm2
       add     rax, rdx
@z:    ret
@big:  mov     rcx, rax
       cmp     rdx, 240
       jb      @ok
       mov     rdx, 239
@ok:   add     rax, rdx // return end position with the exact size
       shr     rdx, 4
       sub     r9, rcx
       add     rdx, 1
       {$ifdef FPC}align 8{$endif}
@s:    movdqu  xmm2, [r9 + rcx]
       {$ifdef HASAESNI}
       pcmpistrm xmm1, xmm2, CMP_RANGES
       {$else}
       db $66, $0F, $3A, $62, $CA, CMP_RANGES
       {$endif}
       pand    xmm0, xmm3
       pxor    xmm2, xmm0
       movdqu  [rcx], xmm2
       add     rcx, 16
       dec     rdx
       jnz     @s
end;

function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // ecx=crc, rdx=buf, r8=len (Linux: edi,rsi,rdx)
{$endif FPC}
        {$ifdef win64}
        mov     eax, ecx
        {$else}
        mov     eax, edi
        mov     r8, rdx
        mov     rdx, rsi
        {$endif win64}
        not     eax
        test    rdx, rdx
        jz      @0
        test    r8, r8
        jz      @0
        test    dl, 7
        jz      @8 // align to 8 bytes boundary
        {$ifdef FPC}align 8{$endif}
@7:     crc32   eax, byte ptr[rdx]
        inc     rdx
        dec     r8
        jz      @0
        test    dl, 7
        jnz     @7
@8:     mov     rcx, r8
        shr     r8, 3
        jz      @2
        {$ifdef FPC}align 8{$endif}
@1:     {$ifdef FPC}
        crc32   rax, qword [rdx] // hash 8 bytes per loop
        {$else}
        db $F2,$48,$0F,$38,$F1,$02 // circumvent Delphi inline asm compiler bug
        {$endif}
        add     rdx, 8
        dec     r8
        jnz     @1
@2:     and     ecx, 7
        jz      @0
        cmp     ecx, 4
        jb      @4
        crc32   eax, dword ptr[rdx]
        add     rdx, 4
        sub     ecx, 4
        jz      @0
@4:     crc32   eax, byte ptr[rdx]
        dec     ecx
        jz      @0
        crc32   eax, byte ptr[rdx + 1]
        dec     ecx
        jz      @0
        crc32   eax, byte ptr[rdx + 2]
@0:     not     eax
end;

function StrLenSSE2(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm .noframe // rcx=S (Linux: rdi)
{$endif FPC} // from GPL strlen64.asm by Agner Fog - www.agner.org/optimize
        {$ifdef win64}
        mov     rax, rcx             // get pointer to string from rcx
        mov     r8,  rcx             // copy pointer
        test    rcx, rcx
        {$else}
        mov     rax, rdi
        mov     ecx, edi
        test    rdi, rdi
        {$endif}
        jz      @null                // returns 0 if S=nil
        // rax=s,ecx=32-bit of s
        pxor    xmm0, xmm0           // set to zero
        and     ecx, 15              // lower 4 bits indicate misalignment
        and     rax, -16             // align pointer by 16
        // will never read outside a memory page boundary, so won't trigger GPF
        movdqa  xmm1, [rax]          // read from nearest preceding boundary
        pcmpeqb xmm1, xmm0           // compare 16 bytes with zero
        pmovmskb edx, xmm1           // get one bit for each byte result
        shr     edx, cl              // shift out false bits
        shl     edx, cl              // shift back again
        bsf     edx, edx             // find first 1-bit
        jnz     @L2                  // found
        // Main loop, search 16 bytes at a time
        {$ifdef FPC}align 8{$endif}
@L1:    add     rax, 10H             // increment pointer by 16
        movdqa  xmm1, [rax]          // read 16 bytes aligned
        pcmpeqb xmm1, xmm0           // compare 16 bytes with zero
        pmovmskb edx, xmm1           // get one bit for each byte result
        bsf     edx, edx             // find first 1-bit
        // (moving the bsf out of the loop and using test here would be faster
        // for long strings on old processors, but we are assuming that most
        // strings are short, and newer processors have higher priority)
        jz      @L1                  // loop if not found
@L2:    // Zero-byte found. Compute string length
        {$ifdef win64}
        sub     rax, r8              // subtract start address
        {$else}
        sub     rax, rdi
        {$endif}
        add     rax, rdx             // add byte index
@null:
end;

const
  EQUAL_EACH = 8;   // see https://msdn.microsoft.com/en-us/library/bb531463
  NEGATIVE_POLARITY = 16;

{$ifdef HASAESNI}
function StrLenSSE42(S: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=S (Linux: rdi)
        .noframe
{$endif FPC}
        xor     rax, rax
        {$ifdef win64}
        mov     rdx, rcx
        test    rcx, rcx
        {$else}
        mov     rdx, rdi
        test    rdi, rdi
        {$endif}
        jz      @null
        xor     rcx, rcx
        pxor    xmm0, xmm0
        pcmpistri xmm0, [rdx], EQUAL_EACH // result in ecx
        jnz     @L
        mov     eax, ecx
@null:  ret
        {$ifdef FPC}align 8{$endif}
@L:     add     rax, 16   // add before comparison flag
        pcmpistri xmm0, [rdx + rax], EQUAL_EACH // result in ecx
        jnz     @L
        add     rax, rcx
end;

function StrCompSSE42(Str1, Str2: pointer): PtrInt;
{$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=Str1, rdx=Str2 (Linux: rdi,rsi)
        .noframe
{$endif FPC}
      {$ifdef win64}
      mov       rax, rcx
      test      rcx, rdx
      {$else}
      mov       rax, rdi
      mov       rdx, rsi
      test      rdi, rsi  // is one of Str1/Str2 nil ?
      {$endif}
      jz        @n
@ok:  sub       rax, rdx
      xor       rcx, rcx
      movdqu    xmm0, dqword [rdx]
      pcmpistri xmm0, dqword [rdx + rax], EQUAL_EACH + NEGATIVE_POLARITY // result in rcx
      ja        @1
      jc        @2
      xor       rax, rax
      ret
      {$ifdef FPC}align 8{$endif}
@1:   add       rdx, 16
      movdqu    xmm0, dqword [rdx]
      pcmpistri xmm0, dqword [rdx + rax], EQUAL_EACH + NEGATIVE_POLARITY
      ja        @1
      jc        @2
@0:   xor       rax, rax // Str1=Str2
      ret
@n:   cmp       rax, rdx
      je        @0
      test      rax, rax  // Str1='' ?
      jz        @max
      test      rdx, rdx  // Str2='' ?
      jnz       @ok
      mov       rax, 1
      ret
@max: dec       rax  // returns -1
      ret
@2:   add       rax, rdx
      movzx     rax, byte ptr [rax + rcx]
      movzx     rdx, byte ptr [rdx + rcx]
      sub       rax, rdx
end;
{$endif HASAESNI}
{$endif CPU64}
{$endif CPUINTEL}

procedure crcblocks(crc128, data128: PBlock128; count: integer);
var oneblock: procedure(crc128, data128: PBlock128);
    i: integer;
begin
  if count>0 then
    {$ifndef DISABLE_SSE42}
    {$ifdef CPUX86}
    if cfSSE42 in CpuFeatures then
    asm
          mov     ecx, crc128
          mov     edx, data128
  @s:     mov     eax, dword ptr[ecx]
          db      $F2, $0F, $38, $F1, $02 // crc32 eax, dword ptr [edx]
          mov     dword ptr[ecx], eax
          mov     eax, dword ptr[ecx + 4]
          db      $F2, $0F, $38, $F1, $42, $04 // crc32 eax, dword ptr [edx+4]
          mov     dword ptr[ecx + 4], eax
          mov     eax, dword ptr[ecx + 8]
          db      $F2, $0F, $38, $F1, $42, $08 // crc32 eax, dword ptr [edx+8]
          mov     dword ptr[ecx + 8], eax
          mov     eax, dword ptr[ecx + 12]
          db      $F2, $0F, $38, $F1, $42, $0C // crc32 eax, dword ptr [edx+12]
          mov     dword ptr[ecx + 12], eax
          add     edx, 16
          dec     count
          jnz     @s
    end else
    {$endif CPUX86}
    {$ifdef CPUX64}
    {$ifdef FPC} // only FPC is able to compile such inlined asm block
    if cfSSE42 in CpuFeatures then
    asm
          mov     rax, data128
          mov     rdx, crc128
          mov     ecx, count
          mov     r8d, dword ptr [rdx]
          mov     r9d, dword ptr [rdx + 4]
          mov     r10d, dword ptr [rdx + 8]
          mov     r11d, dword ptr [rdx + 12]
          align 8
@s:       crc32   r8d, dword ptr [rax]
          crc32   r9d, dword ptr [rax + 4]
          crc32   r10d, dword ptr [rax + 8]
          crc32   r11d, dword ptr [rax + 12]
          add     rax, 16
          dec     ecx
          jnz     @s
          mov     dword ptr [rdx], r8d
          mov     dword ptr [rdx + 4], r9d
          mov     dword ptr [rdx + 8], r10d
          mov     dword ptr [rdx + 12], r11d
    end else
    {$endif FPC}
    {$endif CPUX64}
    {$endif DISABLE_SSE42} begin
      oneblock := @crcblock;
      for i := 1 to count do begin
        oneblock(crc128,data128);
        inc(data128);
      end;
    end;
end;

{$ifdef CPUINTEL}
function crc32cBy4SSE42(crc, value: cardinal): cardinal;
{$ifdef CPU64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=crc, rdx=value(Linux: rdi,rsi)
        .noframe
{$endif FPC}
        {$ifdef Linux}
        mov     eax, edi
        crc32   eax, esi
        {$else}
        mov     eax, ecx
        crc32   eax, edx
        {$endif}
end;
{$else} {$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=crc, edx=value
        {$ifdef FPC_OR_UNICODE}
        crc32   eax, edx
        {$else}
        db      $F2, $0F, $38, $F1, $C2
        {$endif}
end;
{$endif CPU64}

procedure crcblockSSE42(crc128, data128: PBlock128);
{$ifdef CPU64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm // rcx=crc128, rdx=data128 (Linux: rdi,rsi)
        .noframe
{$endif FPC}
        {$ifdef Linux}
        mov     eax, dword ptr[rdi]
        mov     r8d, dword ptr[rdi + 4]
        mov     r9d, dword ptr[rdi + 8]
        mov     r10d, dword ptr[rdi + 12]
        crc32   eax, dword ptr[rsi]
        crc32   r8d, dword ptr[rsi + 4]
        crc32   r9d, dword ptr[rsi + 8]
        crc32   r10d, dword ptr[rsi + 12]
        mov     dword ptr[rdi], eax
        mov     dword ptr[rdi + 4], r8d
        mov     dword ptr[rdi + 8], r9d
        mov     dword ptr[rdi + 12], r10d
        {$else}
        mov     eax, dword ptr[rcx]
        mov     r8d, dword ptr[rcx + 4]
        mov     r9d, dword ptr[rcx + 8]
        mov     r10d, dword ptr[rcx + 12]
        crc32   eax, dword ptr[rdx]
        crc32   r8d, dword ptr[rdx + 4]
        crc32   r9d, dword ptr[rdx + 8]
        crc32   r10d, dword ptr[rdx + 12]
        mov     dword ptr[rcx], eax
        mov     dword ptr[rcx + 4], r8d
        mov     dword ptr[rcx + 8], r9d
        mov     dword ptr[rcx + 12], r10d
        {$endif Linux}
end;
{$else} {$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=crc128, edx=data128
        mov     ecx, eax
        {$ifdef FPC_OR_UNICODE}
        mov     eax, dword ptr[ecx]
        crc32   eax, dword ptr[edx]
        mov     dword ptr[ecx], eax
        mov     eax, dword ptr[ecx + 4]
        crc32   eax, dword ptr[edx + 4]
        mov     dword ptr[ecx + 4], eax
        mov     eax, dword ptr[ecx + 8]
        crc32   eax, dword ptr[edx + 8]
        mov     dword ptr[ecx + 8], eax
        mov     eax, dword ptr[ecx + 12]
        crc32   eax, dword ptr[edx + 12]
        mov     dword ptr[ecx + 12], eax
        {$else}
        mov     eax, dword ptr[ecx]
        db      $F2, $0F, $38, $F1, $02
        mov     dword ptr[ecx], eax
        mov     eax, dword ptr[ecx + 4]
        db      $F2, $0F, $38, $F1, $42, $04
        mov     dword ptr[ecx + 4], eax
        mov     eax, dword ptr[ecx + 8]
        db      $F2, $0F, $38, $F1, $42, $08
        mov     dword ptr[ecx + 8], eax
        mov     eax, dword ptr[ecx + 12]
        db      $F2, $0F, $38, $F1, $42, $0C
        mov     dword ptr[ecx + 12], eax
        {$endif FPC_OR_UNICODE}
end;
{$endif CPU64}
{$endif CPUINTEL}

function crc32cBy4fast(crc, value: cardinal): cardinal;
var tab: ^TCrc32tab;
begin
  tab := @crc32ctab;
  result := crc xor value;
  result := tab[3,ToByte(result)] xor
            tab[2,ToByte(result shr 8)] xor
            tab[1,ToByte(result shr 16)] xor
            tab[0,result shr 24];
end;

function crc32cinlined(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef HASINLINE}
var tab: ^TCrc32tab;
begin
  result := not crc;
  if len>0 then begin
    tab := @crc32ctab;
    repeat
      result := tab[0,(result xor ord(buf^))and 255] xor (result shr 8);
      inc(buf);
      dec(len);
    until len=0;
  end;
  result := not result;
end;
{$else}
begin
  result := crc32c(crc,buf,len);
end;
{$endif}

{$ifdef CPUX86}
procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
        push    esi
        push    edi
        mov     esi, edx
        mov     edi, eax
        pushfd
        pop     eax
        mov     edx, eax
        xor     eax, $200000
        push    eax
        popfd
        pushfd
        pop     eax
        xor     eax, edx
        jz      @nocpuid
        push    ebx
        mov     eax, edi
        xor     ecx, ecx
        {$ifdef DELPHI5OROLDER}
        db      $0f, $a2
        {$else}
        cpuid
        {$endif}
        mov     TRegisters(esi).&eax, eax
        mov     TRegisters(esi).&ebx, ebx
        mov     TRegisters(esi).&ecx, ecx
        mov     TRegisters(esi).&edx, edx
        pop     ebx
@nocpuid:
        pop     edi
        pop     esi
end;

function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=crc, edx=buf, ecx=len
        not     eax
        test    ecx, ecx
        jz      @0
        test    edx, edx
        jz      @0
@3:     test    edx, 3
        jz      @8 // align to 4 bytes boundary
        {$ifdef FPC_OR_UNICODE}
        crc32   eax, byte ptr[edx]
        {$else}
        db      $F2, $0F, $38, $F0, $02
        {$endif}
        inc     edx
        dec     ecx
        jz      @0
        test    edx, 3
        jnz     @3
@8:     push    ecx
        shr     ecx, 3
        jz      @2
@1:     {$ifdef FPC_OR_UNICODE}
        crc32   eax, dword ptr[edx]
        crc32   eax, dword ptr[edx + 4]
        {$else}
        db      $F2, $0F, $38, $F1, $02
        db      $F2, $0F, $38, $F1, $42, $04
        {$endif}
        add     edx, 8
        dec     ecx
        jnz     @1
@2:     pop     ecx
        and     ecx, 7
        jz      @0
        cmp     ecx, 4
        jb      @4
        {$ifdef FPC_OR_UNICODE}
        crc32   eax, dword ptr[edx]
        {$else}
        db      $F2, $0F, $38, $F1, $02
        {$endif}
        add     edx, 4
        sub     ecx, 4
        jz      @0
@4:     {$ifdef FPC_OR_UNICODE}
        crc32   eax, byte ptr[edx]
        dec     ecx
        jz      @0
        crc32   eax, byte ptr[edx + 1]
        dec     ecx
        jz      @0
        crc32   eax, byte ptr[edx + 2]
        {$else}
        db      $F2, $0F, $38, $F0, $02
        dec     ecx
        jz      @0
        db      $F2, $0F, $38, $F0, $42, $01
        dec     ecx
        jz      @0
        db      $F2, $0F, $38, $F0, $42, $02
        {$endif}
@0:     not     eax
end;
{$endif CPUX86}

function crc32cUTF8ToHex(const str: RawUTF8): RawUTF8;
begin
  result := CardinalToHex(crc32c(0,pointer(str),length(str)));
end;

function crc64c(buf: PAnsiChar; len: cardinal): Int64;
var hilo: Int64Rec absolute result;
begin
  hilo.Lo := crc32c(0,buf,len);
  hilo.Hi := crc32c(hilo.Lo,buf,len);
end;

function crc63c(buf: PAnsiChar; len: cardinal): Int64;
var hilo: Int64Rec absolute result;
begin
  hilo.Lo := crc32c(0,buf,len);
  hilo.Hi := crc32c(hilo.Lo,buf,len) and $7fffffff;
end;

procedure crc128c(buf: PAnsiChar; len: cardinal; out crc: THash128);
var h: THash128Rec absolute crc;
    h1,h2: cardinal;
begin // see https://goo.gl/Pls5wi
  assert(SizeOf(h)=SizeOf(crc));
  h1 := crc32c(0,buf,len);
  h2 := crc32c(h1,buf,len);
  h.i0 := h1; inc(h1,h2);
  h.i1 := h1; inc(h1,h2);
  h.i2 := h1; inc(h1,h2);
  h.i3 := h1;
end;

function IsZero(const dig: THash128): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := (a[0]=0) and (a[1]=0)
     {$ifndef CPU64} and (a[2]=0) and (a[3]=0){$endif};
end;

function IsEqual(const A,B: THash128): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1])
    {$ifndef CPU64} or (a_[2] xor b_[2]) or (a_[3] xor b_[3]){$endif})=0;
end;

procedure FillZero(out dig: THash128);
begin
  PInt64Array(@dig)^[0] := 0;
  PInt64Array(@dig)^[1] := 0;
end;

function HashFound(P: PHash128Rec; Count: integer; const h: THash128Rec): boolean;
var first{$ifdef CPU64}, second{$endif}: PtrInt;
    i: integer;
begin // fast O(n) brute force search
  if P<>nil then begin
    result := true;
    first := h.Lo;
    {$ifdef CPU64}
    second := h.hi;
    for i := 1 to Count do
      if (P^.Lo=first) and (P^.Hi=second) then
    {$else}
    for i := 1 to Count do
      if (P^.i0=first) and (P^.i1=h.i1) and (P^.i2=h.i2) and (P^.i3=h.i3) then
    {$endif}
        exit else
        inc(P);
  end;
  result := false;
end;

function IP4Text(ip4: cardinal): shortstring;
var b: array[0..3] of byte absolute ip4;
begin
  if ip4=0 then
    result := '' else
    FormatShort('%.%.%.%',[b[0],b[1],b[2],b[3]],result);
end;

procedure IP6Text(ip6: PHash128; result: PShortString);
var i: integer;
    p: PByte;
    {$ifdef PUREPASCAL}tab: ^TByteToWord;{$endif}
begin
  if IsZero(ip6^) then
    result^ := '' else begin
    result^[0] := AnsiChar(39);
    p := @result^[1];
    {$ifdef PUREPASCAL}tab := @TwoDigitsHexWBLower;{$endif}
    for i := 0 to 7 do begin
      PWord(p)^ := {$ifdef PUREPASCAL}tab{$else}TwoDigitsHexWBLower{$endif}[ip6^[0]]; inc(p,2);
      PWord(p)^ := {$ifdef PUREPASCAL}tab{$else}TwoDigitsHexWBLower{$endif}[ip6^[1]]; inc(p,2);
      inc(PWord(ip6));
      p^ := ord(':'); inc(p);
    end;
  end;
end;

function IP6Text(ip6: PHash128): shortstring;
begin
  IP6Text(ip6, @result);
end;

function IsZero(const dig: THash160): boolean;
var a: TIntegerArray absolute dig;
begin
  result := (a[0]=0) and (a[1]=0) and (a[2]=0) and (a[3]=0) and (a[4]=0);
end;

function IsEqual(const A,B: THash160): boolean;
var a_: TIntegerArray absolute A;
    b_: TIntegerArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or (a_[2] xor b_[2]) or
    (a_[3] xor b_[3]) or (a_[4] xor b_[4]))=0;
end;

procedure FillZero(out dig: THash160);
begin
  PInt64Array(@dig)^[0] := 0;
  PInt64Array(@dig)^[1] := 0;
  PIntegerArray(@dig)^[4] := 0;
end;

procedure crc256c(buf: PAnsiChar; len: cardinal; out crc: THash256);
var h: THash256Rec absolute crc;
    h1,h2: cardinal;
begin // see https://goo.gl/Pls5wi
  h1 := crc32c(0,buf,len);
  h2 := crc32c(h1,buf,len);
  h.i0 := h1; inc(h1,h2);
  h.i1 := h1; inc(h1,h2);
  h.i2 := h1; inc(h1,h2);
  h.i3 := h1; inc(h1,h2);
  h.i4 := h1; inc(h1,h2);
  h.i5 := h1; inc(h1,h2);
  h.i6 := h1; inc(h1,h2);
  h.i7 := h1;
end;

function IsZero(const dig: THash256): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := (a[0]=0) and (a[1]=0) and (a[2]=0) and (a[3]=0)
     {$ifndef CPU64} and (a[4]=0) and (a[5]=0)
                     and (a[6]=0) and (a[7]=0){$endif};
end;

function IsEqual(const A,B: THash256): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or
             (a_[2] xor b_[2]) or (a_[3] xor b_[3])
    {$ifndef CPU64} or (a_[4] xor b_[4]) or (a_[5] xor b_[5])
                    or (a_[6] xor b_[6]) or (a_[7] xor b_[7]) {$endif})=0;
end;

procedure FillZero(out dig: THash256);
begin
  PInt64Array(@dig)^[0] := 0;
  PInt64Array(@dig)^[1] := 0;
  PInt64Array(@dig)^[2] := 0;
  PInt64Array(@dig)^[3] := 0;
end;

function IsZero(const dig: THash384): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := (a[0]=0) and (a[1]=0) and (a[2]=0) and (a[3]=0) and (a[4]=0) and (a[5]=0)
     {$ifndef CPU64} and (a[6]=0) and (a[7]=0) and (a[8]=0)
                     and (a[9]=0) and (a[10]=0) and (a[11]=0){$endif};
end;

function IsEqual(const A,B: THash384): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or
             (a_[2] xor b_[2]) or (a_[3] xor b_[3]) or
             (a_[4] xor b_[4]) or (a_[5] xor b_[5])
    {$ifndef CPU64} or (a_[6] xor b_[6]) or (a_[7] xor b_[7])
                    or (a_[8] xor b_[8]) or (a_[9] xor b_[9])
                    or (a_[10] xor b_[10]) or (a_[11] xor b_[11]) {$endif})=0;
end;

procedure FillZero(out dig: THash384);
begin
  PInt64Array(@dig)^[0] := 0;
  PInt64Array(@dig)^[1] := 0;
  PInt64Array(@dig)^[2] := 0;
  PInt64Array(@dig)^[3] := 0;
  PInt64Array(@dig)^[4] := 0;
  PInt64Array(@dig)^[5] := 0;
end;

function IsZero(const dig: THash512): boolean;
var a: TPtrIntArray absolute dig;
begin
  result := (a[0]=0) and (a[1]=0) and (a[2]=0) and (a[3]=0) and
            (a[4]=0) and (a[5]=0) and (a[6]=0) and (a[7]=0)
     {$ifndef CPU64} and (a[8]=0) and (a[9]=0) and (a[10]=0) and (a[11]=0) and
            (a[12]=0) and (a[13]=0) and (a[14]=0) and (a[15]=0){$endif};
end;

function IsEqual(const A,B: THash512): boolean;
var a_: TPtrIntArray absolute A;
    b_: TPtrIntArray absolute B;
begin // uses anti-forensic time constant "xor/or" pattern
  result := ((a_[0] xor b_[0]) or (a_[1] xor b_[1]) or
             (a_[2] xor b_[2]) or (a_[3] xor b_[3]) or
             (a_[4] xor b_[4]) or (a_[5] xor b_[5]) or
             (a_[6] xor b_[6]) or (a_[7] xor b_[7])
    {$ifndef CPU64} or (a_[8] xor b_[8]) or (a_[9] xor b_[9])
                    or (a_[10] xor b_[10]) or (a_[11] xor b_[11])
                    or (a_[12] xor b_[12]) or (a_[13] xor b_[13])
                    or (a_[14] xor b_[14]) or (a_[15] xor b_[15]) {$endif})=0;
end;

procedure FillZero(out dig: THash512);
begin
  PInt64Array(@dig)^[0] := 0;
  PInt64Array(@dig)^[1] := 0;
  PInt64Array(@dig)^[2] := 0;
  PInt64Array(@dig)^[3] := 0;
  PInt64Array(@dig)^[4] := 0;
  PInt64Array(@dig)^[5] := 0;
  PInt64Array(@dig)^[6] := 0;
  PInt64Array(@dig)^[7] := 0;
end;

procedure crc512c(buf: PAnsiChar; len: cardinal; out crc: THash512);
var h: THash512Rec absolute crc;
    h1,h2: cardinal;
begin // see https://goo.gl/Pls5wi
  h1 := crc32c(0,buf,len);
  h2 := crc32c(h1,buf,len);
  h.i0 := h1; inc(h1,h2);
  h.i1 := h1; inc(h1,h2);
  h.i2 := h1; inc(h1,h2);
  h.i3 := h1; inc(h1,h2);
  h.i4 := h1; inc(h1,h2);
  h.i5 := h1; inc(h1,h2);
  h.i6 := h1; inc(h1,h2);
  h.i7 := h1; inc(h1,h2);
  h.i8 := h1; inc(h1,h2);
  h.i9 := h1; inc(h1,h2);
  h.i10 := h1; inc(h1,h2);
  h.i11 := h1; inc(h1,h2);
  h.i12 := h1; inc(h1,h2);
  h.i13 := h1; inc(h1,h2);
  h.i14 := h1; inc(h1,h2);
  h.i15 := h1;
end;

procedure FillZero(var secret: RawByteString);
begin
  if secret<>'' then
    with PStrRec(Pointer(PtrInt(secret)-STRRECSIZE))^ do
    if refCnt=1 then // avoid GPF if const
      {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(pointer(secret)^,length,0);
end;

procedure FillZero(var secret: RawUTF8);
begin
  if secret<>'' then
    with PStrRec(Pointer(PtrInt(secret)-STRRECSIZE))^ do
    if refCnt=1 then // avoid GPF if const
      {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(pointer(secret)^,length,0);
end;

procedure mul64x64(const left, right: QWord; out product: THash128Rec);
{$ifdef CPUX64} {$ifdef FPC}nostackframe; assembler; asm {$else}
asm     // rcx/rdi=left, rdx/rsi=right r8/rdx=product
        .noframe
{$endif}{$ifdef WIN64}
        mov     rax, rcx
        mul     rdx // uses built-in 64-bit -> 128-bit multiplication
{$else} mov     r8, rdx
        mov     rax, rdi
        mul     rsi
{$endif}mov     qword ptr [r8], rax
        mov     qword ptr [r8+8], rdx
end;
{$else}
{$ifdef CPU32DELPHI}
asm // adapted from FPC compiler output, which is much better than Delphi's here
        mov     ecx, eax
        mov     eax, dword ptr [ebp+8H]
        mul     dword ptr [ebp+10H]
        mov     dword ptr [ecx], eax
        mov     dword ptr [ebp-4H], edx
        mov     eax, dword ptr [ebp+8H]
        mul     dword ptr [ebp+14H]
        add     eax, dword ptr [ebp-4H]
        adc     edx, 0
        mov     dword ptr [ebp-10H], eax
        mov     dword ptr [ebp-0CH], edx
        mov     eax, dword ptr [ebp+0CH]
        mul     dword ptr [ebp+10H]
        add     eax, dword ptr [ebp-10H]
        adc     edx, 0
        mov     dword ptr [ecx+4H], eax
        mov     dword ptr [ebp-14H], edx
        mov     eax, dword ptr [ebp+0CH]
        mul     dword ptr [ebp+14H]
        add     eax, dword ptr [ebp-0CH]
        adc     edx, 0
        add     eax, dword ptr [ebp-14H]
        adc     edx, 0
        mov     dword ptr [ecx+8H], eax
        mov     dword ptr [ecx+0CH], edx
end;
{$else} // CPU-neutral implementation
var l: TQWordRec absolute left;
    r: TQWordRec absolute right;
    t1,t2,t3: TQWordRec;
begin
  t1.V := QWord(l.L)*r.L;
  t2.V := QWord(l.H)*r.L+t1.H;
  t3.V := QWord(l.L)*r.H+t2.L;
  product.H := QWord(l.H)*r.H+t2.H+t3.H;
  product.L := t3.V shl 32 or t1.L;
end;
{$endif CPU32DELPHI}
{$endif CPUX64}

procedure SymmetricEncrypt(key: cardinal; var data: RawByteString);
var i,len: integer;
    d: PCardinal;
    tab: ^TCrc32tab;
begin
  tab := @crc32ctab;
  {$ifdef FPC}
  UniqueString(data); // @data[1] won't call UniqueString() under FPC :(
  {$endif}
  d := @data[1];
  len := length(data);
  key := key xor cardinal(len);
  for i := 0 to (len shr 2)-1 do begin
    key := key xor tab[0,(cardinal(i) xor key)and 1023];
    d^ := d^ xor key;
    inc(d);
  end;
  for i := 0 to (len and 3)-1 do
    PByteArray(d)^[i] := PByteArray(d)^[i] xor key xor tab[0,17 shl i];
end;

function UnixTimeToDateTime(const UnixTime: TUnixTime): TDateTime;
begin
  result := UnixTime / SecsPerDay + UnixDateDelta;
end;

function DateTimeToUnixTime(const AValue: TDateTime): TUnixTime;
begin
  result := Round((AValue - UnixDateDelta) * SecsPerDay);
end;

const
  UnixFileTimeDelta = 116444736000000000; // from year 1601 to 1970
  DateFileTimeDelta =  94353120000000000; // from year 1601 to 1899

{$ifdef MSWINDOWS}
function FileTimeToUnixTime(const FT: TFileTime): TUnixTime;
{$ifdef CPU64}var nano100: Int64;{$endif}
begin
  {$ifdef CPU64}
  FileTimeToInt64(ft,nano100);
  result := (nano100-UnixFileTimeDelta) div 10000000;
  {$else} // use PInt64 to avoid URW699 with Delphi 6 / Kylix
  result := (PInt64(@ft)^-UnixFileTimeDelta) div 10000000;
  {$endif}
end;

function FileTimeToUnixMSTime(const FT: TFileTime): TUnixMSTime;
{$ifdef CPU64}var nano100: Int64;{$endif}
begin
  {$ifdef CPU64}
  FileTimeToInt64(ft,nano100);
  result := (nano100-UnixFileTimeDelta) div 10000;
  {$else} // use PInt64 to avoid URW699 with Delphi 6 / Kylix
  result := (PInt64(@ft)^-UnixFileTimeDelta) div 10000;
  {$endif}
end;

function UnixTimeUTC: TUnixTime;
var ft: TFileTime;
begin
  GetSystemTimeAsFileTime(ft); // very fast, with 100 ns unit
  result := FileTimeToUnixTime(ft);
end;

function UnixMSTimeUTC: TUnixMSTime;
var ft: TFileTime;
begin
  GetSystemTimeAsFileTime(ft); // very fast, with 100 ns unit
  result := FileTimeToUnixMSTime(ft);
end;
{$else MSWINDOWS}
function UnixTimeUTC: TUnixTime;
begin
  result := GetUnixUTC; // direct retrieval from UNIX API
end;

function UnixMSTimeUTC: TUnixMSTime;
begin
  result := GetUnixMSUTC; // direct retrieval from UNIX API
end;
{$endif MSWINDOWS}

function DaysToIso8601(Days: cardinal; Expanded: boolean): RawUTF8;
var Y,M: cardinal;
begin
  Y := 0;
  while Days>365 do begin
    dec(Days,366);
    inc(Y);
  end;
  M := 0;
  if Days>31 then begin
    inc(M);
    while Days>MonthDays[false][M] do begin
      dec(Days,MonthDays[false][M]);
      inc(M);
    end;
  end;
  result := DateToIso8601(Y,M,Days,Expanded);
end;

function UnixTimeToString(const UnixTime: TUnixTime; Expanded: boolean;
  FirstTimeChar: AnsiChar): RawUTF8;
begin // inlined UnixTimeToDateTime
  result := DateTimeToIso8601(UnixTime/SecsPerDay+UnixDateDelta,Expanded,
    FirstTimeChar,false);
end;

function DateTimeToFileShort(const DateTime: TDateTime): TShort16;
begin
  DateTimeToFileShort(DateTime,result);
end;

procedure DateTimeToFileShort(const DateTime: TDateTime; out result: TShort16);
var T: TSynSystemTime;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin // use 'YYMMDDHHMMSS' format
  if DateTime<=0 then begin
    PWord(@result[0])^ := 1+ord('0') shl 8;
    exit;
  end;
  T.FromDate(DateTime);
  if T.Year > 1999 then
    if T.Year < 2100 then
      dec(T.Year,2000) else
      T.Year := 99 else
    T.Year := 0;
  T.FromTime(DateTime);
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  result[0] := #12;
  PWord(@result[1])^ := tab[T.Year];
  PWord(@result[3])^ := tab[T.Month];
  PWord(@result[5])^ := tab[T.Day];
  PWord(@result[7])^ := tab[T.Hour];
  PWord(@result[9])^ := tab[T.Minute];
  PWord(@result[11])^ := tab[T.Second];
end;

procedure UnixTimeToFileShort(const UnixTime: TUnixTime; out result: TShort16);
begin // use 'YYMMDDHHMMSS' format
  if UnixTime<=0 then
    PWord(@result[0])^ := 1+ord('0') shl 8 else
    DateTimeToFileShort(UnixTime/SecsPerDay+UnixDateDelta, result);
end;

function UnixTimeToFileShort(const UnixTime: TUnixTime): TShort16;
begin
  UnixTimeToFileShort(UnixTime, result);
end;

function UnixMSTimeToFileShort(const UnixMSTime: TUnixMSTime): TShort16;
begin
  UnixTimeToFileShort(UnixMSTime div MSecsPerSec, result);
end;

function UnixTimePeriodToString(const UnixTime: TUnixTime; FirstTimeChar: AnsiChar): RawUTF8;
begin
  if UnixTime<SecsPerDay then
    result := TimeToIso8601(UnixTime/SecsPerDay,true,FirstTimeChar) else
    result := DaysToIso8601(UnixTime div SecsPerDay,true);
end;

function UnixMSTimeToDateTime(const UnixMSTime: TUnixMSTime): TDateTime;
begin
  result := UnixMSTime/MSecsPerDay + UnixDateDelta;
end;

function UnixMSTimePeriodToString(const UnixMSTime: TUnixMSTime; FirstTimeChar: AnsiChar): RawUTF8;
begin
  if UnixMSTime<MSecsPerDay then
    result := TimeToIso8601(UnixMSTime/MSecsPerDay,true,FirstTimeChar,UnixMSTime<1000) else
    result := DaysToIso8601(UnixMSTime div MSecsPerDay,true);
end;

function DateTimeToUnixMSTime(const AValue: TDateTime): TUnixMSTime;
begin
  if AValue=0 then
    result := 0 else
    result := Round((AValue - UnixDateDelta) * MSecsPerDay);
end;

function UnixMSTimeToString(const UnixMSTime: TUnixMSTime; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
begin // inlined UnixMSTimeToDateTime()
  if UnixMSTime<=0 then
    result := '' else
    result := DateTimeMSToString(UnixMSTime/MSecsPerDay+UnixDateDelta,Expanded,
      FirstTimeChar,TZD);
end;

function NowUTC: TDateTime;
{$ifdef MSWINDOWS}
var ft: TFileTime;
    {$ifdef CPU64}nano100: Int64; d: double;{$endif}
begin
  GetSystemTimeAsFileTime(ft); // very fast, with 100 ns unit
  {$ifdef CPU64}
  FileTimeToInt64(ft,nano100);
  // in two explicit steps to circumvent weird precision error on FPC
  // having d: double is important here
  d := (nano100-DateFileTimeDelta) / 10000000;
  result := d/SecsPerDay;
  {$else} // use PInt64 to avoid URW699 with Delphi 6 / Kylix
  dec(PInt64(@ft)^,DateFileTimeDelta);
  result := PInt64(@ft)^/(10000000.0*SecsPerDay);
  {$endif}
end;
{$else}
begin
  result := GetNowUTC;
end;
{$endif}

function Iso8601ToDateTimePUTF8Char(P: PUTF8Char; L: integer): TDateTime;
var tmp: TDateTime; // circumvent FPC limitation
begin
  Iso8601ToDateTimePUTF8CharVar(P,L,tmp);
  result := tmp;
end;

function Iso8601CheckAndDecode(P: PUTF8Char; L: integer; var Value: TDateTime): boolean;
// handle 'YYYY-MM-DDThh:mm:ss[.sss]' or 'YYYY-MM-DD' or 'Thh:mm:ss[.sss]'
begin
  if P=nil then
    result := false else
    if (((L=9)or(L=13)) and (P[0]='T') and (P[3]=':')) or // 'Thh:mm:ss[.sss]'
       ((L=10) and (P[4]='-') and (P[7]='-')) or // 'YYYY-MM-DD'
       (((L=19)or(L=23)) and (P[4]='-') and (P[10]='T')) then begin
        Iso8601ToDateTimePUTF8CharVar(P,L,Value);
        result := PInt64(@Value)^<>0;
      end else
      result := false;
end;

{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
type
  unaligned = Double;
{$endif}

function Char2ToByte(P: PUTF8Char; out Value: Cardinal): Boolean;
var B: PtrUInt;
begin
  B := ConvertHexToBin[ord(P[0])];
  if B<=9 then begin
    Value := B;
    B := ConvertHexToBin[ord(P[1])];
    if B<=9 then begin
      Value := Value*10+B;
      result := false;
      exit;
    end;
  end;
  result := true; // error
end;

function Char3ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;
var B: PtrUInt;
begin
  B := ConvertHexToBin[ord(P[0])];
  if B<=9 then begin
    Value := B;
    B := ConvertHexToBin[ord(P[1])];
    if B<=9 then begin
      Value := Value*10+B;
      B := ConvertHexToBin[ord(P[2])];
      if B<=9 then begin
        Value := Value*10+B;
        result := false;
        exit;
      end;
    end;
  end;
  result := true; // error
end;

function Char4ToWord(P: PUTF8Char; out Value: Cardinal): Boolean;
var B: PtrUInt;
begin
  B := ConvertHexToBin[ord(P[0])];
  if B<=9 then begin
    Value := B;
    B := ConvertHexToBin[ord(P[1])];
    if B<=9 then begin
      Value := Value*10+B;
      B := ConvertHexToBin[ord(P[2])];
      if B<=9 then begin
        Value := Value*10+B;
        B := ConvertHexToBin[ord(P[3])];
        if B<=9 then begin
          Value := Value*10+B;
          result := false;
          exit;
        end;
      end;
    end;
  end;
  result := true; // error
end;

procedure Iso8601ToDateTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);
var B: cardinal;
    Y,M,D, H,MI,SS,MS: cardinal;
    d100: TDiv100Rec;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
// expect 'YYYYMMDDThhmmss[.sss]' format but handle also 'YYYY-MM-DDThh:mm:ss[.sss]'
begin
  unaligned(result) := 0;
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if L<4 then
    exit; // we need 'YYYY' at least
  if P[0]='T' then begin
    dec(P,8);
    inc(L,8);
  end else begin
    {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
    B := tab[ord(P[0])]; // first digit
    if B>9 then exit else Y := B; // fast check '0'..'9'
    B := tab[ord(P[1])];
    if B>9 then exit else Y := Y*10+B;
    B := tab[ord(P[2])];
    if B>9 then exit else Y := Y*10+B;
    B := tab[ord(P[3])];
    if B>9 then exit else Y := Y*10+B;
    if P[4] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
    D := 1;
    if L>=6 then begin // YYYYMM
      M := ord(P[4])*10+ord(P[5])-(48+480);
      if (M=0) or (M>12) then exit;
      if P[6] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
      if L>=8 then begin // YYYYMMDD
        if not(P[8] in [#0,' ','T']) then
          exit; // invalid date format
        D := ord(P[6])*10+ord(P[7])-(48+480);
        if (D=0) or (D>MonthDays[true][M]) then exit; // worse is leap year=true
      end;
    end else
      M := 1;
    if M>2 then // inlined EncodeDate(Y,M,D)
      dec(M,3) else
    if M>0 then begin
      inc(M,9);
      dec(Y);
    end;
    if Y>9999 then
      exit; // avoid integer overflow e.g. if '0000' is an invalid date
    Div100(Y,d100);
    unaligned(result) := (146097*d100.d) shr 2 + (1461*d100.m) shr 2 +
          (153*M+2) div 5+D-693900;
    if L<15 then
      exit; // not enough space to retrieve the time
  end;
  H := ord(P[9])*10+ord(P[10])-(48+480);
  if P[11]=':' then begin inc(P); dec(L); end;// allow hh:mm:ss
  MI := ord(P[11])*10+ord(P[12])-(48+480);
  if P[13]=':' then begin inc(P); dec(L); end; // allow hh:mm:ss
  SS := ord(P[13])*10+ord(P[14])-(48+480);
  if (L>16) and (P[15]='.') then begin
    // one or more digits representing a decimal fraction of a second
    MS := ord(P[16])*100-4800;
    if L>17 then MS := MS+ord(P[17])*10-480;
    if L>18 then MS := MS+ord(P[18])-48;
    if MS>1000 then
      MS := 0;
  end else
    MS := 0;
  if (H<24) and (MI<60) and (SS<60) then // inlined EncodeTime()
    result := result+(H*(MinsPerHour*SecsPerMin*MSecsPerSec)+
              MI*(SecsPerMin*MSecsPerSec)+SS*MSecsPerSec+MS)/MSecsPerDay;
end;

function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer=0): TDateTime;
begin
  Iso8601ToTimePUTF8CharVar(P,L,result);
end;

procedure Iso8601ToTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);
var H,MI,SS,MS: cardinal;
begin
  if Iso8601ToTimePUTF8Char(P,L,H,MI,SS,MS) then
    result := (H*(MinsPerHour*SecsPerMin*MSecsPerSec)+
               MI*(SecsPerMin*MSecsPerSec)+SS*MSecsPerSec+MS)/MSecsPerDay else
    result := 0;
end;

function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer; var H,M,S,MS: cardinal): boolean;
begin
  result := false; // error
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if L<6 then
    exit; // we need 'hhmmss' at least
  H := ord(P[0])*10+ord(P[1])-(48+480);
  if P[2]=':' then begin inc(P); dec(L); end; // allow hh:mm:ss
  M := ord(P[2])*10+ord(P[3])-(48+480);
  if P[4]=':' then begin inc(P); dec(L); end; // allow hh:mm:ss
  S := ord(P[4])*10+ord(P[5])-(48+480);
  if (L>6) and (P[6]='.') then begin
    // one or more digits representing a decimal fraction of a second
    MS := ord(P[7])*100-4800;
    if L>7 then MS := MS+ord(P[8])*10-480;
    if L>8 then MS := MS+ord(P[9])-48;
  end else
    MS := 0;
  if (H<24) and (M<60) and (S<60) and (MS<1000) then
    result := true;
end;

function IntervalTextToDateTime(Text: PUTF8Char): TDateTime;
begin
  IntervalTextToDateTimeVar(Text,result);
end;

procedure IntervalTextToDateTimeVar(Text: PUTF8Char; var result: TDateTime);
var negative: boolean;
    Time: TDateTime;
begin // e.g. IntervalTextToDateTime('+0 06:03:20')
  result := 0;
  if Text=nil then
    exit;
  if Text^ in ['+','-'] then begin
    negative := (Text^='-');
    result := GetNextItemDouble(Text,' ');
  end else
    negative := false;
  Iso8601ToTimePUTF8CharVar(Text,0,Time);
  if negative then
    result := result-Time else
    result := result+Time;
end;

function Iso8601ToDateTime(const S: RawByteString): TDateTime;
begin
  result := Iso8601ToDateTimePUTF8Char(pointer(S),length(S));
end;

function TimeLogToDateTime(const Timestamp: TTimeLog): TDateTime;
begin
  result := PTimeLogBits(@Timestamp)^.ToDateTime;
end;

function TimeLogToUnixTime(const Timestamp: TTimeLog): TUnixTime;
begin
  result := PTimeLogBits(@Timestamp)^.ToUnixTime;
end;

procedure DateToIso8601PChar(P: PUTF8Char; Expanded: boolean; Y,M,D: PtrUInt);
// use 'YYYYMMDD' format if not Expanded, 'YYYY-MM-DD' format if Expanded
var tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  {$ifdef CPUX86NOTPIC}
  YearToPChar(Y,P);
  {$else}
  tab := @TwoDigitLookupW;
  YearToPChar2(tab,Y,P);
  {$endif}
  inc(P,4);
  if Expanded then begin
    P^ := '-';
    inc(P);
  end;
  PWord(P)^ := tab[M];
  inc(P,2);
  if Expanded then begin
    P^ := '-';
    inc(P);
  end;
  PWord(P)^ := tab[D];
end;

procedure TimeToIso8601PChar(P: PUTF8Char; Expanded: boolean; H,M,S,MS: PtrUInt;
  FirstChar: AnsiChar; WithMS: boolean);
var tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin // use Thhmmss[.sss] format
  if FirstChar<>#0 then begin
    P^ := FirstChar;
    inc(P);
  end;
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  PWord(P)^ := tab[H];
  inc(P,2);
  if Expanded then begin
    P^ := ':';
    inc(P);
  end;
  PWord(P)^ := tab[M];
  inc(P,2);
  if Expanded then begin
    P^ := ':';
    inc(P);
  end;
  PWord(P)^ := tab[S];
  if WithMS then begin
    inc(P,2);
    {$ifdef CPUX86NOTPIC}YearToPChar(MS{$else}YearToPChar2(tab,MS{$endif},P);
    P^ := '.'; // override first digit
  end;
end;

procedure DateToIso8601PChar(Date: TDateTime; P: PUTF8Char; Expanded: boolean);
var T: TSynSystemTime;
begin // use YYYYMMDD / YYYY-MM-DD date format
  T.FromDate(Date);
  DateToIso8601PChar(P,Expanded,T.Year,T.Month,T.Day);
end;

function DateToIso8601Text(Date: TDateTime): RawUTF8;
begin // into 'YYYY-MM-DD' date format
  if Date=0 then
    result := '' else begin
    SetLength(result,10);
    DateToIso8601PChar(Date,pointer(result),True);
  end;
end;

procedure TimeToIso8601PChar(Time: TDateTime; P: PUTF8Char; Expanded: boolean;
  FirstChar: AnsiChar; WithMS: boolean);
var T: TSynSystemTime;
begin
  T.FromTime(Time);
  TimeToIso8601PChar(P,Expanded,T.Hour,T.Minute,T.Second,T.MilliSecond,FirstChar,WithMS);
end;

function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar; WithMS: boolean): RawUTF8;
const ISO8601_LEN: array[boolean,boolean] of integer = ((15,14),(19,18));
var tmp: array[0..31] of AnsiChar;
begin // D=0 is handled in DateTimeToIso8601Text()
  DateToIso8601PChar(D,tmp,Expanded);
  if Expanded then
    TimeToIso8601PChar(D,@tmp[10],true,FirstChar,WithMS) else
    TimeToIso8601PChar(D,@tmp[8],false,FirstChar,WithMS);
  FastSetString(result,@tmp,ISO8601_LEN[Expanded,FirstChar=#0]+4*integer(WithMS));
end;

function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8;
// use YYYYMMDD / YYYY-MM-DD date format
begin
  FastSetString(result,nil,8+2*integer(Expanded));
  DateToIso8601PChar(Date,pointer(result),Expanded);
end;

function DateToIso8601(Y,M,D: cardinal; Expanded: boolean): RawUTF8;
// use 'YYYYMMDD' format if not Expanded, 'YYYY-MM-DD' format if Expanded
begin
  FastSetString(result,nil,8+2*integer(Expanded));
  DateToIso8601PChar(pointer(result),Expanded,Y,M,D);
end;

function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar;
  WithMS: boolean): RawUTF8;
// use Thhmmss[.sss] / Thh:mm:ss[.sss] format
begin
  FastSetString(result,nil,7+2*integer(Expanded)+4*integer(WithMS));
  TimeToIso8601PChar(Time,pointer(result),Expanded,FirstChar,WithMS);
end;

function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar;
  WithMS: boolean): RawUTF8;
begin
  DateTimeToIso8601TextVar(DT,FirstChar,result,WithMS);
end;

procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar;
  var result: RawUTF8; WithMS: boolean);
begin
  if DT=0 then
    result := '' else
    if frac(DT)=0 then
      result := DateToIso8601(DT,true) else
    if trunc(DT)=0 then
      result := TimeToIso8601(DT,true,FirstChar,WithMS) else
      result := DateTimeToIso8601(DT,true,FirstChar,WithMS);
end;

procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar;
  var result: string; WithMS: boolean);
var tmp: RawUTF8;
begin
  DateTimeToIso8601TextVar(DT,FirstChar,tmp,WithMS);
  Ansi7ToString(Pointer(tmp),length(tmp),result);
end;

procedure DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUTF8Char;
  FirstChar: AnsiChar='T'; WithMS: boolean=false);
begin
  if Value<>0 then begin
    if trunc(Value)<>0 then begin
      DateToIso8601PChar(Value,Dest,true);
      inc(Dest,10);
    end;
    if frac(Value)<>0 then begin
      TimeToIso8601PChar(Value,Dest,true,FirstChar,WithMS);
      inc(Dest,9+4*integer(WithMS));
    end;
  end;
  Dest^ := #0;
end;

function Iso8601ToTimeLogPUTF8Char(P: PUTF8Char; L: integer; ContainsNoTime: PBoolean=nil): TTimeLog;
// bits: S=0..5 M=6..11 H=12..16 D=17..21 M=22..25 Y=26..38
// i.e. S<64 M<64 H<32 D<32 M<16 Y<4096: power of 2 -> use fast shl/shr
var V,B: PtrUInt;
    i: integer;
begin
  result := 0;
  if P=nil then
    exit;
  if L=0 then
    L := StrLen(P);
  if L<4 then
    exit; // we need 'YYYY' at least
  if P[0]='T' then
    dec(P,8) else begin // 'YYYY' -> year decode
    V := ConvertHexToBin[ord(P[0])]; if V>9 then exit;
    for i := 1 to 3 do begin
      B := ConvertHexToBin[ord(P[i])]; if B>9 then exit else V := V*10+B; end;
    result := Int64(V) shl 26;  // store YYYY
    if P[4] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
    if L>=6 then begin // YYYYMM
      V := ord(P[4])*10+ord(P[5])-(48+480+1); // Month 1..12 -> 0..11
      if V<=11 then
        inc(result,V shl 22) else begin
        result := 0;
        exit;
      end;
      if P[6] in ['-','/'] then begin inc(P); dec(L); end; // allow YYYY-MM-DD
      if L>=8 then begin  // YYYYMMDD
        V := ord(P[6])*10+ord(P[7])-(48+480+1); // Day 1..31 -> 0..30
        if (V<=30) and(P[8] in [#0,' ','T']) then
          inc(result,V shl 17) else begin
          result := 0;
          exit;
        end;
      end;
    end;
    if L<15 then begin // not enough place to retrieve a time
      if ContainsNoTime<>nil then
        ContainsNoTime^ := true;
      exit;
    end;
  end;
  if ContainsNoTime<>nil then
    ContainsNoTime^ := false;
  B := ord(P[9])*10+ord(P[10])-(48+480);
  if B<=23 then V := B shl 12 else exit;
  if P[11]=':' then inc(P); // allow hh:mm:ss
  B := ord(P[11])*10+ord(P[12])-(48+480);
  if B<=59 then inc(V,B shl 6) else exit;
  if P[13]=':' then inc(P); // allow hh:mm:ss
  B := ord(P[13])*10+ord(P[14])-(48+480);
  if B<=59 then inc(result,PtrUInt(V+B));
end;

function IsIso8601(P: PUTF8Char; L: integer): boolean;
begin
  result := Iso8601ToTimeLogPUTF8Char(P,L)<>0;
end;

function DateTimeToi18n(const DateTime: TDateTime): string;
begin
  if Assigned(i18nDateTimeText) then
    result := i18nDateTimeText(DateTime) else
    result := {$ifdef UNICODE}Ansi7ToString{$endif}(DateTimeToIso8601(DateTime,true,' ',true));
end;


{ TTimeLogBits }

// bits: S=0..5 M=6..11 H=12..16 D=17..21 M=22..25 Y=26..38
// size: S=6 M=6  H=5  D=5  M=4  Y=12
// i.e. S<64 M<64 H<32 D<32 M<16 Y<4096: power of 2 -> use fast shl/shr

procedure TTimeLogBits.From(Y, M, D, HH, MM, SS: cardinal);
begin
  inc(HH,D shl 5+M shl 10+Y shl 14-(1 shl 5+1 shl 10));
  Value := SS+MM shl 6+Int64(HH) shl 12;
end;

procedure TTimeLogBits.From(P: PUTF8Char; L: integer);
begin
  Value := Iso8601ToTimeLogPUTF8Char(P,L);
end;

procedure TTimeLogBits.Expand(out Date: TSynSystemTime);
begin
  Date.Year := (Value shr (6+6+5+5+4)) and 4095;
  Date.Month := 1+(PCardinal(@Value)^ shr (6+6+5+5)) and 15;
  Date.Day := 1+(PCardinal(@Value)^ shr (6+6+5)) and 31;
  Date.DayOfWeek := 0;
  Date.Hour := (PCardinal(@Value)^ shr (6+6)) and 31;
  Date.Minute := (PCardinal(@Value)^ shr 6) and 63;
  Date.Second := PCardinal(@Value)^ and 63;
end;

procedure TTimeLogBits.From(const S: RawUTF8);
begin
  Value := Iso8601ToTimeLog(S);
end;

procedure TTimeLogBits.From(FileDate: integer);
begin
{$ifdef MSWINDOWS}
  From(PInt64Rec(@FileDate)^.Hi shr 9+1980,
       PInt64Rec(@FileDate)^.Hi shr 5 and 15,
       PInt64Rec(@FileDate)^.Hi and 31,
       PInt64Rec(@FileDate)^.Lo shr 11,
       PInt64Rec(@FileDate)^.Lo shr 5 and 63,
       PInt64Rec(@FileDate)^.Lo and 31 shl 1);
{$else} // FileDate depends on the running OS
  From(FileDateToDateTime(FileDate));
{$endif}
end;

procedure TTimeLogBits.From(DateTime: TDateTime; DateOnly: Boolean);
var T: TSynSystemTime;
    V: PtrInt;
begin
  T.FromDate(DateTime);
  if DateOnly then
    T.Hour := 0 else
    T.FromTime(DateTime);
  V := T.Day shl 5+T.Month shl 10+T.Year shl 14-(1 shl 5+1 shl 10);
  Value := V; // circumvent C1093 error on Delphi 5
  Value := Value shl 12;
  if not DateOnly then begin
    V := T.Second+T.Minute shl 6+T.Hour shl 12;
    Value := Value+V;
  end;
end;

procedure TTimeLogBits.FromUnixTime(const UnixTime: TUnixTime);
begin
  From(UnixTimeToDateTime(UnixTime));
end;

procedure TTimeLogBits.FromUnixMSTime(const UnixMSTime: TUnixMSTime);
begin
  From(UnixMSTimeToDateTime(UnixMSTime));
end;

procedure TTimeLogBits.From(Time: PSynSystemTime);
var V: PtrInt;
begin
  V := Time^.Hour+Time^.Day shl 5+Time^.Month shl 10+Time^.Year shl 14-(1 shl 5+1 shl 10);
  Value := V; // circumvent C1093 error on Delphi 5
  V := Time^.Second+Time^.Minute shl 6;
  Value := (Value shl 12)+V;
end;

var // GlobalTime[LocalTime] cache protected using RCU128()
  GlobalTime: array[boolean] of record
    time: TSystemTime;
    clock: PtrInt; // avoid slower API call with 8-16ms loss of precision
  end;

{$ifndef FPC}{$ifdef CPUINTEL} // intrinsic in FPC
procedure ReadBarrier;
asm
  {$ifdef CPUX86}
  lock add dword ptr [esp], 0
  {$else}
  lfence // lfence requires an SSE CPU, which is OK on x86-64
  {$endif}
end;
{$endif}{$endif}

procedure RCU32(var src,dst);
begin
  repeat
    Integer(dst) := Integer(src);
    ReadBarrier;
  until Integer(dst)=Integer(src);
end;

procedure RCU64(var src,dst);
begin
  repeat
    Int64(dst) := Int64(src);
    ReadBarrier;
  until Int64(dst)=Int64(src);
end;

procedure RCUPtr(var src,dst);
begin
  repeat
    PtrInt(dst) := PtrInt(src);
    ReadBarrier;
  until PtrInt(dst)=PtrInt(src);
end;

procedure RCU128(var src,dst);
var s: THash128Rec absolute src;
    d: THash128Rec absolute dst;
begin
  repeat
    d := s;
    ReadBarrier;
  until (d.L=s.L) and (d.H=s.H);
end;

procedure RCU(var src,dst; len: integer);
begin
  repeat
    {$ifdef FPC}Move{$else}MoveFast{$endif}(src,dst,len);
    ReadBarrier;
  until CompareMem(@src,@dst,len);
end;

procedure FromGlobalTime(LocalTime: boolean; out NewTime: TSynSystemTime);
var tix: PtrInt;
    newtimesys: TSystemTime absolute NewTime;
begin
  with GlobalTime[LocalTime] do begin
    tix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64
      {$ifndef MSWINDOWS}shr 3{$endif}; // Linux: 8ms refresh
    if clock<>tix then begin // Windows: typically in range of 10-16 ms
      clock := tix;
      NewTime.Clear;
      if LocalTime then
        GetLocalTime(newtimesys) else
        {$ifdef MSWINDOWS}GetSystemTime{$else}GetNowUTCSystem{$endif}(newtimesys);
      RCU128(newtimesys,time);
    end else
      RCU128(time,NewTime);
  end;
  {$ifndef MSWINDOWS} // those TSystemTime fields are inverted in datih.inc :(
  tix := newtimesys.DayOfWeek;
  NewTime.Day := newtimesys.Day;
  NewTime.DayOfWeek := tix;
  {$endif}
end;

procedure TTimeLogBits.FromUTCTime;
var now: TSynSystemTime;
begin
  FromGlobalTime(false,now);
  From(@now);
end;

procedure TTimeLogBits.FromNow;
var now: TSynSystemTime;
begin
  FromGlobalTime(true,now);
  From(@now);
end;

function TTimeLogBits.ToTime: TDateTime;
var lo: PtrUInt;
begin
  lo := {$ifdef CPU64}Value{$else}PCardinal(@Value)^{$endif};
  if lo and (1 shl (6+6+5)-1)=0 then
    result := 0 else
    result := EncodeTime((lo shr(6+6))and 31, (lo shr 6)and 63, lo and 63, 0);
end;

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
var d100: TDiv100Rec;
begin // faster version by AB
  Result := False;
  if (Month<1) or (Month>12) then exit;
  if (Day <= MonthDays[
      ((Year and 3)=0) and ((Year mod 100>0) or (Year mod 400=0))][Month]) and
     (Year>=1) and (Year<10000) and
     (Month<13) and (Day>0) then begin
    if Month>2 then
      dec(Month,3) else
    if (Month>0) then begin
      inc(Month,9);
      dec(Year);
    end
      else exit; // Month <= 0
    Div100(Year,d100);
    Date := (146097*d100.D) shr 2+(1461*d100.M) shr 2+
            (153*Month+2) div 5+Day-693900;
    result := true;
  end;
end;

function TTimeLogBits.ToDate: TDateTime;
var Y, lo: PtrUInt;
begin
  {$ifdef CPU64}
  lo := Value;
  Y := (lo shr (6+6+5+5+4)) and 4095;
  {$else}
  Y := (Value shr (6+6+5+5+4)) and 4095;
  lo := PCardinal(@Value)^;
  {$endif}
  if (Y=0) or not TryEncodeDate(Y,1+(lo shr(6+6+5+5))and 15,1+(lo shr(6+6+5))and 31,result) then
    result := 0;
end;

function TTimeLogBits.ToDateTime: TDateTime;
var Y, lo: PtrUInt;
    Time: TDateTime;
begin
  {$ifdef CPU64}
  lo := Value;
  Y := (lo shr (6+6+5+5+4)) and 4095;
  {$else}
  Y := (Value shr (6+6+5+5+4)) and 4095;
  lo := PCardinal(@Value)^;
  {$endif}
  if (Y=0) or not TryEncodeDate(Y,1+(lo shr(6+6+5+5))and 15,1+(lo shr(6+6+5))and 31,result) then
    result := 0;
  if (lo and (1 shl(6+6+5)-1)<>0) and TryEncodeTime((lo shr(6+6)) and 31,
      (lo shr 6)and 63, lo and 63, 0, Time) then
    result := result+Time;
end;

function TTimeLogBits.Year: Integer;
begin
  result := (Value shr (6+6+5+5+4)) and 4095;
end;

function TTimeLogBits.Month: Integer;
begin
  result := 1+(PCardinal(@Value)^ shr (6+6+5+5)) and 15;
end;

function TTimeLogBits.Day: Integer;
begin
  result := 1+(PCardinal(@Value)^ shr (6+6+5)) and 31;
end;

function TTimeLogBits.Hour: Integer;
begin
  result := (PCardinal(@Value)^ shr (6+6)) and 31;
end;

function TTimeLogBits.Minute: Integer;
begin
  result := (PCardinal(@Value)^ shr 6) and 63;
end;

function TTimeLogBits.Second: Integer;
begin
  result := PCardinal(@Value)^ and 63;
end;

function TTimeLogBits.ToUnixTime: TUnixTime;
begin
  result := DateTimeToUnixTime(ToDateTime);
end;

function TTimeLogBits.ToUnixMSTime: TUnixMSTime;
begin
  result := DateTimeToUnixMSTime(ToDateTime);
end;

function TTimeLogBits.Text(Dest: PUTF8Char; Expanded: boolean; FirstTimeChar: AnsiChar): integer;
var lo: PtrUInt;
begin
  if Value=0 then begin
    result := 0;
    exit;
  end;
  lo := {$ifdef CPU64}Value{$else}PCardinal(@Value)^{$endif};
  if lo and (1 shl (6+6+5)-1)=0 then begin
    // no Time: just convert date
    DateToIso8601PChar(Dest, Expanded,
      ({$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5+5+4)) and 4095,
      1+(lo shr (6+6+5+5)) and 15, 1+(lo shr (6+6+5)) and 31);
    if Expanded then
      result := 10 else
      result := 8;
  end else
  if {$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5)=0 then begin
    // no Date: just convert time
    TimeToIso8601PChar(Dest, Expanded, (lo shr (6+6)) and 31,
      (lo shr 6) and 63, lo and 63, 0, FirstTimeChar);
    if Expanded then
      result := 9 else
      result := 7;
    if FirstTimeChar=#0 then
      dec(result);
  end else begin
    // convert time and date
    DateToIso8601PChar(Dest, Expanded,
      ({$ifdef CPU64}lo{$else}Value{$endif} shr (6+6+5+5+4)) and 4095,
      1+(lo shr (6+6+5+5)) and 15, 1+(lo shr (6+6+5)) and 31);
    if Expanded then
      inc(Dest,10) else
      inc(Dest,8);
    TimeToIso8601PChar(Dest, Expanded, (lo shr (6+6)) and 31,
      (lo shr 6) and 63, lo and 63, 0, FirstTimeChar);
    if Expanded then
      result := 15+4 else
      result := 15;
    if FirstTimeChar=#0 then
      dec(result);
  end;
end;

function TTimeLogBits.Text(Expanded: boolean; FirstTimeChar: AnsiChar = 'T'): RawUTF8;
var tmp: array[0..31] of AnsiChar;
begin
  if Value=0 then
    result := '' else
    FastSetString(result,@tmp,Text(tmp,Expanded,FirstTimeChar));
end;

function TTimeLogBits.i18nText: string;
begin
  if Assigned(i18nDateText) then
    result := i18nDateText(Value) else
    result := {$ifdef UNICODE}Ansi7ToString{$endif}(Text(true,' '));
end;

function TimeLogNow: TTimeLog;
begin
  PTimeLogBits(@result)^.FromNow;
end;

function TimeLogNowUTC: TTimeLog;
begin
  PTimeLogBits(@result)^.FromUTCTime;
end;

function NowToString(Expanded: boolean=true; FirstTimeChar: AnsiChar = ' '): RawUTF8;
var I: TTimeLogBits;
begin
  I.FromNow;
  result := I.Text(Expanded,FirstTimeChar);
end;

function NowUTCToString(Expanded: boolean=true; FirstTimeChar: AnsiChar = ' '): RawUTF8;
var I: TTimeLogBits;
begin
  I.FromUTCTime;
  result := I.Text(Expanded,FirstTimeChar);
end;

const
  DTMS_FMT: array[boolean] of RawUTF8 = ('%%%%%%%%%', '%-%-%%%:%:%.%%');

function DateTimeMSToString(DateTime: TDateTime; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
var T: TSynSystemTime;
begin //  'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
  if DateTime=0 then
    result := '' else begin
    T.FromDateTime(DateTime);
    result := DateTimeMSToString(T.Hour,T.Minute,T.Second,T.MilliSecond,
      T.Year,T.Month,T.Day,Expanded,FirstTimeChar,TZD);
  end;
end;

function DateTimeMSToString(HH,MM,SS,MS,Y,M,D: cardinal; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
begin //  'YYYY-MM-DD hh:mm:ss.sssZ' or 'YYYYMMDD hhmmss.sssZ' format
  FormatUTF8(DTMS_FMT[Expanded], [UInt4DigitsToShort(Y),UInt2DigitsToShortFast(M),
    UInt2DigitsToShortFast(D),FirstTimeChar,UInt2DigitsToShortFast(HH),
    UInt2DigitsToShortFast(MM),UInt2DigitsToShortFast(SS),UInt3DigitsToShort(MS),TZD], result);
end;

const
  HTML_WEEK_DAYS: array[1..7] of string[3] =
    ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  HTML_MONTH_NAMES: array[1..12] of string[3] =
    ('Jan','Feb','Mar','Apr','May','Jun', 'Jul','Aug','Sep','Oct','Nov','Dec');

function DateTimeToHTTPDate(UTCDateTime: TDateTime): RawUTF8;
var T: TSynSystemTime;
begin
  if UTCDateTime=0 then begin
    result := '';
    exit;
  end;
  T.FromDateTime(UTCDateTime);
  FormatUTF8('%, % % % %:%:% GMT', [HTML_WEEK_DAYS[DayOfWeek(UTCDateTime)],
    UInt2DigitsToShortFast(T.Day),HTML_MONTH_NAMES[T.Month],UInt4DigitsToShort(T.Year),
    UInt2DigitsToShortFast(T.Hour),UInt2DigitsToShortFast(T.Minute),
    UInt2DigitsToShortFast(T.Second)], result);
end;

function TimeToString: RawUTF8;
var I: TTimeLogBits;
begin
  I.FromNow;
  I.Value := I.Value and (1 shl (6+6+5)-1); // keep only time
  result := I.Text(true,' ');
end;

function TimeLogFromFile(const FileName: TFileName): TTimeLog;
var Date: TDateTime;
begin
  Date := FileAgeToDateTime(FileName);
  if Date=0 then
    result := 0 else
    PTimeLogBits(@result)^.From(Date);
end;

function TimeLogFromDateTime(const DateTime: TDateTime): TTimeLog;
begin
  PTimeLogBits(@result)^.From(DateTime);
end;

function TimeLogFromUnixTime(const UnixTime: TUnixTime): TTimeLog;
begin
  PTimeLogBits(@result)^.FromUnixTime(UnixTime);
end;


{ TSynSystemTime }

function TryEncodeDayOfWeekInMonth(AYear, AMonth, ANthDayOfWeek, ADayOfWeek: integer;
  out AValue: TDateTime): Boolean;
var LStartOfMonth, LDay: integer;
begin // adapted from DateUtils
  result := TryEncodeDate(AYear,AMonth,1,aValue);
  if not result then
    exit;
  LStartOfMonth := (DateTimeToTimestamp(aValue).Date-1)mod 7+1;
  if LStartOfMonth<=ADayOfWeek then
    dec(ANthDayOfWeek);
  LDay := (ADayOfWeek-LStartOfMonth+1)+7*ANthDayOfWeek;
  result := TryEncodeDate(AYear,AMonth,LDay,AValue);
end;

function TSynSystemTime.EncodeForTimeChange(const aYear: word): TDateTime;
var dow,d: word;
begin
  if DayOfWeek=0 then
    dow := 7 else // Delphi Sunday = 7
    dow := DayOfWeek;
  // Encoding the day of change
  d := Day;
  while not TryEncodeDayOfWeekInMonth(aYear,Month,d,dow,Result) do begin
    // if Day = 5 then try it and if needed decrement to find the last
    // occurence of the day in this month
    if d=0 then begin
      TryEncodeDayOfWeekInMonth(aYear,Month,1,7,Result);
      break;
    end;
    dec(d);
  end;
  // finally add the time when change is due
  result := result+EncodeTime(Hour,Minute,Second,MilliSecond);
end;

procedure TSynSystemTime.Clear;
begin
  PInt64Array(@self)[0] := 0;
  PInt64Array(@self)[1] := 0;
end;

function TSynSystemTime.IsZero: boolean;
begin
  result := (PInt64Array(@self)[0]=0) and (PInt64Array(@self)[1]=0);
end;

function TSynSystemTime.IsEqual(const another{$ifndef DELPHI5OROLDER}: TSynSystemTime{$endif}): boolean;
begin
  result := (PInt64Array(@self)[0]=PInt64Array(@another)[0]) and
            (PInt64Array(@self)[1]=PInt64Array(@another)[1]);
end;

procedure TSynSystemTime.FromNowUTC;
begin
  FromGlobalTime(false,self);
end;

procedure TSynSystemTime.FromNowLocal;
begin
  FromGlobalTime(true,self);
end;

procedure TSynSystemTime.FromDateTime(const dt: TDateTime);
begin
  FromDate(dt);
  FromTime(dt);
end;

procedure TSynSystemTime.FromDate(const dt: TDateTime);
var t,t2,t3: PtrUInt;
begin
  t := Trunc(dt);
  t := (t+693900)*4-1;
  if PtrInt(t)>=0 then begin
    t3 := t div 146097;
    t2 := (t-t3*146097) and not 3;
    t := PtrUInt(t2+3) div 1461; // PtrUInt() needed for FPC i386
    Year := t3*100+t;
    t2 := ((t2+7-t*1461)shr 2)*5;
    t3 := PtrUInt(t2-3) div 153;
    Day := PtrUInt(t2+2-t3*153) div 5;
    if t3<10 then
      inc(t3,3) else begin
      dec(t3,9);
      inc(Year);
    end;
    Month := t3;
    DayOfWeek := 0;
  end else
    PInt64(@Year)^ := 0;
end;

procedure TSynSystemTime.FromTime(const dt: TDateTime);
var t,t2: PtrUInt;
begin
  t := round(abs(dt)*MSecsPerDay) mod MSecsPerDay;
  t2 := t div 3600000;
  Hour := t2;
  dec(t,t2*3600000);
  t2 := t div 60000;
  Minute := t2;
  dec(t,t2*60000);
  t2 := t div 1000;
  Second := t2;
  MilliSecond := t-t2*1000;
end;

function TSynSystemTime.ToText(Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8): RawUTF8;
begin
  result := DateTimeMSToString(Hour,Minute,Second,MilliSecond,Year,Month,Day,
    Expanded,FirstTimeChar,TZD);
end;

procedure TSynSystemTime.AddLogTime(WR: TTextWriter);
var y,d100: PtrUInt;
    P: PUTF8Char;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  if WR.BEnd-WR.B<=18 then
    WR.FlushToStream;
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  y := Year;
  d100 := y div 100;
  P := WR.B+1;
  PWord(P)^ := tab[d100];
  PWord(P+2)^ := tab[y-(d100*100)];
  PWord(P+4)^ := tab[Month];
  PWord(P+6)^ := tab[Day];
  P[8] := ' ';
  PWord(P+9)^ := tab[Hour];
  PWord(P+11)^ := tab[Minute];
  PWord(P+13)^ := tab[Second];
  y := Millisecond;
  PWord(P+15)^ := tab[y shr 4];
  inc(WR.B,17);
end;

function TSynSystemTime.ToNCSAText(P: PUTF8Char): PtrInt;
var y,d100: PtrUInt;
    tab: {$ifdef CPUX86NOTPIC}TWordArray absolute TwoDigitLookupW{$else}PWordArray{$endif};
begin
  {$ifndef CPUX86NOTPIC}tab := @TwoDigitLookupW;{$endif}
  PWord(P)^ := tab[Day];
  PCardinal(P+2)^ := PCardinal(@HTML_MONTH_NAMES[Month])^;
  P[2] := '/'; // overwrite HTML_MONTH_NAMES[][0]
  P[6] := '/';
  y := Year;
  d100 := y div 100;
  PWord(P+7)^ := tab[d100];
  PWord(P+9)^ := tab[y-(d100*100)];
  P[11] := ':';
  PWord(P+12)^ := tab[Hour];
  P[14] := ':';
  PWord(P+15)^ := tab[Minute];
  P[17] := ':';
  PWord(P+18)^ := tab[Second];
  P[20] := ' ';
  result := 21;
end;

procedure TSynSystemTime.AddNCSAText(WR: TTextWriter);
begin
  if WR.BEnd-WR.B<=21 then
    WR.FlushToStream;
  inc(WR.B,ToNCSAText(WR.B+1));
end;

function TSynSystemTime.ToDateTime: TDateTime;
var time: TDateTime;
begin
  if TryEncodeDate(Year,Month,Day,result) then
    if TryEncodeTime(Hour,Minute,Second,MilliSecond,time) then
      result := result+time else
      result := 0 else
    result := 0;
end;

procedure TSynSystemTime.IncrementMS(ms: integer);
begin
  inc(MilliSecond, ms);
  if MilliSecond >= 1000 then
    repeat
      dec(MilliSecond, 1000);
      if Second < 60 then
        inc(Second)
      else begin
        Second := 0;
        if Minute < 60 then
          inc(Minute)
        else begin
          Minute := 0;
          if Hour < 24 then
            inc(Hour)
          else begin
            Hour := 0;
            if Day < MonthDays[false, Month] then
              inc(Day)
            else begin
              Day := 1;
              if Month < 12 then
                inc(Month)
              else begin
                Month := 1;
                inc(Year);
              end;
            end;
          end;
        end;
      end;
    until MilliSecond < 1000;
end;

{ TTimeZoneData }

function TTimeZoneData.GetTziFor(year: integer): PTimeZoneInfo;
var i,last: integer;
begin
  if dyn=nil then
    result := @tzi else
    if year<=dyn[0].year then
      result := @dyn[0].tzi else begin
      last := high(dyn);
      if year>=dyn[last].year then
        result := @dyn[last].tzi else begin
        for i := 1 to last do
          if year<dyn[i].year then begin
            result := @dyn[i-1].tzi;
            exit;
          end;
        result := @tzi; // should never happen, but makes compiler happy
      end;
    end;
end;


{ TTimeZoneInformation }

constructor TSynTimeZone.Create;
begin
  fZones.InitSpecific(TypeInfo(TTimeZoneDataDynArray),fZone,djRawUTF8);
end;

constructor TSynTimeZone.CreateDefault;
begin
  Create;
  {$ifdef LVCL}
  LoadFromFile;
  {$else}
  {$ifdef MSWINDOWS}
  LoadFromRegistry;
  {$else}
  LoadFromFile;
  if fZones.Count=0 then
    LoadFromResource; // if no .tz file is available, try from registry
  {$endif}
  {$endif}
end;

destructor TSynTimeZone.Destroy;
begin
  inherited Destroy;
  fIds.Free;
  fDisplays.Free;
end;

var
  SharedSynTimeZone: TSynTimeZone;

class function TSynTimeZone.Default: TSynTimeZone;
begin
  if SharedSynTimeZone=nil then
    GarbageCollectorFreeAndNil(SharedSynTimeZone,TSynTimeZone.CreateDefault);
  result := SharedSynTimeZone;
end;

function TSynTimeZone.SaveToBuffer: RawByteString;
begin
  result := SynLZCompress(fZones.SaveTo);
end;

procedure TSynTimeZone.SaveToFile(const FileName: TFileName);
var FN: TFileName;
begin
  if FileName='' then
    FN := ChangeFileExt(ExeVersion.ProgramFileName,'.tz') else
    FN := FileName;
  FileFromString(SaveToBuffer,FN);
end;

procedure TSynTimeZone.LoadFromBuffer(const Buffer: RawByteString);
begin
  fZones.LoadFrom(pointer(AlgoSynLZ.Decompress(Buffer)));
  fZones.ReHash(false);
  FreeAndNil(fIds);
  FreeAndNil(fDisplays);
end;

procedure TSynTimeZone.LoadFromFile(const FileName: TFileName);
var FN: TFileName;
begin
  if FileName='' then
    FN := ChangeFileExt(ExeVersion.ProgramFileName,'.tz') else
    FN := FileName;
  LoadFromBuffer(StringFromFile(FN));
end;

procedure TSynTimeZone.LoadFromResource(Instance: THandle);
var buf: RawByteString;
begin
  ResourceToRawByteString(ClassName,PChar(10),buf,Instance);
  if buf<>'' then
    LoadFromBuffer(buf);
end;

{$ifdef MSWINDOWS}
{$ifndef LVCL}
procedure TSynTimeZone.LoadFromRegistry;
const REGKEY = '\Software\Microsoft\Windows NT\CurrentVersion\Time Zones\';
var Reg: TRegistry;
    Keys: TStringList;
    i,first,last,year,n: integer;
    item: TTimeZoneData;
begin
  fZones.Clear;
  Keys := TStringList.Create;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKeyReadOnly(REGKEY) then
    try
      Reg.GetKeyNames(Keys);
    finally
      Reg.CloseKey;
    end;
    for i := 0 to Keys.Count-1 do begin
      Finalize(item);
      FillcharFast(item.tzi,SizeOf(item.tzi),0);
      if Reg.OpenKeyReadOnly(REGKEY+Keys[i]) then
      try
        StringToUTF8(Keys[i],RawUTF8(item.id));
        StringToUTF8(Reg.ReadString('Display'),item.Display);
        Reg.ReadBinaryData('TZI', item.tzi, SizeOf(item.tzi));
      finally
        Reg.CloseKey;
      end;
      if Reg.OpenKeyReadOnly(REGKEY+Keys[i]+'\Dynamic DST') then
      try
        first := Reg.ReadInteger('FirstEntry');
        last := Reg.ReadInteger('LastEntry');
        n := 0;
        SetLength(item.dyn,last-first+1);
        for year := first to last do
        if Reg.ReadBinaryData(IntToStr(year),item.dyn[n].tzi,
            SizeOf(TTimeZoneInfo))=SizeOf(TTimeZoneInfo) then begin
          item.dyn[n].year := year;
          inc(n);
        end;
        SetLength(item.dyn,n);
      finally
        Reg.CloseKey;
      end;
      fZones.Add(item);
    end;
  finally
    Reg.Free;
    Keys.Free;
  end;
  fZones.ReHash;
  FreeAndNil(fIds);
  FreeAndNil(fDisplays);
end;
{$endif LVCL}
{$endif MSWINDOWS}

function TSynTimeZone.GetDisplay(const TzId: TTimeZoneID): RawUTF8;
var ndx: integer;
begin
  if self=nil then
    ndx := -1 else
    ndx := fZones.FindHashed(TzID);
  if ndx<0 then
    result := '' else
    result := fZone[ndx].display;
end;

function TSynTimeZone.GetBiasForDateTime(const Value: TDateTime;
  const TzId: TTimeZoneID; out Bias: integer; out HaveDaylight: boolean): boolean;
var ndx: integer;
    y,m,d: word;
    tzi: PTimeZoneInfo;
    std,dlt: TDateTime;
begin
  if (self=nil) or (TzId='') then
    ndx := -1 else
    if TzID=fLastZone then
      ndx := fLastIndex else begin
      ndx := fZones.FindHashed(TzID);
      fLastZone := TzID;
      flastIndex := ndx;
    end;
  if ndx<0 then begin
    Bias := 0;
    HaveDayLight := false;
    result := false;
    exit;
  end;
  DecodeDate(Value,y,m,d);
  tzi := fZone[ndx].GetTziFor(y);
  if tzi.change_time_std.IsZero then begin
    HaveDaylight := false;
    Bias := tzi.Bias+tzi.bias_std;
  end else begin
    HaveDaylight := true;
    std := tzi.change_time_std.EncodeForTimeChange(y);
    dlt := tzi.change_time_dlt.EncodeForTimeChange(y);
    if std<dlt then
      if (std<=Value) and (Value<dlt) then
        Bias := tzi.Bias+tzi.bias_std else
        Bias := tzi.Bias+tzi.bias_dlt else
      if (dlt<=Value) and (Value<std) then
        Bias := tzi.Bias+tzi.bias_dlt else
        Bias := tzi.Bias+tzi.bias_std;
  end;
  result := true;
end;

function TSynTimeZone.UtcToLocal(const UtcDateTime: TDateTime;
  const TzId: TTimeZoneID): TDateTime;
var Bias: integer;
    HaveDaylight: boolean;
begin
  if (self=nil) or (TzId='') then
    result := UtcDateTime else begin
    GetBiasForDateTime(UtcDateTime,TzId,Bias,HaveDaylight);
    result := ((UtcDateTime*MinsPerDay)-Bias)/MinsPerDay;
  end;
end;

function TSynTimeZone.NowToLocal(const TzId: TTimeZoneID): TDateTime;
begin
  result := UtcToLocal(NowUtc,TzId);
end;

function TSynTimeZone.LocalToUtc(const LocalDateTime: TDateTime; const TzID: TTimeZoneID): TDateTime;
var Bias: integer;
    HaveDaylight: boolean;
begin
  if (self=nil) or (TzId='') then
    result := LocalDateTime else begin
    GetBiasForDateTime(LocalDateTime,TzId,Bias,HaveDaylight);
    result := ((LocalDateTime*MinsPerDay)+Bias)/MinsPerDay;
  end;
end;

function TSynTimeZone.Ids: TStrings;
var i: integer;
begin
  if fIDs=nil then begin
    fIDs := TStringList.Create;
    for i := 0 to high(fZone) do
      fIDs.Add(UTF8ToString(fZone[i].id));
  end;
  result := fIDs;
end;

function TSynTimeZone.Displays: TStrings;
var i: integer;
begin
  if fDisplays=nil then begin
    fDisplays := TStringList.Create;
    for i := 0 to high(fZone) do
      fDisplays.Add(UTF8ToString(fZone[i].Display));
  end;
  result := fDisplays;
end;


procedure AppendToTextFile(aLine: RawUTF8; const aFileName: TFileName;
    aMaxSize: Int64; aUTCTimeStamp: boolean);
var F: THandle;
    Old: TFileName;
    Date: array[1..22] of AnsiChar;
    size: Int64;
    i: integer;
    now: TSynSystemTime;
begin
  if aFileName='' then
    exit;
  F := FileOpen(aFileName,fmOpenWrite or fmShareDenyNone);
  if PtrInt(F)<0 then begin
    F := FileCreate(aFileName);
    if PtrInt(F)<0 then
      exit; // you may not have write access to this folder
  end;
  // append to end of file
  size := FileSeek64(F,0,soFromEnd);
  if (aMaxSize>0) and (size>aMaxSize) then begin
    // rotate log file if too big
    FileClose(F);
    Old := aFileName+'.bak'; // '.log.bak'
    DeleteFile(Old); // rotate once
    RenameFile(aFileName,Old);
    F := FileCreate(aFileName);
    if PtrInt(F)<0 then
      exit;
  end;
  PWord(@Date)^ := 13+10 shl 8; // first go to next line
  if aUTCTimeStamp then
    now.FromNowUTC else
    now.FromNowLocal;
  DateToIso8601PChar(@Date[3],true,Now.Year,Now.Month,Now.Day);
  TimeToIso8601PChar(@Date[13],true,Now.Hour,Now.Minute,Now.Second,0,' ');
  Date[22] := ' ';
  FileWrite(F,Date,SizeOf(Date));
  for i := 1 to length(aLine) do
    if aLine[i]<' ' then
      aLine[i] := ' '; // avoid line feed in text log file
  FileWrite(F,pointer(aLine)^,length(aLine));
  FileClose(F);
end;

procedure LogToTextFile(Msg: RawUTF8);
begin
  if Msg='' then begin
    StringToUTF8(SysErrorMessage(GetLastError),Msg);
    if Msg='' then
      exit;
  end;
  AppendToTextFile(Msg,{$ifndef MSWINDOWS}ExtractFileName{$endif}
    (ChangeFileExt(ExeVersion.ProgramFileName,'.log')));
end;

function IsEqualGUID({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid1, guid2: TGUID): Boolean;
begin
  result := (PHash128Rec(@guid1).L=PHash128Rec(@guid2).L) and
            (PHash128Rec(@guid1).H=PHash128Rec(@guid2).H);
end;

function IsEqualGUIDArray({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF}
  guid: TGUID; const guids: array of TGUID): integer;
begin
  for result := 0 to high(guids) do
    if IsEqualGUID(guid,guids[result]) then
      exit;
  result := -1;
end;

function IsNullGUID({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): Boolean;
var a: TPtrIntArray absolute guid;
begin
  result := (a[0]=0) and (a[1]=0)
    {$ifndef CPU64} and (a[2]=0) and (a[3]=0){$endif};
end;

function AddGUID(var guids: TGUIDDynArray; const guid: TGUID;
  NoDuplicates: boolean): integer;
begin
  if NoDuplicates then
    for result := 0 to length(guids)-1 do
      if IsEqualGUID(guid,guids[result]) then
        exit;
  result := length(guids);
  SetLength(guids,result+1);
  guids[result] := guid;
end;

function GUIDToText(P: PUTF8Char; guid: PByteArray): PUTF8Char;
var i: integer;
begin // encode as '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
  for i := 3 downto 0 do begin
    PWord(P)^ := TwoDigitsHexWB[guid[i]];
    inc(P,2);
  end;
  inc(PByte(guid),4);
  for i := 1 to 2 do begin
    P[0] := '-';
    PWord(P+1)^ := TwoDigitsHexWB[guid[1]];
    PWord(P+3)^ := TwoDigitsHexWB[guid[0]];
    inc(PByte(guid),2);
    inc(P,5);
  end;
  P[0] := '-';
  PWord(P+1)^ := TwoDigitsHexWB[guid[0]];
  PWord(P+3)^ := TwoDigitsHexWB[guid[1]];
  P[5] := '-';
  inc(PByte(guid),2);
  inc(P,6);
  for i := 0 to 5 do begin
    PWord(P)^ := TwoDigitsHexWB[guid[i]];
    inc(P,2);
  end;
  result := P;
end;

function HexaToByte(P: PUTF8Char; var Dest: byte): boolean; {$ifdef HASINLINE}inline;{$endif}
var B,C: PtrUInt;
begin
  B := ConvertHexToBin[Ord(P[0])];
  if B<=15 then begin
    C := ConvertHexToBin[Ord(P[1])];
    if C<=15 then begin
      Dest := B shl 4+C;
      result := true;
      exit;
    end;
  end;
  result := false; // mark error
end;

function TextToGUID(P: PUTF8Char; guid: PByteArray): PUTF8Char;
var i: integer;
begin // decode from '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
  result := nil;
  for i := 3 downto 0 do begin
    if not HexaToByte(P,guid[i]) then
      exit;
    inc(P,2);
  end;
  inc(PByte(guid),4);
  for i := 1 to 2 do begin
    if (P^<>'-') or not HexaToByte(P+1,guid[1]) or not HexaToByte(P+3,guid[0]) then
      exit;
    inc(P,5);
    inc(PByte(guid),2);
  end;
  if (P[0]<>'-') or (P[5]<>'-') or
     not HexaToByte(P+1,guid[0]) or not HexaToByte(P+3,guid[1]) then
    exit;
  inc(PByte(guid),2);
  inc(P,6);
  for i := 0 to 5 do
    if HexaToByte(P,guid[i]) then
      inc(P,2) else
      exit;
  result := P;
end;

function GUIDToRawUTF8({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): RawUTF8;
var P: PUTF8Char;
begin
  FastSetString(result,nil,38);
  P := pointer(result);
  P^ := '{';
  GUIDToText(P+1,@guid)^ := '}';
end;

function GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): TGUIDShortString;
begin
  GUIDToShort(guid,result);
end;

procedure GUIDToShort({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID;
  out dest: TGUIDShortString);
begin
  dest[0] := #38;
  dest[1] := '{';
  dest[38] := '}';
  GUIDToText(@dest[2],@guid);
end;

function GUIDToString({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID): string;
{$ifdef UNICODE}
var tmp: array[0..35] of AnsiChar;
    i: integer;
begin
  GUIDToText(tmp,@guid);
  SetString(result,nil,38);
  PWordArray(result)[0] := ord('{');
  for i := 1 to 36 do
    PWordArray(result)[i] := ord(tmp[i-1]); // no conversion for 7 bit Ansi
  PWordArray(result)[37] := ord('}');
end;
{$else}
begin
  result := GUIDToRawUTF8(guid);
end;
{$endif}

{$ifdef CPUINTEL} /// NIST SP 800-90A compliant RDRAND Intel x86/x64 opcode
function RdRand32: cardinal;
{$ifdef CPU64}{$ifdef FPC}nostackframe; assembler; asm{$else}
asm
  .noframe {$endif FPC} {$else}
{$ifdef FPC}nostackframe; assembler;{$endif} asm
{$endif}
  // rdrand eax: same opcodes for x86 and x64
  db $0f,$c7,$f0
  // returns in eax, ignore carry flag (eax=0 won't hurt)
end;
{$endif CPUINTEL}

threadvar
  _Lecuyer: TLecuyer; // uses only 16 bytes per thread

procedure TLecuyer.Seed(entropy: PByteArray; entropylen: PtrInt);
var time, crc: THash128Rec;
    i, j: PtrInt;
begin
  repeat
    QueryPerformanceCounter(time.Lo);
    time.Hi := UnixMSTimeUTC xor PtrUInt(GetCurrentThreadID);
    crcblock(@crc.b,@time.b);
    crcblock(@crc.b,@ExeVersion.Hash.b);
    if entropy<>nil then
      for i := 0 to entropylen-1 do begin
        j := i and 15;
        crc.b[j] := crc.b[j] xor entropy^[i];
      end;
    rs1 := rs1 xor crc.c0;
    rs2 := rs2 xor crc.c1;
    rs3 := rs3 xor crc.c2;
    {$ifdef CPUINTEL}
    if cfRAND in CpuFeatures then begin // won't hurt e.g. from Random32gsl
      rs1 := rs1 xor RdRand32;
      rs2 := rs2 xor RdRand32;
      rs3 := rs3 xor RdRand32;
    end;
    {$endif CPUINTEL}
  until (rs1>1) and (rs2>7) and (rs3>15);
  seedcount := 1;
  for i := 1 to crc.i3 and 15 do
    Next; // warm up
end;

function TLecuyer.Next: cardinal;
begin
  if word(seedcount)=0 then // reseed after 256KB of output
    Seed(nil,0) else
    inc(seedcount);
  result := rs1;
  rs1 := ((result and -2)shl 12) xor (((result shl 13)xor result)shr 19);
  result := rs2;
  rs2 := ((result and -8)shl 4) xor (((result shl 2)xor result)shr 25);
  result := rs3;
  rs3 := ((result and -16)shl 17) xor (((result shl 3)xor result)shr 11);
  result := rs1 xor rs2 xor result;
end;

function TLecuyer.Next(max: cardinal): cardinal;
begin
  result := (QWord(Next)*max)shr 32;
end;

procedure Random32Seed(entropy: pointer; entropylen: integer);
begin
  _Lecuyer.Seed(entropy,entropylen);
end;

function Random32: cardinal;
begin
  {$ifdef CPUINTEL}
  if cfRAND in CpuFeatures then
    result := RdRand32 else
  {$endif}
    result := _Lecuyer.Next;
end;

function Random32(max: cardinal): cardinal;
begin
  result := (QWord(Random32)*max)shr 32;
end;

function Random32gsl: cardinal;
begin
  result := _Lecuyer.Next;
end;

function Random32gsl(max: cardinal): cardinal;
begin
  result := (QWord(_Lecuyer.Next)*max)shr 32;
end;

procedure FillRandom(Dest: PCardinalArray; CardinalCount: integer; forcegsl: boolean);
var i: PtrInt;
    c: cardinal;
    seed: TQWordRec;
    lecuyer: ^TLecuyer;
begin
  {$ifdef CPUINTEL}
  if (cfRAND in CpuFeatures) and not forcegsl then
    lecuyer := nil else
  {$endif}
    lecuyer := @_Lecuyer;
  QueryPerformanceCounter(PInt64(@seed)^);
  c := crc32cBy4(seed.L,seed.H);
  {$ifdef CPUINTEL}
  if lecuyer=nil then
    for i := 0 to CardinalCount-1 do begin
      c := crc32cBy4(c,RdRand32); // won't trust plain Intel values
      Dest^[i] := Dest^[i] xor c;
    end else
  {$endif}
    for i := 0 to CardinalCount-1 do begin
      c := c xor lecuyer^.Next;
      Dest^[i] := Dest^[i] xor c;
    end;
end;

function RandomGUID: TGUID;
begin
  FillRandom(@result,SizeOf(TGUID) shr 2);
end;

procedure RandomGUID(out result: TGUID);
begin
  FillRandom(@result,SizeOf(TGUID) shr 2);
end;

procedure FillZero(var result: TGUID);
begin
  FillZero(PHash128(@result)^);
end;

function RawUTF8ToGUID(const text: RawByteString): TGUID;
begin
  if (length(text)<>38) or (text[1]<>'{') or (text[38]<>'}') or
     (TextToGUID(@text[2],@result)=nil) then
   FillZero(PHash128(@result)^);
end;

function StringToGUID(const text: string): TGUID;
{$ifdef UNICODE}
var tmp: array[0..35] of byte;
    i: integer;
{$endif}
begin
  if (length(text)=38) and (text[1]='{') and (text[38]='}') then begin
    {$ifdef UNICODE}
    for i := 0 to 35 do
      tmp[i] := PWordArray(text)[i+1];
    if TextToGUID(@tmp,@result)<>nil then
    {$else}
    if TextToGUID(@text[2],@result)<>nil then
    {$endif}
      exit; // conversion OK
  end;
  FillZero(PHash128(@result)^);
end;

function StrCurr64(P: PAnsiChar; const Value: Int64): PAnsiChar;
var c: QWord;
    d: cardinal;
    {$ifndef CPU64}c64: Int64Rec absolute c;{$endif}
begin
  if Value=0 then begin
    result := P-1;
    result^ := '0';
    exit;
  end;
  if Value<0 then
    c := -Value else
    c := Value;
  if {$ifdef CPU64}c<10000{$else}(c64.Hi=0) and (c64.Lo<10000){$endif} then begin
    result := P-6; // only decimals -> append '0.xxxx'
    PWord(result)^ := ord('0')+ord('.')shl 8;
    YearToPChar(c,PUTF8Char(P)-4);
  end else begin
    result := StrUInt64(P-1,c);
    d := PCardinal(P-5)^; // in two explit steps for CPUARM (alf)
    PCardinal(P-4)^ := d;
    P[-5] := '.'; // insert '.' just before last 4 decimals
  end;
  if Value<0 then begin
    dec(result);
    result^ := '-';
  end;
end;

procedure Curr64ToStr(const Value: Int64; var result: RawUTF8);
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Decim, L: Cardinal;
begin
  if Value=0 then
    result := SmallUInt32UTF8[0] else begin
    P := StrCurr64(@tmp[31],Value);
    L := @tmp[31]-P;
    if L>4 then begin
      Decim := PCardinal(P+L-SizeOf(cardinal))^; // 4 last digits = 4 decimals
      if Decim=ord('0')+ord('0')shl 8+ord('0')shl 16+ord('0')shl 24 then
        dec(L,5) else // no decimal
      if Decim and $ffff0000=ord('0')shl 16+ord('0')shl 24 then
        dec(L,2); // 2 decimals
    end;
    FastSetString(result,P,L);
  end;
end;

function Curr64ToStr(const Value: Int64): RawUTF8;
begin
  Curr64ToStr(Value,result);
end;

function CurrencyToStr(Value: currency): RawUTF8;
begin
  result := Curr64ToStr(PInt64(@Value)^);
end;

function Curr64ToPChar(const Value: Int64; Dest: PUTF8Char): PtrInt;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Decim: Cardinal;
begin
  P := StrCurr64(@tmp[31],Value);
  result := @tmp[31]-P;
  if result>4 then begin
    Decim := PCardinal(P+result-SizeOf(cardinal))^; // 4 last digits = 4 decimals
    if Decim=ord('0')+ord('0')shl 8+ord('0')shl 16+ord('0')shl 24 then
      dec(result,5) else // no decimal
    if Decim and $ffff0000=ord('0')shl 16+ord('0')shl 24 then
      dec(result,2); // 2 decimals
  end;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,Dest^,result);
end;

function StrToCurr64(P: PUTF8Char; NoDecimal: PBoolean=nil): Int64;
var c: cardinal;
    minus: boolean;
    Dec: cardinal;
begin
  result := 0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^='-' then begin
    minus := true;
    repeat inc(P) until P^<>' ';
  end else begin
    minus := false;
    if P^='+' then
      repeat inc(P) until P^<>' ';
  end;
  if P^='.' then begin // '.5' -> 500
    Dec := 2;
    inc(P);
  end else
    Dec := 0;
  c := byte(P^)-48;
  if c>9 then
    exit;
  PCardinal(@result)^ := c;
  inc(P);
  repeat
    if P^<>'.' then begin
      c := byte(P^)-48;
      if c>9 then
        break;
      {$ifdef CPU32DELPHI}
      result := result shl 3+result+result;
      {$else}
      result := result*10;
      {$endif}
      inc(result,c);
      inc(P);
      if Dec<>0 then begin
        inc(Dec);
        if Dec<5 then continue else break;
      end;
    end else begin
      inc(Dec);
      inc(P);
    end;
  until false;
  if NoDecimal<>nil then
    if Dec=0 then begin
      NoDecimal^ := true;
      if minus then
        result := -result;
      exit;
    end else
      NoDecimal^ := false;
  if Dec<>5 then // Dec=5 most of the time
  case Dec of
  0,1: result := result*10000;
  {$ifdef CPU32DELPHI}
  2: result := result shl 10-result shl 4-result shl 3;
  3: result := result shl 6+result shl 5+result shl 2;
  4: result := result shl 3+result+result;
  {$else}
  2: result := result*1000;
  3: result := result*100;
  4: result := result*10;
  {$endif}
  end;
  if minus then
    result := -result;
end;

function StrToCurrency(P: PUTF8Char): currency;
begin
  PInt64(@result)^ := StrToCurr64(P,nil);
end;

function TruncTo2Digits(Value: Currency): Currency;
var V64: Int64 absolute Value; // to avoid any floating-point precision issues
begin
  dec(V64,V64 mod 100);
  result := Value;
end;

procedure TruncTo2DigitsCurr64(var Value: Int64);
begin
  dec(Value,Value mod 100);
end;

function SimpleRoundTo2Digits(Value: Currency): Currency;
var V64: Int64 absolute Value; // to avoid any floating-point precision issues
begin
  SimpleRoundTo2DigitsCurr64(V64);
  result := Value;
end;

procedure SimpleRoundTo2DigitsCurr64(var Value: Int64);
var Spare: PtrInt;
begin
  Spare := Value mod 100;
  if Spare<>0 then
    if Spare>50 then
      inc(Value,100-Spare) else
    if Spare<-50 then
      dec(Value,100+Spare) else
      dec(Value,Spare);
end;

function TrimLeftLowerCase(const V: RawUTF8): PUTF8Char;
begin
  result := Pointer(V);
  if result<>nil then begin
    while result^ in ['a'..'z'] do
      inc(result);
    if result^=#0 then
      result := Pointer(V);
  end;
end;

function TrimLeftLowerCaseToShort(V: PShortString): ShortString;
begin
  TrimLeftLowerCaseToShort(V,result);
end;

procedure TrimLeftLowerCaseToShort(V: PShortString; out result: ShortString);
var P: PAnsiChar;
    L: integer;
begin
  L := length(V^);
  P := @V^[1];
  while (L>0) and (P^ in ['a'..'z']) do begin
    inc(P);
    dec(L);
  end;
  if L=0 then
    result := V^ else
    SetString(result,P,L);
end;

{$ifdef FPC_OR_PUREPASCAL}
function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;
var P: PAnsiChar;
    L: integer;
begin
  L := length(V^);
  P := @V^[1];
  while (L>0) and (P^ in ['a'..'z']) do begin
    inc(P);
    dec(L);
  end;
  if L=0 then
    FastSetString(result,@V^[1],length(V^)) else
    FastSetString(result,P,L);
end;
{$else}
function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;
asm // eax=V
        xor     ecx, ecx
        push    edx // save result RawUTF8
        test    eax, eax
        jz      @2 // avoid GPF
        lea     edx, [eax + 1]
        mov     cl, [eax]
@1:     mov     ch, [edx] // edx=source cl=length
        sub     ch, 'a'
        sub     ch, 'z' - 'a'
        ja      @2 // not a lower char -> create a result string starting at edx
        inc     edx
        dec     cl
        jnz     @1
        mov     cl, [eax]
        lea     edx, [eax + 1]  // no UpperCase -> retrieve full text (result := V^)
@2:     pop     eax
        movzx   ecx, cl
{$ifdef UNICODE}
        push    CP_UTF8 // UTF-8 code page for Delphi 2009+ + call below, not jump
        call    System.@LStrFromPCharLen // eax=Dest edx=Source ecx=Length
        rep     ret // we need a call just above for right push CP_UTF8 retrieval
{$else} jmp     System.@LStrFromPCharLen // eax=dest edx=source ecx=length(source)
{$endif}
end;
{$endif FPC_OR_PUREPASCAL}

function UnCamelCase(const S: RawUTF8): RawUTF8;
begin
  result := '';
  if S='' then
    exit;
  SetLength(result,length(S)*2); // max length
  SetLength(result,UnCamelCase(pointer(result),pointer(S)));
end;

function UnCamelCase(D, P: PUTF8Char): integer;
var Space, SpaceBeg, DBeg: PUTF8Char;
    CapitalCount: integer;
    Number: boolean;
label Next;
begin
  DBeg := D;
  if (D<>nil) and (P<>nil) then begin // avoid GPF
    Space := D;
    SpaceBeg := D;
    repeat
      CapitalCount := 0;
      Number := P^ in  ['0'..'9'];
      if Number then
        repeat
          inc(CapitalCount);
          D^ := P^;
          inc(P);
          inc(D);
        until not (P^ in ['0'..'9']) else
        repeat
          inc(CapitalCount);
          D^ := P^;
          inc(P);
          inc(D);
        until not (P^ in ['A'..'Z']);
      if P^=#0 then break; // no lowercase conversion of last fully uppercased word
      if (CapitalCount > 1) and not Number then begin
        dec(P);
        dec(D);
      end;
      while P^ in ['a'..'z'] do begin
        D^  := P^;
        inc(D);
        inc(P);
      end;
      if P^='_' then
      if P[1]='_' then begin
        D^ := ':';
        inc(P);
        inc(D);
        goto Next;
      end else begin
        PWord(D)^ := ord(' ')+ord('-')shl 8;
        inc(D,2);
  Next: if Space=SpaceBeg then
          SpaceBeg := D+1;
        inc(P);
        Space := D+1;
      end else
        Space := D;
      if P^=#0 then break;
      D^ := ' ';
      inc(D);
    until false;
    if Space>DBeg then
      dec(Space);
    while Space>SpaceBeg do begin
      if Space^ in ['A'..'Z'] then
        if not (Space[1] in ['A'..'Z',' ']) then
          inc(Space^,32); // lowercase conversion of not last fully uppercased word
      dec(Space);
    end;
  end;
  result := D-DBeg;
end;

procedure CamelCase(P: PAnsiChar; len: integer; var s: RawUTF8;
  const isWord: TSynByteSet);
var i: integer;
    d: PAnsiChar;
    tmp: array[byte] of AnsiChar;
begin
  if len > SizeOf(tmp) then
    len := SizeOf(tmp);
  for i := 0 to len - 1 do
    if not (ord(P[i]) in isWord) then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,tmp,i);
      inc(P,i);
      d := @tmp[i];
      dec(len,i);
      while len > 0 do begin
        while (len > 0) and not (ord(P^) in isWord) do begin
          inc(P);
          dec(len);
        end;
        if len = 0 then
          break;
        d^ := NormToUpperAnsi7[P^];
        inc(d);
        repeat
          inc(P);
          dec(len);
          if not (ord(P^) in isWord) then
            break;
          d^ := P^;
          inc(d);
        until len = 0;
      end;
      P := @tmp;
      len := d-tmp;
      break;
    end;
  FastSetString(s,P,len);
end;

procedure CamelCase(const text: RawUTF8; var s: RawUTF8; const isWord: TSynByteSet);
begin
  CamelCase(pointer(text), length(text), s, isWord);
end;

procedure GetCaptionFromPCharLen(P: PUTF8Char; out result: string);
var Temp: array[byte] of AnsiChar;
begin // "out result" parameter definition already made result := ''
  if P=nil then
    exit;
{$ifdef UNICODE}
  // property and enumeration names are UTF-8 encoded with Delphi 2009+
  UTF8DecodeToUnicodeString(Temp,UnCamelCase(@Temp,P),result);
{$else}
  SetString(result,Temp,UnCamelCase(@Temp,P));
{$endif}
{$ifndef LVCL} // LVCL system.pas doesn't implement LoadResStringTranslate()
  if Assigned(LoadResStringTranslate) then
    LoadResStringTranslate(result);
{$endif}
end;

function GetDisplayNameFromClass(C: TClass): RawUTF8;
var DelphiName: PShortString;
    TrimLeft: integer;
begin
  if C=nil then begin
    result := '';
    exit;
  end;
  DelphiName := ClassNameShort(C);
  TrimLeft := 0;
  if DelphiName^[0]>#4 then
    case PInteger(@DelphiName^[1])^ and $DFDFDFDF of
      // fast case-insensitive compare
      ord('T')+ord('S')shl 8+ord('Q')shl 16+ord('L')shl 24:
        if (DelphiName^[0]<=#10) or
         (PInteger(@DelphiName^[5])^ and $DFDFDFDF<> // fast case-insensitive compare
           ord('R')+ord('E')shl 8+ord('C')shl 16+ord('O')shl 24) or
         (PWord(@DelphiName^[9])^ and $DFDF<>ord('R')+ord('D')shl 8) then
        TrimLeft := 4 else
        TrimLeft := 10;
      ord('T')+ord('S')shl 8+ord('Y')shl 16+ord('N')shl 24:
        TrimLeft := 4;
    end;
  if (Trimleft=0) and (DelphiName^[1]='T') then
    Trimleft := 1;
  FastSetString(result,@DelphiName^[TrimLeft+1],ord(DelphiName^[0])-TrimLeft);
end;

function ClassNameShort(C: TClass): PShortString;
// new TObject.ClassName is UnicodeString (since Delphi 2009) -> inline code
// with vmtClassName = UTF-8 encoded text stored in a shortstring = -44
begin
  result := PPointer(PtrInt(PtrUInt(C))+vmtClassName)^;
end;

function ClassNameShort(Instance: TObject): PShortString;
begin
  result := PPointer(PPtrInt(Instance)^+vmtClassName)^;
end;

function ToText(C: TClass): RawUTF8;
var P: PShortString;
begin
  if C=nil then
    result := '' else begin
    P := PPointer(PtrInt(PtrUInt(C))+vmtClassName)^;
    FastSetString(result,@P^[1],ord(P^[0]));
  end;
end;

procedure ToText(C: TClass; var result: RawUTF8);
var P: PShortString;
begin
  if C=nil then
    result := '' else begin
    P := PPointer(PtrInt(PtrUInt(C))+vmtClassName)^;
    FastSetString(result,@P^[1],ord(P^[0]));
  end;
end;

function GetPublishedMethods(Instance: TObject; out Methods: TPublishedMethodInfoDynArray; aClass: TClass): integer;
  procedure AddParentsFirst(C: TClass);
  type
    TMethodInfo = packed record
      {$ifdef FPC}
      Name: PShortString;
      Addr: Pointer;
      {$else}
      Len: Word;
      Addr: Pointer;
      Name: ShortString;
      {$endif}
    end;
  var Table: {$ifdef FPC}PCardinalArray{$else}PWordArray{$endif};
      M: ^TMethodInfo;
      i: integer;
  begin
    if C=nil then
      exit;
    AddParentsFirst(C.ClassParent); // put children published methods afterward
    Table := PPointer(PtrUInt(C)+PtrUInt(vmtMethodTable))^;
    if Table=nil then
      exit;
    SetLength(Methods,result+Table^[0]);
    M := @Table^[1];
    for i := 1 to Table^[0] do  // Table^[0] = methods count
      with Methods[result] do begin
        ShortStringToAnsi7String(M^.Name{$ifdef FPC}^{$endif},Name);
        Method.Data := Instance;
        Method.Code := M^.Addr;
        {$ifdef FPC}
        inc(M);
        {$else}
        inc(PByte(M),M^.Len);
        {$endif}
        inc(result);
      end;
  end;
begin
  result := 0;
  if aClass <> nil then
    AddParentsFirst(aClass)
  else if Instance<>nil then
    AddParentsFirst(PPointer(Instance)^); // use recursion for adding
end;

function GetCaptionFromClass(C: TClass): string;
var tmp: RawUTF8;
    P: PUTF8Char;
begin
  if C=nil then
    result := '' else begin
    ToText(C,tmp);
    P := pointer(tmp);
    if IdemPChar(P,'TSQL') or IdemPChar(P,'TSYN') then
      inc(P,4) else
    if P^='T' then
       inc(P);
    GetCaptionFromPCharLen(P,result);
  end;
end;

function GetCaptionFromEnum(aTypeInfo: pointer; aIndex: integer): string;
begin
  GetCaptionFromTrimmed(GetEnumName(aTypeInfo,aIndex),result);
end;

function CharSetToCodePage(CharSet: integer): cardinal;
begin
  case CharSet of
    SHIFTJIS_CHARSET:   result := 932;
    HANGEUL_CHARSET:    result := 949;
    GB2312_CHARSET:     result := 936;
    HEBREW_CHARSET:     result := 1255;
    ARABIC_CHARSET:     result := 1256;
    GREEK_CHARSET:      result := 1253;
    TURKISH_CHARSET:    result := 1254;
    VIETNAMESE_CHARSET: result := 1258;
    THAI_CHARSET:       result := 874;
    EASTEUROPE_CHARSET: result := 1250;
    RUSSIAN_CHARSET:    result := 1251;
    BALTIC_CHARSET:     result := 1257;
  else result := CODEPAGE_US; // default is ANSI_CHARSET = iso-8859-1 = windows-1252
  end;
end;

function CodePageToCharSet(CodePage: Cardinal): Integer;
begin
  case CodePage of
    932:  result := SHIFTJIS_CHARSET;
    949:  result := HANGEUL_CHARSET;
    936:  result := GB2312_CHARSET;
    1255: result := HEBREW_CHARSET;
    1256: result := ARABIC_CHARSET;
    1253: result := GREEK_CHARSET;
    1254: result := TURKISH_CHARSET;
    1258: result := VIETNAMESE_CHARSET;
    874:  result := THAI_CHARSET;
    1250: result := EASTEUROPE_CHARSET;
    1251: result := RUSSIAN_CHARSET;
    1257: result := BALTIC_CHARSET;
  else result := ANSI_CHARSET; // default is iso-8859-1 = windows-1252
  end;
end;

function GetMimeContentTypeFromBuffer(Content: Pointer; Len: integer;
  const DefaultContentType: RawUTF8): RawUTF8;
begin
  result := DefaultContentType;
  if (Content<>nil) and (Len>4) then
    case PCardinal(Content)^ of
    $04034B50: result := 'application/zip'; // 50 4B 03 04
    $46445025: result := 'application/pdf'; //  25 50 44 46 2D 31 2E
    $21726152: result := 'application/x-rar-compressed'; // 52 61 72 21 1A 07 00
    $AFBC7A37: result := 'application/x-7z-compressed';  // 37 7A BC AF 27 1C
    $694C5153: result := 'application/x-sqlite3'; // SQlite format 3 = 53 51 4C 69
    $75B22630: result := 'audio/x-ms-wma'; // 30 26 B2 75 8E 66
    $9AC6CDD7: result := 'video/x-ms-wmv'; // D7 CD C6 9A 00 00
    $474E5089: result := 'image/png'; // 89 50 4E 47 0D 0A 1A 0A
    $38464947: result := 'image/gif'; // 47 49 46 38
    $46464F77: result := 'application/font-woff'; // wOFF in BigEndian
    $46464952: if Len>16 then // RIFF
      case PCardinalArray(Content)^[2] of
      $50424557: result := 'image/webp';
      $20495641: if PCardinalArray(Content)^[3]=$5453494C then
        result := 'video/x-msvideo'; // Windows Audio Video Interleave file
      end;
    $002A4949, $2A004D4D, $2B004D4D:
      result := 'image/tiff'; // 49 49 2A 00 or 4D 4D 00 2A or 4D 4D 00 2B
    $E011CFD0: // Microsoft Office applications D0 CF 11 E0=DOCFILE
      if Len>600 then
      case PWordArray(Content)^[256] of // at offset 512
        $A5EC: result := 'application/msword'; // EC A5 C1 00
        $FFFD: // FD FF FF
          case PByteArray(Content)^[516] of
            $0E,$1C,$43: result := 'application/vnd.ms-powerpoint';
            $10,$1F,$20,$22,$23,$28,$29: result := 'application/vnd.ms-excel';
          end;
      end;
    $5367674F:
      if Len>14 then // OggS
        if (PCardinalArray(Content)^[1]=$00000200) and
           (PCardinalArray(Content)^[2]=$00000000) and
           (PWordArray(Content)^[6]=$0000) then
          result := 'video/ogg';
    $1C000000:
      if Len>12 then
        if PCardinalArray(Content)^[1]=$70797466 then  // ftyp
          case PCardinalArray(Content)^[2] of
            $6D6F7369, // isom: ISO Base Media file (MPEG-4) v1
            $3234706D: // mp42: MPEG-4 video/QuickTime file
              result := 'video/mp4';
            $35706733: // 3gp5: MPEG-4 video files
              result := 'video/3gpp';
          end;
    else
      case PCardinal(Content)^ and $00ffffff of
        $685A42: result := 'application/bzip2'; // 42 5A 68
        $088B1F: result := 'application/gzip'; // 1F 8B 08
        $492049: result := 'image/tiff'; // 49 20 49
        $FFD8FF: result := JPEG_CONTENT_TYPE; // FF D8 FF DB/E0/E1/E2/E3/E8
        else
          case PWord(Content)^ of
            $4D42: result := 'image/bmp'; // 42 4D
          end;
      end;
    end;
end;

function GetMimeContentType(Content: Pointer; Len: integer;
  const FileName: TFileName): RawUTF8;
begin // see http://www.garykessler.net/library/file_sigs.html for magic numbers
  if Content<>nil then
    result := GetMimeContentTypeFromBuffer(Content,Len,'') else
    result := '';
  if (result='') and (FileName<>'') then begin
    result := LowerCase(StringToAnsi7(ExtractFileExt(FileName)));
    case PosEx(copy(result,2,4),
        'png,gif,tiff,jpg,jpeg,bmp,doc,htm,html,css,js,ico,wof,txt,svg,'+
      // 1   5   9    14  18   23  27  31  35   40  44 47  51  55  59
        'atom,rdf,rss,webp,appc,mani,docx,xml,json,woff,ogg,ogv,mp4,m2v,'+
      // 63   68  72  76   81   86   91   96  100  105  110 114 118 122
        'm2p,mp3,h264,text,log,gz') of
      // 126 130 134  139  144 148
      1:  result := 'image/png';
      5:  result := 'image/gif';
      9:  result := 'image/tiff';
      14,18: result := JPEG_CONTENT_TYPE;
      23: result := 'image/bmp';
      27,91: result := 'application/msword';
      31,35: result := HTML_CONTENT_TYPE;
      40: result := 'text/css';
      44: result := 'application/javascript';
      // text/javascript and application/x-javascript are obsolete (RFC 4329)
      47: result := 'image/x-icon';
      51,105: result := 'application/font-woff';
      55,139,144: result := TEXT_CONTENT_TYPE;
      59: result := 'image/svg+xml';
      63,68,72,96: result := XML_CONTENT_TYPE;
      76: result := 'image/webp';
      81,86: result := 'text/cache-manifest';
      100: result := JSON_CONTENT_TYPE_VAR;
      110,114: result := 'video/ogg';  // RFC 5334
      118: result := 'video/mp4';      // RFC 4337 6381
      122,126: result := 'video/mp2';
      130: result := 'audio/mpeg';     // RFC 3003
      134: result := 'video/H264';     // RFC 6184
      148: result := 'application/gzip';
      else
        if result<>'' then
          result := 'application/'+copy(result,2,10);
    end;
  end;
  if result='' then
    result := BINARY_CONTENT_TYPE;
end;

function GetMimeContentTypeHeader(const Content: RawByteString;
  const FileName: TFileName): RawUTF8;
begin
  result := HEADER_CONTENT_TYPE+
    GetMimeContentType(Pointer(Content),length(Content),FileName);
end;

function IsContentCompressed(Content: Pointer; Len: integer): boolean;
begin // see http://www.garykessler.net/library/file_sigs.html
  result := false;
  if (Content<>nil) and (Len>8) then
    case PCardinal(Content)^ of
    $002a4949, $2a004d4d, $2b004d4d, // 'image/tiff'
    $04034b50, // 'application/zip' = 50 4B 03 04
    $184d2204, // LZ4 stream format = 04 22 4D 18
    $21726152, // 'application/x-rar-compressed' = 52 61 72 21 1A 07 00
    $28635349, // cab = 49 53 63 28
    $38464947, // 'image/gif' = 47 49 46 38
    $43614c66, // FLAC = 66 4C 61 43 00 00 00 22
    $4643534d, // cab = 4D 53 43 46 [MSCF]
    $46464952, // avi,webp,wav = 52 49 46 46 [RIFF]
    $46464f77, // 'application/font-woff' = wOFF in BigEndian
    $474e5089, // 'image/png' = 89 50 4E 47 0D 0A 1A 0A
    $4d5a4cff, // LZMA = FF 4C 5A 4D 41 00
    $75b22630, // 'audio/x-ms-wma' = 30 26 B2 75 8E 66
    $766f6f6d, // mov = 6D 6F 6F 76 [....moov]
    $89a8275f, // jar = 5F 27 A8 89
    $9ac6cdd7, // 'video/x-ms-wmv' = D7 CD C6 9A 00 00
    $a5a5a5a5, // .mab file = MAGIC_MAB in SynLog.pas
    $a5aba5a5, // .data = TSQLRESTSTORAGEINMEMORY_MAGIC in mORMot.pas
    $aba51051, // .log.synlz = LOG_MAGIC in SynLog.pas
    $aba5a5ab, // .dbsynlz = SQLITE3_MAGIC in SynSQLite3.pas
    $afbc7a37, // 'application/x-7z-compressed' = 37 7A BC AF 27 1C
    $b7010000, $ba010000, // mpeg = 00 00 01 Bx
    $cececece, // jceks = CE CE CE CE
    $e011cfd0: // msi = D0 CF 11 E0 A1 B1 1A E1
      result := true;
    else
      case PCardinal(Content)^ and $00ffffff of
        $088b1f, // 'application/gzip' = 1F 8B 08
        $334449, // mp3 = 49 44 33 [ID3]
        $492049, // 'image/tiff' = 49 20 49
        $535746, // swf = 46 57 53 [FWS]
        $535743, // swf = 43 57 53 [zlib]
        $53575a, // zws/swf = 5A 57 53 [FWS]
        $564c46, // flv = 46 4C 56 [FLV]
        $685a42, // 'application/bzip2' = 42 5A 68
        $ffd8ff: // JPEG_CONTENT_TYPE = FF D8 FF DB/E0/E1/E2/E3/E8
          result := true;
        else
        case PCardinalArray(Content)^[1] of // 4 byte offset
        1{TAlgoSynLZ.AlgoID}: // crc32 01 00 00 00 crc32 = Compress() header
          result := PCardinalArray(Content)^[0]<>PCardinalArray(Content)^[2];
        $70797466, // mp4,mov = 66 74 79 70 [33 67 70 35/4D 53 4E 56..]
        $766f6f6d: // mov = 6D 6F 6F 76
          result := true;
        end;
      end;
    end;
end;

function GetJpegSize(jpeg: PAnsiChar; len: integer; out Height, Width: integer): boolean;
var je: PAnsiChar;
begin // see https://en.wikipedia.org/wiki/JPEG#Syntax_and_structure
  result := false;
  if (jpeg=nil) or (len<100) or (PWord(jpeg)^<>$d8ff) then // SOI
    exit;
  je := jpeg+len-1;
  inc(jpeg,2);
  while jpeg<je do begin
    if jpeg^<>#$ff then
      exit;
    inc(jpeg);
    case ord(jpeg^) of
      $c0..$c3,$c5..$c7,$c9..$cb,$cd..$cf: begin // SOF
        Height := swap(PWord(jpeg+4)^);
        Width  := swap(PWord(jpeg+6)^);
        result := (Height>0) and (Height<20000) and (Width>0) and (Width<20000);
        exit;
      end;
      $d0..$d8,$01: inc(jpeg); // RST, SOI
      $d9: break;   // EOI
      $ff: ;        // padding
      else inc(jpeg,swap(PWord(jpeg+1)^)+1);
    end;
  end;
end;

function GetJpegSize(const jpeg: TFileName; out Height, Width: integer): boolean;
var map: TMemoryMap;
begin
  if map.Map(jpeg) then
    try
      result := GetJpegSize(map.Buffer,map.Size,Height,Width);
    finally
      map.UnMap;
    end else
    result := false;
end;

function IsHTMLContentTypeTextual(Headers: PUTF8Char): Boolean;
begin
  result := ExistsIniNameValue(Headers,HEADER_CONTENT_TYPE_UPPER,
    [JSON_CONTENT_TYPE_UPPER,'TEXT/','APPLICATION/XML','APPLICATION/JAVASCRIPT',
     'APPLICATION/X-JAVASCRIPT','IMAGE/SVG+XML']);
end;

function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;
var boundary,endBoundary: RawUTF8;
    i,j: integer;
    P: PUTF8Char;
    part: TMultiPart;
begin
  result := false;
  i := PosEx('boundary=',MimeType);
  if i=0 then
    exit;
  boundary := trim(copy(MimeType,i+9,200));
  if (boundary<>'') and (boundary[1]='"') then
    boundary := copy(boundary,2,length(boundary)-2); // "boundary" -> boundary
  boundary := '--'+boundary;
  endBoundary := boundary+'--'+#13#10;
  boundary := boundary+#13#10;
  i := PosEx(boundary,Body);
  if i<>0 then
  repeat
    inc(i,length(boundary));
    if i=length(body) then
      exit; // reached the end
    P := PUTF8Char(Pointer(Body))+i-1;
    Finalize(part);
    repeat
      if IdemPChar(P,'CONTENT-DISPOSITION: ') then begin
        inc(P,21);
        if IdemPCharAndGetNextItem(P,'FORM-DATA; NAME="',part.Name,'"') then
          IdemPCharAndGetNextItem(P,'; FILENAME="',part.FileName,'"') else
          IdemPCharAndGetNextItem(P,'FILE; FILENAME="',part.FileName,'"')
      end else
      if not IdemPCharAndGetNextItem(P,'CONTENT-TYPE: ',part.ContentType) then
         IdemPCharAndGetNextItem(P,'CONTENT-TRANSFER-ENCODING: ',part.Encoding);
      P := GotoNextLine(P);
      if P=nil then
        exit;
    until PWord(P)^=13+10 shl 8;
    i := P-PUTF8Char(Pointer(Body))+3; // i = just after header
    j := PosEx(boundary,Body,i);
    if j=0 then begin
     j := PosEx(endboundary,Body,i); // try last boundary
     if j=0 then
      exit;
    end;
    part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
    if (part.ContentType='') or (PosEx('-8',part.ContentType)>0) then begin
      part.ContentType := TEXT_CONTENT_TYPE;
      {$ifdef HASCODEPAGE}
      SetCodePage(part.Content,CP_UTF8,false); // ensure raw field value is UTF-8
      {$endif}
    end;
    if IdemPropNameU(part.Encoding,'base64') then
      part.Content := Base64ToBin(part.Content);
    // note: "quoted-printable" not yet handled here
    SetLength(MultiPart,length(MultiPart)+1);
    MultiPart[high(MultiPart)] := part;
    result := true;
    i := j;
  until false;
end;

function MultiPartFormDataEncode(const MultiPart: TMultiPartDynArray;
  var MultiPartContentType, MultiPartContent: RawUTF8): boolean;
var len, boundcount, filescount, i: integer;
    boundaries: array of RawUTF8;
    bound: RawUTF8;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
  procedure NewBound;
  var random: array[1..3] of cardinal;
  begin
    FillRandom(@random,3);
    bound := BinToBase64(@random,SizeOf(Random));
    SetLength(boundaries,boundcount+1);
    boundaries[boundcount] := bound;
    inc(boundcount);
  end;
begin
  result := false;
  len := length(MultiPart);
  if len=0 then
    exit;
  boundcount := 0;
  filescount := 0;
  W := TTextWriter.CreateOwnedStream(temp);
  try
    // header - see https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html
    NewBound;
    MultiPartContentType := 'Content-Type: multipart/form-data; boundary='+bound;
    for i := 0 to len-1 do
    with MultiPart[i] do begin
      if FileName='' then
        W.Add('--%'#13#10'Content-Disposition: form-data; name="%"'#13#10+
          'Content-Type: %'#13#10#13#10'%'#13#10'--%'#13#10,
          [bound,Name,ContentType,Content,bound]) else begin
        // if this is the first file, create the header for files
        if filescount=0 then begin
          if i>0 then
            NewBound;
          W.Add('Content-Disposition: form-data; name="files"'#13#10+
            'Content-Type: multipart/mixed; boundary=%'#13#10#13#10,[bound]);
        end;
        inc(filescount);
        W.Add('--%'#13#10'Content-Disposition: file; filename="%"'#13#10+
          'Content-Type: %'#13#10,[bound,FileName,ContentType]);
        if Encoding<>'' then
          W.Add('Content-Transfer-Encoding: %'#13#10,[Encoding]);
        W.AddCR;
        W.AddString(MultiPart[i].Content);
        W.Add(#13#10'--%'#13#10,[bound]);
      end;
    end;
    // footer multipart
    for i := boundcount-1 downto 0 do
      W.Add('--%--'#13#10, [boundaries[i]]);
    W.SetText(MultiPartContent);
    result := True;
  finally
    W.Free;
  end;
end;

function MultiPartFormDataAddFile(const FileName: TFileName;
  var MultiPart: TMultiPartDynArray; const Name: RawUTF8): boolean;
var part: TMultiPart;
    newlen: integer;
    content: RawByteString;
begin
  result := false;
  content := StringFromFile(FileName);
  if content='' then
    exit;
  newlen := length(MultiPart)+1;
  if Name='' then
    FormatUTF8('File%',[newlen],part.Name) else
    part.Name := Name;
  part.FileName := StringToUTF8(ExtractFileName(FileName));
  part.ContentType := GetMimeContentType(pointer(content),length(content),FileName);
  part.Encoding := 'base64';
  part.Content := BinToBase64(content);
  SetLength(MultiPart,newlen);
  MultiPart[newlen-1] := part;
  result := true;
end;

function MultiPartFormDataAddField(const FieldName, FieldValue: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;
var
  part: TMultiPart;
  newlen: integer;
begin
  result := false;
  if FieldName='' then
    exit;
  newlen := length(MultiPart)+1;
  part.Name := FieldName;
  part.ContentType := GetMimeContentTypeFromBuffer(
    pointer(FieldValue),length(FieldValue),'text/plain');
  part.Content := FieldValue;
  SetLength(MultiPart,newlen);
  MultiPart[newlen-1] := part;
  result := true;
end;

function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt;
begin
  result := FastLocatePUTF8CharSorted(P,R,Value,TUTF8Compare(@StrComp));
end;

function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt;
var L,i,cmp: PtrInt;
begin // fast O(log(n)) binary search
  if not Assigned(Compare) or (R<0) then
    result := 0 else
    if Compare(P^[R],Value)<0 then // quick return if already sorted
      result := R+1 else begin
      L := 0;
      result := -1; // return -1 if found
      repeat
        i := (L + R) shr 1;
        cmp := Compare(P^[i],Value);
        if cmp=0 then
          exit;
        if cmp<0 then
          L := i + 1 else
          R := i - 1;
      until (L > R);
      while (i>=0) and (Compare(P^[i],Value)>=0) do dec(i);
      result := i+1; // return the index where to insert
    end;
end;

function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt;
var L, cmp: PtrInt;
begin // fast O(log(n)) binary search
  L := 0;
  if Assigned(Compare) and (R>=0) then
    repeat
      result := (L+R) shr 1;
      cmp := Compare(P^[result],Value);
      if cmp=0 then
        exit;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1;
end;

function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt;
begin
  result := FastFindPUTF8CharSorted(P,R,Value,TUTF8Compare(@StrComp));
end;

function FastFindIndexedPUTF8Char(P: PPUTF8CharArray; R: PtrInt;
  var SortedIndexes: TCardinalDynArray; Value: PUTF8Char;
  ItemComp: TUTF8Compare): PtrInt;
var L, cmp: PtrInt;
begin // fast O(log(n)) binary search
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      cmp := ItemComp(P^[SortedIndexes[result]],Value);
      if cmp=0 then begin
        result := SortedIndexes[result];
        exit;
      end;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1;
end;

function AddSortedRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8; CoValues: PIntegerDynArray; ForcedIndex: PtrInt;
  Compare: TUTF8Compare): PtrInt;
var n: PtrInt;
begin
  if ForcedIndex>=0 then
    result := ForcedIndex else begin
    if not Assigned(Compare) then
      Compare := @StrComp;
    result := FastLocatePUTF8CharSorted(pointer(Values),ValuesCount-1,pointer(Value),Compare);
    if result<0 then
      exit; // Value exists -> fails
  end;
  n := Length(Values);
  if ValuesCount=n then begin
    n := NextGrow(n);
    SetLength(Values,n);
    if CoValues<>nil then
      SetLength(CoValues^,n);
  end;
  n := ValuesCount;
  if result<n then begin
    n := (n-result)*SizeOf(pointer);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Pointer(Values[result]),Pointer(Values[result+1]),n);
    PtrInt(Values[result]) := 0; // avoid GPF
    if CoValues<>nil then begin
      {$ifdef CPU64}n := n shr 1;{$endif} // 64-bit pointer size is twice an integer
      {$ifdef FPC}Move{$else}MoveFast{$endif}(CoValues^[result],CoValues^[result+1],n);
    end;
  end else
    result := n;
  Values[result] := Value;
  inc(ValuesCount);
end;


type
  /// used internaly for faster quick sort
  {$ifdef FPC_OR_UNICODE}TQuickSortRawUTF8 = record{$else}TQuickSortRawUTF8 = object{$endif}
  public
    Values: PPointerArray;
    Compare: TUTF8Compare;
    CoValues: PIntegerArray;
    pivot: pointer;
    procedure Sort(L,R: PtrInt);
  end;

procedure TQuickSortRawUTF8.Sort(L, R: PtrInt);
var I, J, P: integer;
    Tmp: Pointer;
    TmpInt: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Values^[P];
      while Compare(Values^[I],pivot)<0 do Inc(I);
      while Compare(Values^[J],pivot)>0 do Dec(J);
      if I <= J then begin
        Tmp := Values^[J];
        Values^[J] := Values^[I];
        Values^[I] := Tmp;
        if CoValues<>nil then begin
          TmpInt := CoValues^[J];
          CoValues^[J] := CoValues^[I];
          CoValues^[I] := TmpInt;
        end;
        if P = I then P := J else if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        Sort(L, J);
      L := I;
    end else begin
      if I < R then
        Sort(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure QuickSortRawUTF8(var Values: TRawUTF8DynArray; ValuesCount: integer;
  CoValues: PIntegerDynArray=nil; Compare: TUTF8Compare=nil);
var QS: TQuickSortRawUTF8;
begin
  QS.Values := pointer(Values);
  if Assigned(Compare) then
    QS.Compare := Compare else
    QS.Compare := @StrComp;
  if CoValues=nil then
    QS.CoValues := nil else
    QS.CoValues := pointer(CoValues^);
  QS.Sort(0,ValuesCount-1);
end;

function DeleteRawUTF8(var Values: TRawUTF8DynArray; Index: integer): boolean;
var n: integer;
begin
  n := length(Values);
  if cardinal(Index)>=cardinal(n) then
    result := false else begin
    dec(n);
    Values[Index] := ''; // avoid GPF
    if n>Index then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(
        pointer(Values[Index+1]),pointer(Values[Index]),(n-Index)*SizeOf(pointer));
      PtrUInt(Values[n]) := 0; // avoid GPF
    end;
    SetLength(Values,n);
    result := true;
  end;
end;

function DeleteRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  Index: integer; CoValues: PIntegerDynArray=nil): boolean;
var n: integer;
begin
  n := ValuesCount;
  if cardinal(Index)>=cardinal(n) then
    result := false else begin
    dec(n);
    ValuesCount := n;
    Values[Index] := ''; // avoid GPF
    dec(n,Index);
    if n>0 then begin
      if CoValues<>nil then
        {$ifdef FPC}Move{$else}MoveFast{$endif}(
          CoValues^[Index+1],CoValues^[Index],n*SizeOf(Integer));
      {$ifdef FPC}Move{$else}MoveFast{$endif}(
        pointer(Values[Index+1]),pointer(Values[Index]),n*SizeOf(pointer));
      PtrUInt(Values[ValuesCount]) := 0; // avoid GPF
    end;
    result := true;
  end;
end;

function ToText(const aIntelCPUFeatures: TIntelCpuFeatures; const Sep: RawUTF8): RawUTF8;
var f: TIntelCpuFeature;
    List: PShortString;
    MaxValue: integer;
begin
  result := '';
  List := GetEnumInfo(TypeInfo(TIntelCpuFeature),MaxValue);
  if List<>nil then
    for f := low(f) to high(f) do begin
      if (f in aIntelCPUFeatures) and (List^[3]<>'_') then begin
        if result<>'' then
          result := result+Sep;
        result := result+RawUTF8(copy(List^,3,10));
      end;
      inc(PByte(List),ord(List^[0])+1); // next short string
    end;
end;

{$ifdef MSWINDOWS}

// wrapper around some low-level Windows-specific API

{$ifdef DELPHI6OROLDER}
function GetFileVersion(const FileName: TFileName): cardinal;
var Size, Size2: DWord;
    Pt: Pointer;
    Info: ^TVSFixedFileInfo;
    tmp: TFileName;
begin
  result := cardinal(-1);
  if FileName='' then
    exit;
  // GetFileVersionInfo modifies the filename parameter data while parsing
  // Copy the string const into a local variable to create a writeable copy
  SetString(tmp,PChar(FileName),length(FileName));
  Size := GetFileVersionInfoSize(pointer(tmp), Size2);
  if Size>0 then begin
    GetMem(Pt, Size);
    try
      GetFileVersionInfo(pointer(FileName), 0, Size, Pt);
      if VerQueryValue(Pt, '\', pointer(Info), Size2) then
        result := Info^.dwFileVersionMS;
    finally
      Freemem(Pt);
    end;
  end;
end;
{$endif DELPHI6OROLDER}

function WndProcMethod(Hwnd: HWND; Msg,wParam,lParam: integer): integer; stdcall;
var obj: TObject;
    dsp: TMessage;
begin
  {$ifdef CPU64}
  obj := pointer(GetWindowLongPtr(HWnd,GWLP_USERDATA));
  {$else}
  obj := pointer(GetWindowLong(HWnd,GWL_USERDATA)); // faster than GetProp()
  {$endif CPU64}
  if not Assigned(obj) then
    result := DefWindowProc(HWnd,Msg,wParam,lParam) else begin
    dsp.msg := Msg;
    dsp.wParam := WParam;
    dsp.lParam := lParam;
    dsp.result := 0;
    obj.Dispatch(dsp);
    result := dsp.result;
  end;
end;

function CreateInternalWindow(const aWindowName: string; aObject: TObject): HWND;
var TempClass: TWndClass;
begin
  result := 0;
  if GetClassInfo(HInstance, pointer(aWindowName), TempClass) then
    exit; // class name already registered -> fail
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(TempClass,SizeOf(TempClass),0);
  TempClass.hInstance := HInstance;
  TempClass.lpfnWndProc := @DefWindowProc;
  TempClass.lpszClassName :=  pointer(aWindowName);
  Windows.RegisterClass(TempClass);
  result := CreateWindowEx(WS_EX_TOOLWINDOW, pointer(aWindowName),
    '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if result=0 then
    exit; // impossible to create window -> fail
  {$ifdef CPU64}
  SetWindowLongPtr(result,GWLP_USERDATA,PtrInt(aObject));
  SetWindowLongPtr(result,GWLP_WNDPROC,PtrInt(@WndProcMethod));
  {$else}
  SetWindowLong(result,GWL_USERDATA,PtrInt(aObject)); // faster than SetProp()
  SetWindowLong(result,GWL_WNDPROC,PtrInt(@WndProcMethod));
  {$endif CPU64}
end;

function ReleaseInternalWindow(var aWindowName: string; var aWindow: HWND): boolean;
begin
  if (aWindow<>0) and (aWindowName<>'') then begin
    {$ifdef CPU64}
    SetWindowLongPtr(aWindow,GWLP_WNDPROC,PtrInt(@DefWindowProc));
    {$else}
    SetWindowLong(aWindow,GWL_WNDPROC,PtrInt(@DefWindowProc));
    {$endif CPU64}
    DestroyWindow(aWindow);
    Windows.UnregisterClass(pointer(aWindowName),HInstance);
    aWindow := 0;
    aWindowName := '';
    result := true;
  end else
    result := false;
end;

var
  LastAppUserModelID: string;

function SetAppUserModelID(const AppUserModelID: string): boolean;
var shell32: THandle;
    id: SynUnicode;
    SetCurrentProcessExplicitAppUserModelID: function(appID: PWidechar): HResult; stdcall;
begin
  if AppUserModelID=LastAppUserModelID then begin
    result := true;
    exit; // nothing to set
  end;
  result := false;
  shell32 := GetModuleHandle('shell32.dll');
  if shell32=0 then
    exit;
  SetCurrentProcessExplicitAppUserModelID := GetProcAddress(
    shell32,'SetCurrentProcessExplicitAppUserModelID');
  if not Assigned(SetCurrentProcessExplicitAppUserModelID) then
    exit; // API available since Windows Seven / Server 2008 R2
  id := StringToSynUnicode(AppUserModelID);
  if Pos('.',AppUserModelID)=0 then
    id := id+'.'+id; // at least CompanyName.ProductName
  if SetCurrentProcessExplicitAppUserModelID(pointer(id))<>S_OK then
    exit;
  result := true;
  LastAppUserModelID := AppUserModelID;
end;

{$endif MSWINDOWS}

{ TFileVersion }

constructor TFileVersion.Create(const aFileName: TFileName;
  aMajor,aMinor,aRelease,aBuild: integer);
var M,D: word;
{$ifdef MSWINDOWS}
    Size, Size2: DWord;
    Pt, StrPt, StrValPt: Pointer;
    LanguageInfo: RawUTF8;
    Info: ^TVSFixedFileInfo;
    FileTime: TFILETIME;
    SystemTime: TSYSTEMTIME;
    tmp: TFileName;
    function ReadResourceByName(const From: RawUTF8): RawUTF8;
    var sz: DWord;
    begin
      VerQueryValueA(Pt,PAnsiChar('\StringFileInfo\'+LanguageInfo+'\'+From),StrValPt,sz);
      if sz>0 then
        FastSetString(Result,StrValPt,sz)
    end;
{$else}
{$ifdef FPCUSEVERSIONINFO}
  VI: TVersionInfo;
  LanguageInfo: String;
  TI, I: Integer;
{$endif}
{$endif MSWINDOWS}
begin
  fFileName := aFileName;
  {$ifdef MSWINDOWS}
  if aFileName<>'' then begin
    // GetFileVersionInfo modifies the filename parameter data while parsing.
    // Copy the string const into a local variable to create a writeable copy.
    SetString(tmp,PChar(aFileName),length(aFileName));
    Size := GetFileVersionInfoSize(pointer(tmp), Size2);
    if Size>0 then begin
      GetMem(Pt, Size);
      try
        GetFileVersionInfo(pointer(aFileName), 0, Size, Pt);
        VerQueryValue(Pt, '\', pointer(Info), Size2);
        with Info^ do begin
          if Version32=0 then begin
            aMajor := dwFileVersionMS shr 16;
            aMinor := word(dwFileVersionMS);
            aRelease := dwFileVersionLS shr 16;
          end;
          aBuild := word(dwFileVersionLS);
          BuildYear := 2010;
          if (dwFileDateLS<>0) and (dwFileDateMS<>0) then begin
            FileTime.dwLowDateTime:= dwFileDateLS; // built date from version info
            FileTime.dwHighDateTime:= dwFileDateMS;
            FileTimeToSystemTime(FileTime, SystemTime);
            fBuildDateTime := EncodeDate(
              SystemTime.wYear,SystemTime.wMonth,SystemTime.wDay);
          end;
        end;
        VerQueryValue(Pt, '\VarFileInfo\Translation', StrPt, Size2);
        if Size2 >= 4 then begin
          LanguageInfo := BinToHexDisplay(PAnsiChar(StrPt), 2) + BinToHexDisplay(PAnsiChar(StrPt)+2, 2);
          CompanyName := ReadResourceByName('CompanyName');
          FileDescription := ReadResourceByName('FileDescription');
          FileVersion := ReadResourceByName('FileVersion');
          InternalName := ReadResourceByName('InternalName');
          LegalCopyright := ReadResourceByName('LegalCopyright');
          OriginalFilename := ReadResourceByName('OriginalFilename');
          ProductName := ReadResourceByName('ProductName');
          ProductVersion := ReadResourceByName('ProductVersion');
          Comments := ReadResourceByName('Comments');
        end
      finally
        Freemem(Pt);
      end;
    end;
  end;
  {$else MSWINDOWS}
  {$ifdef FPCUSEVERSIONINFO} // FPC 3.0+ if enabled in Synopse.inc / project options
  if aFileName<>'' then begin
    VI := TVersionInfo.Create;
    try
      if (aFileName<>ExeVersion.ProgramFileName) and (aFileName<>ParamStr(0)) then
        VI.Load(aFileName) else
        VI.Load(HInstance); // load info for currently running program
      aMajor := VI.FixedInfo.FileVersion[0];
      aMinor := VI.FixedInfo.FileVersion[1];
      aRelease := VI.FixedInfo.FileVersion[2];
      aBuild := VI.FixedInfo.FileVersion[3];
      //fBuildDateTime := TDateTime(VI.FixedInfo.FileDate); << need to find out how to convert this before uncommenting
      // detect translation.
      if VI.VarFileInfo.Count>0 then
        with VI.VarFileInfo.Items[0] do
          LanguageInfo := Format('%.4x%.4x',[language,codepage]);
      if LanguageInfo='' then begin
        // take first language
        Ti := 0;
        if VI.StringFileInfo.Count>0 then
          LanguageInfo := VI.StringFileInfo.Items[0].Name
      end else begin
        // look for index of language
        TI := VI.StringFileInfo.Count-1;
        while (TI>=0) and (CompareText(VI.StringFileInfo.Items[TI].Name,LanguageInfo)<>0) do
          dec(TI);
        if (TI < 0) then begin
          TI := 0; // revert to first translation
          LanguageInfo := VI.StringFileInfo.Items[TI].Name;
        end;
      end;
      with VI.StringFileInfo.Items[TI] do begin
        CompanyName := Values['CompanyName'];
        FileDescription := Values['FileDescription'];
        FileVersion := Values['FileVersion'];
        InternalName := Values['InternalName'];
        LegalCopyright := Values['LegalCopyright'];
        OriginalFilename := Values['OriginalFilename'];
        ProductName := Values['ProductName'];
        ProductVersion := Values['ProductVersion'];
        Comments := Values['Comments'];
      end;
    finally
      VI.Free;
    end;
  end;
  {$endif FPCUSEVERSIONINFO}
  {$endif MSWINDOWS}
  SetVersion(aMajor,aMinor,aRelease,aBuild);
  if fBuildDateTime=0 then  // get build date from file age
    fBuildDateTime := FileAgeToDateTime(aFileName);
  if fBuildDateTime<>0 then
    DecodeDate(fBuildDateTime,BuildYear,M,D);
end;

function TFileVersion.Version32: integer;
begin
  result := Major shl 16+Minor shl 8+Release;
end;

procedure TFileVersion.SetVersion(aMajor,aMinor,aRelease,aBuild: integer);
begin
  Major := aMajor;
  Minor := aMinor;
  Release := aRelease;
  Build := aBuild;
  Main := IntToString(Major)+'.'+IntToString(Minor);
  fDetailed := Main+ '.'+IntToString(Release)+'.'+IntToString(Build);
end;

function TFileVersion.BuildDateTimeString: string;
begin
  DateTimeToIso8601StringVar(fBuildDateTime,' ',result);
end;

function TFileVersion.DetailedOrVoid: string;
begin
  if (self=nil) or (fDetailed='0.0.0.0') then
    result := '' else
    result := fDetailed;
end;

function TFileVersion.VersionInfo: RawUTF8;
begin
  FormatUTF8('% % %',[ExtractFileName(fFileName),fDetailed,BuildDateTimeString],result);
end;

function TFileVersion.UserAgent: RawUTF8;
begin
  if self=nil then
    result := '' else
    FormatUTF8('%/%%',[GetFileNameWithoutExt(ExtractFileName(fFileName)),
      DetailedOrVoid,OS_INITIAL[OS_KIND]],result);
  {$ifdef MSWINDOWS}
  if OSVersion in WINDOWS_32 then
    result := result+'32';
  {$endif}
end;

class function TFileVersion.GetVersionInfo(const aFileName: TFileName): RawUTF8;
begin
  with Create(aFileName,0,0,0,0) do
  try
    result := VersionInfo;
  finally
    Free;
  end;
end;

procedure SetExecutableVersion(const aVersionText: RawUTF8);
var P: PUTF8Char;
    i: integer;
    ver: array[0..3] of integer;
begin
  P := pointer(aVersionText);
  for i := 0 to 3 do
    ver[i] := GetNextItemCardinal(P,'.');
  SetExecutableVersion(ver[0],ver[1],ver[2],ver[3]);
end;

procedure SetExecutableVersion(aMajor,aMinor,aRelease,aBuild: integer);
var {$ifdef MSWINDOWS}
    tmp: array[byte] of WideChar;
    tmpsize: cardinal;
    {$else}
    tmp: string;
    {$endif}
begin
  with ExeVersion do begin
    if Version=nil then begin
      {$ifdef MSWINDOWS}
      ProgramFileName := paramstr(0);
      {$else}
      ProgramFileName := GetModuleName(HInstance);
      if ProgramFileName='' then
        ProgramFileName := ExpandFileName(paramstr(0));
      {$endif}
      ProgramFilePath := ExtractFilePath(ProgramFileName);
      if IsLibrary then
        InstanceFileName := GetModuleName(HInstance) else
        InstanceFileName := ProgramFileName;
      ProgramName := StringToUTF8(GetFileNameWithoutExt(ExtractFileName(ProgramFileName)));
      {$ifdef MSWINDOWS}
      tmpsize := SizeOf(tmp);
      GetComputerNameW(tmp,tmpsize);
      RawUnicodeToUtf8(@tmp,StrLenW(tmp),Host);
      tmpsize := SizeOf(tmp);
      GetUserNameW(tmp,tmpsize);
      RawUnicodeToUtf8(@tmp,StrLenW(tmp),User);
      {$else}
      StringToUTF8(GetHostName,Host);
      if Host='' then
        StringToUTF8(GetEnvironmentVariable('HOSTNAME'),Host);
      tmp := GetEnvironmentVariable('LOGNAME'); // POSIX
      if tmp='' then
        tmp := GetEnvironmentVariable('USER');
      {$ifdef KYLIX3}
      if tmp='' then
        User := LibC.getpwuid(LibC.getuid)^.pw_name else
      {$endif}
        StringToUTF8(tmp,User);
      {$endif}
      if Host='' then
        Host := 'unknown';
      if User='' then
        User := 'unknown';
      GarbageCollectorFreeAndNil(Version,
        TFileVersion.Create(InstanceFileName,aMajor,aMinor,aRelease,aBuild));
    end else
      Version.SetVersion(aMajor,aMinor,aRelease,aBuild);
    FormatUTF8('% % (%)',[ProgramFileName,Version.Detailed,
      DateTimeToIso8601(Version.BuildDateTime,True,' ')],ProgramFullSpec);
    Hash.c0 := Version.Version32;
    {$ifdef CPUINTEL}
    Hash.c0 := crc32c(Hash.c0,@CpuFeatures,SizeOf(CpuFeatures));
    {$endif}
    Hash.c0 := crc32c(Hash.c0,pointer(Host),length(Host));
    Hash.c1 := crc32c(Hash.c0,pointer(User),length(User));
    Hash.c2 := crc32c(Hash.c1,pointer(ProgramFullSpec),length(ProgramFullSpec));
    Hash.c3 := crc32c(Hash.c2,pointer(InstanceFileName),length(InstanceFileName));
  end;
end;

{$ifdef MSWINDOWS}
// avoid unneeded reference to ShlObj.pas
function SHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle;
  dwFlags: DWord; pszPath: PChar): HRESULT; stdcall; external 'SHFolder.dll'
  name {$ifdef UNICODE}'SHGetFolderPathW'{$else}'SHGetFolderPathA'{$endif};

var
  _SystemPath: array[TSystemPath] of TFileName;

function GetSystemPath(kind: TSystemPath): TFileName;
const
  CSIDL_PERSONAL = $0005;
  CSIDL_LOCAL_APPDATA = $001C; // local non roaming user folder
  CSIDL_COMMON_APPDATA = $0023;
  CSIDL_COMMON_DOCUMENTS = $002E;
  CSIDL: array[TSystemPath] of integer = (
    // spCommonData,       spUserData,          spCommonDocuments
    CSIDL_COMMON_APPDATA, CSIDL_LOCAL_APPDATA, CSIDL_COMMON_DOCUMENTS,
    // spUserDocuments, spTempFolder, spLog
    CSIDL_PERSONAL, 0, CSIDL_LOCAL_APPDATA);
  ENV: array[TSystemPath] of TFileName = (
    'ALLUSERSAPPDATA', 'LOCALAPPDATA', '', '', 'TEMP', 'LOCALAPPDATA');
var tmp: array[0..MAX_PATH] of char;
    k: TSystemPath;
begin
  if _SystemPath[spCommonData]='' then
    for k := low(k) to high(k) do
      if (k=spLog) and IsDirectoryWritable(ExeVersion.ProgramFilePath) then
        _SystemPath[k] := EnsureDirectoryExists(ExeVersion.ProgramFilePath+'log') else
      if (CSIDL[k]<>0) and (SHGetFolderPath(0,CSIDL[k],0,0,@tmp)=S_OK) then
        _SystemPath[k] := IncludeTrailingPathDelimiter(tmp) else begin
        _SystemPath[k] := GetEnvironmentVariable(ENV[k]);
        if _SystemPath[k]='' then
          _SystemPath[k] := GetEnvironmentVariable('APPDATA');
        _SystemPath[k] := IncludeTrailingPathDelimiter(_SystemPath[k]);
      end;
  result := _SystemPath[kind];
end;
{$else MSWINDOWS}
var
  _HomePath, _TempPath, _UserPath, _LogPath: TFileName;

function GetSystemPath(kind: TSystemPath): TFileName;
begin
  case kind of
  spLog: begin
    if _LogPath='' then
      if IsDirectoryWritable('/var/log') then
        _LogPath := '/var/log/' else // may not be writable by not root on POSIX
        if IsDirectoryWritable(ExeVersion.ProgramFilePath) then
          _LogPath := ExeVersion.ProgramFilePath else
          _LogPath := GetSystemPath(spUserData);
    result := _LogPath;
  end;
  spUserData: begin
    if _UserPath='' then begin //  ~/.cache/appname
      _UserPath := GetEnvironmentVariable('XDG_CACHE_HOME');
      if (_UserPath='') or not IsDirectoryWritable(_UserPath) then
        _UserPath := EnsureDirectoryExists(GetSystemPath(spUserDocuments)+'.cache');
      _UserPath := EnsureDirectoryExists(_UserPath+UTF8ToString(ExeVersion.ProgramName));
    end;
    result := _UserPath;
  end;
  spTempFolder: begin
    if _TempPath='' then begin
      _TempPath := GetEnvironmentVariable('TMPDIR'); // POSIX
      if _TempPath='' then
        _TempPath := GetEnvironmentVariable('TMP');
      if _TempPath='' then
        if DirectoryExists('/tmp') then
          _TempPath := '/tmp' else
          _TempPath := '/var/tmp';
      _TempPath := IncludeTrailingPathDelimiter(_TempPath);
    end;
    result := _TempPath;
  end else begin
    if _HomePath='' then // POSIX requires a value for $HOME
      _HomePath := IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME'));
    result := _HomePath;
  end;
  end;
end;
{$endif MSWINDOWS}

{$ifdef BSD}
function mprotect(Addr: Pointer; Len: size_t; Prot: Integer): Integer;
  {$ifdef Darwin} cdecl external 'libc.dylib' name 'mprotect';
  {$else} cdecl external 'libc.so' name 'mprotect'; {$endif}
  {$define USEMPROTECT}
{$endif}
{$ifdef KYLIX3}
  {$define USEMPROTECT}
{$endif}

procedure PatchCode(Old,New: pointer; Size: integer; Backup: pointer=nil;
  LeaveUnprotected: boolean=false);
{$ifdef MSWINDOWS}
var RestoreProtection, Ignore: DWORD;
    i: integer;
begin
  if VirtualProtect(Old, Size, PAGE_EXECUTE_READWRITE, RestoreProtection) then
  begin
    if Backup<>nil then
      for i := 0 to Size-1 do  // do not use Move() here
        PByteArray(Backup)^[i] := PByteArray(Old)^[i];
    for i := 0 to Size-1 do    // do not use Move() here
      PByteArray(Old)^[i] := PByteArray(New)^[i];
    if not LeaveUnprotected then
      VirtualProtect(Old, Size, RestoreProtection, Ignore);
    FlushInstructionCache(GetCurrentProcess, Old, Size);
    if not CompareMemFixed(Old,New,Size) then
      raise ESynException.Create('PatchCode?');
  end;
end;
{$else}
var PageSize, AlignedAddr: PtrUInt;
    i: integer;
begin
  if Backup<>nil then
    for i := 0 to Size-1 do // do not use Move() here
      PByteArray(Backup)^[i] := PByteArray(Old)^[i];
  PageSize := SystemInfo.dwPageSize;
  AlignedAddr := PtrUInt(Old) and not (PageSize-1);
  while PtrUInt(Old)+PtrUInt(Size)>=AlignedAddr+PageSize do
    Inc(PageSize,SystemInfo.dwPageSize);
  {$ifdef USEMPROTECT}
  if mprotect(Pointer(AlignedAddr),PageSize,PROT_READ or PROT_WRITE or PROT_EXEC)=0 then
  {$else}
  Do_SysCall(syscall_nr_mprotect,PtrUInt(AlignedAddr),PageSize,PROT_READ or PROT_WRITE or PROT_EXEC);
  {$endif}
    try
      for i := 0 to Size-1 do // do not use Move() here
        PByteArray(Old)^[i] := PByteArray(New)^[i];
    except
    end;
end;
{$endif}

procedure PatchCodePtrUInt(Code: PPtrUInt; Value: PtrUInt;
  LeaveUnprotected: boolean=false);
begin
  PatchCode(Code,@Value,SizeOf(Code^),nil,LeaveUnprotected);
end;

{$ifdef CPUINTEL}

procedure RedirectCode(Func, RedirectFunc: Pointer; Backup: PPatchCode=nil);
var NewJump: packed record
    Code: byte;        // $e9 = jmp {relative}
    Distance: integer; // relative jump is 32-bit even on CPU64
  end;
begin
  if (Func=nil) or (RedirectFunc=nil) then
    exit; // nothing to redirect to
  assert(SizeOf(TPatchCode)=SizeOf(NewJump));
  NewJump.Code := $e9;
  NewJump.Distance := integer(PtrUInt(RedirectFunc)-PtrUInt(Func)-SizeOf(NewJump));
  PatchCode(Func,@NewJump,SizeOf(NewJump),Backup);
  {$ifndef LVCL}
  assert(pByte(Func)^=$e9);
  {$endif}
end;

procedure RedirectCodeRestore(Func: pointer; const Backup: TPatchCode);
begin
  PatchCode(Func,@Backup,SizeOf(TPatchCode));
end;

{$endif CPUINTEL}

{$ifndef LVCL}
{$ifndef FPC}
{$ifdef MSWINDOWS}

const
  MemoryDelta = $8000; // 32 KB granularity (must be a power of 2)

function THeapMemoryStream.Realloc(var NewCapacity: longint): Pointer;
// allocates memory from Delphi heap (FastMM4/SynScaleMM) and not windows.Global*()
// and uses bigger growing size -> a lot faster
var i: PtrInt;
begin
  if NewCapacity>0 then begin
    i := Seek(0,soFromCurrent); // no direct access to fSize -> use Seek() trick
    if NewCapacity=Seek(0,soFromEnd) then begin // avoid ReallocMem() if just truncate
      result := Memory;
      Seek(i,soBeginning);
      exit;
    end;
    NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
    Seek(i,soBeginning);
  end;
  Result := Memory;
  if NewCapacity <> Capacity then begin
    if NewCapacity = 0 then begin
      FreeMem(Memory);
      Result := nil;
    end else begin
      if Capacity = 0 then
        GetMem(Result, NewCapacity) else
        if NewCapacity > Capacity then // only realloc if necessary (grow up)
          ReallocMem(Result, NewCapacity) else
          NewCapacity := Capacity; // same capacity as before
      if Result = nil then
        raise EStreamError.Create('THeapMemoryStream'); // memory allocation bug
    end;
  end;
end;

{$endif MSWINDOWS}
{$endif FPC}
{$endif LVCL}


{ TSortedWordArray }

function FastLocateWordSorted(P: PWordArray; R: integer; Value: word): PtrInt;
var L,cmp: PtrInt;
begin
  if R<0 then
    result := 0 else begin
    L := 0;
    repeat
      result := (L + R) shr 1;
      cmp := P^[result]-Value;
      if cmp=0 then begin
        result := -result-1; // return -(foundindex+1) if already exists
        exit;
      end;
      if cmp<0 then
        L := result + 1 else
        R := result - 1;
    until (L > R);
    while (result>=0) and (P^[result]>=Value) do dec(result);
    result := result+1; // return the index where to insert
  end;
end;

function FastFindWordSorted(P: PWordArray; R: PtrInt; Value: Word): PtrInt;
var L: PtrInt;
    cmp: integer;
begin
  L := 0;
  if 0<=R then
    repeat
      result := (L + R) shr 1;
      cmp := P^[result]-Value;
      if cmp=0 then
        exit;
      if cmp<0 then begin
        L := result+1;
        if L<=R then
          continue;
        break;
      end;
      R := result-1;
      if L<=R  then
        continue;
      break;
    until false;
  result := -1
end;

function TSortedWordArray.Add(aValue: Word): PtrInt;
begin
  result := FastLocateWordSorted(pointer(Values),Count-1,aValue);
  if result<0 then // aValue already exists in Values[] -> fails
    exit;
  if Count=length(Values) then
    SetLength(Values,Count+100);
  if result<Count then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      Values[result],Values[result+1],(Count-result)*2) else
    result := Count;
  Values[result] := aValue;
  inc(Count);
end;

function TSortedWordArray.IndexOf(aValue: Word): PtrInt;
begin
  result := FastFindWordSorted(pointer(Values),Count-1,aValue);
end;

procedure QuickSortCompare(const OnCompare: TOnValueGreater;
  Index: PIntegerArray; L,R: PtrInt);
var I, J, P: PtrInt;
    pivot, tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Index[P];
      while OnCompare(pivot,Index[I]) do inc(I);
      while OnCompare(Index[J],pivot) do dec(J);
      if I <= J then begin
        tmp := Index[J]; Index[J] := Index[I]; Index[I] := tmp;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortCompare(OnCompare, Index, L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortCompare(OnCompare, Index, I, R);
      R := J;
    end;
  until L >= R;
end;

procedure Exchg32(var A,B: integer); {$ifdef HASINLINE}inline;{$endif}
var tmp: integer;
begin
  tmp := A;
  A := B;
  B := tmp;
end;

function MedianQuickSelectInteger(Values: PIntegerArray; n: integer): integer;
var low, high, median, middle, ll, hh: PtrInt;
begin
  if n=0 then begin
    result := 0;
    exit;
  end;
  if n=1 then begin
    result := Values[0];
    exit;
  end;
  low := 0;
  high := n-1;
  median := high shr 1;
  repeat
    if high<=low then begin // one item left
      result := Values[median];
      exit;
    end;
    if high=low+1 then begin // two items -> return the smallest (not average)
      if Values[low]>Values[high] then
        Exchg32(Values[low],Values[high]);
      result := Values[median];
      exit;
    end;
    // find median of low, middle and high items; swap into position low
    middle := (low+high) shr 1;
    if Values[middle]>Values[high] then
      Exchg32(Values[middle],Values[high]);
    if Values[low]>Values[high] then
      Exchg32(Values[low],Values[high]);
    if Values[middle]>Values[low] then
      Exchg32(Values[middle],Values[low]);
    // swap low item (now in position middle) into position (low+1)
    Exchg32(Values[middle],Values[low+1]);
    // nibble from each end towards middle, swapping items when stuck
    ll := low+1;
    hh := high;
    repeat
      repeat
        inc(ll);
      until not (Values[low]>Values[ll]);
      repeat
        dec(hh);
      until not (Values[hh]>Values[low]);
      if hh<ll then
        break;
      Exchg32(Values[ll],Values[hh]);
    until false;
    // swap middle item (in position low) back into correct position
    Exchg32(Values[low],Values[hh]);
    // next active partition
    if hh<=median then
      low := ll;
    if hh>=median then
      high := hh-1;
  until false;
end;

function MedianQuickSelect(const OnCompare: TOnValueGreater; n: integer;
  var TempBuffer: TSynTempBuffer): integer;
var low, high, middle, median, ll, hh: PtrInt;
    tmp: integer;
    ndx: PIntegerArray;
begin
  if n<=1 then begin
    TempBuffer.buf := nil; // avoid GPF in TempBuffer.Done
    result := 0;
    exit;
  end;
  low := 0;
  high := n-1;
  ndx := TempBuffer.InitIncreasing(n*4); // no heap alloacation until n>1024
  median := high shr 1;
  repeat
    if high<=low then begin // one item left
      result := ndx[median];
      TempBuffer.Done;
      exit;
    end;
    if high=low+1 then begin // two items -> return the smallest (not average)
      if OnCompare(ndx[low],ndx[high]) then
        Exchg32(ndx[low],ndx[high]);
      result := ndx[median];
      TempBuffer.Done;
      exit;
    end;
    // find median of low, middle and high items; swap into position low
    middle := (low+high) shr 1;
    if OnCompare(ndx[middle],ndx[high]) then
      Exchg32(ndx[middle],ndx[high]);
    if OnCompare(ndx[low],ndx[high]) then
      Exchg32(ndx[low],ndx[high]);
    if OnCompare(ndx[middle],ndx[low]) then
      Exchg32(ndx[middle],ndx[low]);
    // swap low item (now in position middle) into position (low+1)
    Exchg32(ndx[middle],ndx[low+1]);
    // nibble from each end towards middle, swapping items when stuck
    ll := low+1;
    hh := high;
    repeat
      tmp := ndx[low];
      repeat
        inc(ll);
      until not OnCompare(tmp,ndx[ll]);
      repeat
        dec(hh);
      until not OnCompare(ndx[hh],tmp);
      if hh<ll then
        break;
      tmp := ndx[ll]; ndx[ll] := ndx[hh]; ndx[hh] := tmp; // Exchg32(ndx[ll],ndx[hh]);
    until false;
    // swap middle item (in position low) back into correct position
    Exchg32(ndx[low],ndx[hh]);
    // next active partition
    if hh<=median then
      low := ll;
    if hh>=median then
      high := hh-1;
  until false;
end;

function gcd(a, b: cardinal): cardinal;
begin
  while a <> b do
    if a > b then
      dec(a, b) else
      dec(b, a);
  result := a;
end;

function ToVarUInt32Length(Value: PtrUInt): PtrUInt;
begin
  if Value<=$7f then
    result := 1 else
  if Value<$80 shl 7 then
    result := 2 else
  if Value<$80 shl 14 then
    result := 3 else
  if Value <$80 shl 21 then
    result := 4 else
    result := 5;
end;

function ToVarUInt32LengthWithData(Value: PtrUInt): PtrUInt;
begin
  if Value<=$7f then
    result := Value+1 else
  if Value<$80 shl 7 then
    result := Value+2 else
  if Value<$80 shl 14 then
    result := Value+3 else
  if Value<$80 shl 21 then
    result := Value+4 else
    result := Value+5;
end;

{$ifdef HASINLINE}
function FromVarUInt32(var Source: PByte): cardinal;
begin
  result := Source^;
  inc(Source);
  if result>$7f then
    result := (result and $7F) or FromVarUInt32Up128(Source);
end;

function FromVarUInt32Big(var Source: PByte): cardinal;
{$else}
function FromVarUInt32Big(var Source: PByte): cardinal;
asm
     jmp    FromVarUInt32
end;

function FromVarUInt32(var Source: PByte): cardinal;
{$endif}
var c: cardinal;
    p: PByte;
begin
  p := Source;
  result := p^;
  inc(p);
  if result>$7f then begin
    c := p^;
    c := c shl 7;
    result := result and $7F or c;
    inc(p);
    if c>$7f shl 7 then begin // Values between 128 and 16256
      c := p^;
      c := c shl 14;
      inc(p);
      result := result and $3FFF or c;
      if c>$7f shl 14 then begin // Values between 16257 and 2080768
        c := p^;
        c := c shl 21;
        inc(p);
        result := result and $1FFFFF or c;
        if c>$7f shl 21 then begin // Values between 2080769 and 266338304
          c := p^;
          c := c shl 28;
          inc(p);
          result := result and $FFFFFFF or c;
        end;
      end;
    end;
  end;
  Source := p;
end;

function FromVarUInt32Up128(var Source: PByte): cardinal;
var c: cardinal;
    p: PByte;
begin
  p := Source;
  result := p^ shl 7;
  inc(p);
  if result>$7f shl 7 then begin // Values between 128 and 16256
    c := p^;
    c := c shl 14;
    inc(p);
    result := result and $3FFF or c;
    if c>$7f shl 14 then begin // Values between 16257 and 2080768
      c := p^;
      c := c shl 21;
      inc(p);
      result := result and $1FFFFF or c;
      if c>$7f shl 21 then begin // Values between 2080769 and 266338304
        c := p^;
        c := c shl 28;
        inc(p);
        result := result and $FFFFFFF or c;
      end;
    end;
  end;
  Source := p;
end;

function FromVarInt32(var Source: PByte): integer;
var c: cardinal;
    p: PByte;
begin // faster as stand-alone function with inlined FromVarUInt32
  p := Source;
  result := p^;
  inc(p);
  if result>$7f then begin
    c := p^;
    c := c shl 7;
    result := result and $7F or integer(c);
    inc(p);
    if c>$7f shl 7 then begin // Values between 128 and 16256
      c := p^;
      c := c shl 14;
      inc(p);
      result := result and $3FFF or integer(c);
      if c>$7f shl 14 then begin // Values between 16257 and 2080768
        c := p^;
        c := c shl 21;
        inc(p);
        result := result and $1FFFFF or integer(c);
        if c>$7f shl 21 then begin // Values between 2080769 and 266338304
          c := p^;
          c := c shl 28;
          inc(p);
          result := result and $FFFFFFF or integer(c);
        end;
      end;
    end;
  end;
  Source := p;
  // 0=0,1=1,2=-1,3=2,4=-2...
  if result and 1<>0 then
    // 1->1, 3->2..
    result := result shr 1+1 else
    // 0->0, 2->-1, 4->-2..
    result := -(result shr 1);
end;

function FromVarUInt32High(var Source: PByte): cardinal;
var c: cardinal;
begin
  result := Source^;
  inc(Source);
  c := Source^ shl 7;
  inc(Source);
  result := result and $7F or c;
  if c<=$7f shl 7 then
    exit; // Values between 128 and 16256
  c := Source^ shl 14;
  inc(Source);
  result := result and $3FFF or c;
  if c<=$7f shl 14 then
    exit; // Values between 16257 and 2080768
  c := Source^ shl 21;
  inc(Source);
  result := result and $1FFFFF or c;
  if c<=$7f shl 21 then
    exit; // Values between 2080769 and 266338304
  c := Source^ shl 28;
  inc(Source);
  result := result and $FFFFFFF or c;
end;

function ToVarInt64(Value: Int64; Dest: PByte): PByte;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  {$ifdef CPU32}
  if Value<=0 then
    // 0->0, -1->2, -2->4..
    result := ToVarUInt64((-Value) shl 1,Dest) else
    // 1->1, 2->3..
    result := ToVarUInt64((Value shl 1)-1,Dest);
  {$else}
  if Value<=0 then
    // 0->0, -1->2, -2->4..
    Value := (-Value) shl 1 else
    // 1->1, 2->3..
    Value := (Value shl 1)-1;
  result := ToVarUInt64(Value,Dest);
  {$endif}
end;

function ToVarUInt64(Value: QWord; Dest: PByte): PByte;
label _1,_2,_3; // ugly but fast
var c: cardinal;
begin
  c := Value;
  if {$ifdef CPU32}PInt64Rec(@Value)^.Hi=0{$else}Value shr 32=0{$endif} then begin
    if c>$7f then begin // inlined result := ToVarUInt32(Value,Dest);
      if c<$80 shl 7 then goto _1 else
        if c<$80 shl 14 then goto _2 else
          if c<$80 shl 21 then goto _3;
      Dest^ := (c and $7F) or $80;
      c := c shr 7;
      inc(Dest);
  _3: Dest^ := (c and $7F) or $80;
      c := c shr 7;
      inc(Dest);
  _2: Dest^ := (c and $7F) or $80;
      c := c shr 7;
      inc(Dest);
  _1: Dest^ := (c and $7F) or $80;
      c := c shr 7;
      inc(Dest);
    end;
    Dest^ := c;
    inc(Dest);
    result := Dest;
    exit;
  end;
  PCardinal(Dest)^ := (c and $7F) or (((c shr 7)and $7F)shl 8) or
    (((c shr 14)and $7F)shl 16) or (((c shr 21)and $7F)shl 24) or $80808080;
  Value := Value shr 28;
  inc(Dest,4);
  repeat
    Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
  until Value<=$7f;
  Dest^ := Value;
  inc(Dest);
  result := Dest;
end;

function FromVarUInt64(var Source: PByte): QWord;
var c,n: PtrUInt;
    p: PByte;
begin
  p := Source;
  {$ifdef CPU64}
  result := p^;
  if result>$7f then begin
    result := result and $7F;
  {$else}
  if p^>$7f then begin
    result := PtrUInt(p^) and $7F;
  {$endif}
    n := 0;
    inc(p);
    repeat
      c := p^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (QWord(c and $7f) shl n);
      inc(p);
    until false;
    result := result or (QWord(c) shl n);
  end{$ifndef CPU64} else
    result := p^{$endif};
  inc(p);
  Source := p;
end;

function FromVarInt64(var Source: PByte): Int64;
var c,n: PtrUInt;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  {$ifdef CPU64}
  result := Source^;
  if result>$7f then begin
    result := result and $7F;
    n := 0;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (Int64(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (Int64(c) shl n);
  end;
  if result and 1<>0 then
    // 1->1, 3->2..
    result := result shr 1+1 else
    // 0->0, 2->-1, 4->-2..
    result := -(result shr 1);
  {$else}
  c := Source^;
  if c>$7f then begin
    result := c and $7F;
    n := 0;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (Int64(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (Int64(c) shl n);
    if PCardinal(@result)^ and 1<>0 then
      // 1->1, 3->2..
      result := result shr 1+1 else
      // 0->0, 2->-1, 4->-2..
      result := -(result shr 1);
  end else begin
    if c=0 then
      result := 0 else
    if c and 1=0 then
      // 0->0, 2->-1, 4->-2..
      result := -Int64(c shr 1) else
      // 1->1, 3->2..
      result := (c shr 1)+1;
  end;
  {$endif}
  inc(Source);
end;

function FromVarInt64Value(Source: PByte): Int64;
{$ifdef DELPHI5OROLDER}
begin // try to circumvent Internal Error C1093 on Delphi 5 :(
  result := FromVarInt64(Source);
end;
{$else}
var c,n: PtrUInt;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  c := Source^;
  if c>$7f then begin
    result := c and $7F;
    n := 0;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (Int64(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (Int64(c) shl n);
    if {$ifdef CPU64}result{$else}PCardinal(@result)^{$endif} and 1<>0 then
      // 1->1, 3->2..
      result := result shr 1+1 else
      // 0->0, 2->-1, 4->-2..
      result := -Int64(result shr 1);
  end else
    if c=0 then
      result := 0 else
      if c and 1=0 then
        // 0->0, 2->-1, 4->-2..
        result := -Int64(c shr 1) else
        // 1->1, 3->2..
        result := (c shr 1)+1;
end;
{$endif DELPHI5OROLDER}

function GotoNextVarInt(Source: PByte): pointer;
begin
  if Source<>nil then begin
    if Source^>$7f then
      repeat
        inc(Source)
      until Source^<=$7f;
    inc(Source);
  end;
  result := Source;
end;

function ToVarString(const Value: RawUTF8; Dest: PByte): PByte;
var Len: integer;
begin
  Len := Length(Value);
  Dest := ToVarUInt32(Len,Dest);
  if Len>0 then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Value)^,Dest^,Len);
    result := pointer(PAnsiChar(Dest)+Len);
  end else
    result := Dest;
end;

function GotoNextVarString(Source: PByte): pointer;
begin
  result := Pointer(PtrUInt(Source)+FromVarUInt32(Source));
end;

function FromVarString(var Source: PByte): RawUTF8;
var Len: PtrUInt;
begin
  Len := FromVarUInt32(Source);
  FastSetStringCP(Result,Source,Len,CP_UTF8);
  inc(Source,Len);
end;

procedure FromVarString(var Source: PByte; var Value: TSynTempBuffer);
var len: integer;
begin
  len := FromVarUInt32(Source);
  Value.Init(Source,len);
  PByteArray(Value.buf)[len] := 0; // include trailing #0
  inc(Source,len);
end;

procedure FromVarString(var Source: PByte; var Value: RawByteString; CodePage: integer);
var Len: PtrUInt;
begin
  Len := FromVarUInt32(Source);
  FastSetStringCP(Value,Source,Len,CodePage);
  inc(Source,Len);
end;

function FromVarBlob(Data: PByte): TValueResult;
begin
  Result.Len := FromVarUInt32(Data);
  Result.Ptr := pointer(Data);
end;


{ ************ low-level RTTI types and conversion routines }

{$ifdef FPC}

{$ifdef FPC_OLDRTTI}
function OldRTTIFirstManagedField(info: PTypeInfo): PFieldInfo;
var fieldtype: PTypeInfo;
    i: integer;
begin
  result := @info^.ManagedFields[0];
  for i := 1 to info^.ManagedCount do begin
    fieldtype := DeRef(result^.TypeInfo);
    if (fieldtype<>nil) and (fieldtype^.Kind in tkManagedTypes) then
      exit;
    inc(result);
  end;
  result := nil;
end;

function OldRTTIManagedSize(typeInfo: Pointer): SizeInt; inline;
begin
  case PTypeKind(typeInfo)^ of // match tkManagedTypes
    tkLString,tkLStringOld,tkWString,tkUString, tkInterface,tkDynarray:
      result := SizeOf(Pointer);
    {$ifndef NOVARIANTS}
    tkVariant: result := SizeOf(TVarData);
    {$endif}
    tkArray: with GetTypeInfo(typeInfo)^ do
      result := arraySize{$ifdef VER2_6}*elCount{$endif};
    tkObject,tkRecord: result := GetTypeInfo(typeInfo)^.recSize;
    else raise ESynException.CreateUTF8('OldRTTIManagedSize unhandled % (%)',
        [ToText(PTypeKind(typeInfo)^)^,PByte(typeInfo)^]);
  end;
end;

procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
begin // external name 'FPC_COPY' does not work as we need
  FPCFinalize(@Dest,TypeInfo);
  Move(Source,Dest,OldRTTIManagedSize(TypeInfo));
  FPCRecordAddRef(Dest,TypeInfo);
end;
{$else}
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
begin
  FPCRecordCopy(Source,Dest,TypeInfo);
end;
{$endif FPC_OLDRTTI}

procedure RecordClear(var Dest; TypeInfo: pointer);
begin
  FPCFinalize(@Dest,TypeInfo);
end;

{$else FPC}

procedure CopyArray(dest, source, typeInfo: Pointer; cnt: PtrUInt);
asm
{$ifdef CPU64}
        .NOFRAME
        jmp     System.@CopyArray
{$else} push    dword ptr[EBP + 8]
        call    System.@CopyArray // RTL is fast enough for this
{$endif}
end;

procedure _DynArrayClear(var a: Pointer; typeInfo: Pointer);
asm
  {$ifdef CPU64}
  .NOFRAME
  {$endif}
  jmp System.@DynArrayClear
end;

procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: PtrUInt);
asm
  {$ifdef CPU64}
  .NOFRAME
  {$endif}
  jmp System.@FinalizeArray
end;

procedure _Finalize(Data: Pointer; TypeInfo: Pointer);
asm
{$ifdef CPU64}
        .NOFRAME
        mov     r8, 1 // rcx=p rdx=typeInfo r8=ElemCount
        jmp     System.@FinalizeArray
{$else} // much faster than FinalizeArray(Data,TypeInfo,1)
        movzx   ecx, byte ptr[edx]  // eax=ptr edx=typeinfo ecx=datatype
        sub     cl, tkLString
        {$ifdef UNICODE}
        cmp     cl, tkUString - tkLString + 1
        {$else}
        cmp     cl, tkDynArray - tkLString + 1
        {$endif}
        jnb     @@err
        jmp     dword ptr[@@Tab + ecx * 4]
        nop
        nop // for @@Tab alignment
@@Tab:  dd      System.@LStrClr
{$IFDEF LINUX} // under Linux, WideString are refcounted as AnsiString
        dd      System.@LStrClr
{$else} dd      System.@WStrClr
{$endif LINUX}
{$ifdef LVCL}
        dd      @@err
{$else} dd      System.@VarClr
{$endif LVCL}
        dd      @@ARRAY
        dd      RecordClear
        dd      System.@IntfClear
        dd      @@err
        dd      System.@DynArrayClear
        {$ifdef UNICODE}
        dd      System.@UStrClr
        {$endif}
@@err:  mov     al, reInvalidPtr
        {$ifdef DELPHI5OROLDER}
        jmp     System.@RunError
        {$else}
        jmp     System.Error
        {$endif}
@@array:movzx   ecx, [edx].TTypeInfo.NameLen
        add     ecx, edx
        mov     edx, dword ptr[ecx].TTypeInfo.ManagedFields[0] // Fields[0].TypeInfo^
        mov     ecx, [ecx].TTypeInfo.ManagedCount
        mov     edx, [edx]
        jmp     System.@FinalizeArray
{$endif CPU64}
end;
{$endif FPC}

function ArrayItemType(var info: PTypeInfo; out len: integer): PTypeInfo;
  {$ifdef HASINLINE}inline;{$endif}
begin
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} // inlined info := GetTypeInfo(info)
  info := GetFPCAlignPtr(info);
  {$else}
  info := @PAnsiChar(info)[info^.NameLen];
  {$endif}
  result := nil;
  if (info=nil) or (info^.dimCount<>1) then begin
    len := 0;
    info := nil; // supports single dimension static array only
  end else begin
    len := info^.arraySize{$ifdef VER2_6}*info^.elCount{$endif};
    {$ifdef HASDIRECTTYPEINFO} // inlined result := DeRef(info^.arrayType)
    result := info^.arrayType;
    {$else}
    if info^.arrayType=nil then
      exit;
    result := info^.arrayType^;
    {$endif}
    {$ifdef FPC}
    if (result<>nil) and not(result^.Kind in tkManagedTypes) then
      result := nil; // as with Delphi
    {$endif}
  end;
end;

function ManagedTypeCompare(A,B: PAnsiChar; info: PTypeInfo): integer;
// returns -1 if info was not handled, 0 if A^<>B^, or SizeOf(A^) if A^=B^
var i,arraysize: integer;
    itemtype: PTypeInfo;
    {$ifndef DELPHI5OROLDER} // do not know why this compiler does not like it
    DynA, DynB: TDynArray;
    {$endif}
begin // info is expected to come from a DeRef() if retrieved from RTTI
  result := 0; // A^<>B^
  case info^.Kind of // should match tkManagedTypes
  tkLString{$ifdef FPC},tkLStringOld{$endif}:
    if PAnsiString(A)^=PAnsiString(B)^ then
      result := SizeOf(pointer);
  tkWString:
    if PWideString(A)^=PWideString(B)^ then
      result := SizeOf(pointer);
  {$ifdef HASVARUSTRING}
  tkUString:
    if PUnicodeString(A)^=PUnicodeString(B)^ then
      result := SizeOf(pointer);
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    if not RecordEquals(A^,B^,info,@result) then
      result := 0; // A^<>B^
  {$ifndef NOVARIANTS}
  tkVariant: // slightly more optimized than PVariant(A)^=PVariant(B)^
    if SortDynArrayVariantComp(PVarData(A)^,PVarData(B)^,false)=0 then
      result := SizeOf(variant);
  {$endif}
  {$ifndef DELPHI5OROLDER}
  tkDynArray: begin
    DynA.Init(info,A^);
    DynB.Init(info,B^);
    if DynA.Equals(DynB) then
      result := SizeOf(pointer);
  end;
  {$endif}
  tkInterface:
    if PPointer(A)^=PPointer(B)^ then
      result := SizeOf(pointer);
  tkArray: begin
    itemtype := ArrayItemType(info,arraysize);
    if info=nil then
      result := -1 else
      if itemtype=nil then
        if CompareMemFixed(A,B,arraysize) then
          result := arraysize else
          result := 0 else begin
        for i := 1 to info^.elCount do begin // only compare managed fields
          result := ManagedTypeCompare(A,B,itemtype);
          if result<=0 then
            exit; // invalid (-1) or not equals (0)
          inc(A,result);
          inc(B,result);
        end;
        result := arraysize;
      end;
  end;
  else
    result := -1; // Unhandled field
  end;
end;

function ManagedTypeSaveLength(data: PAnsiChar; info: PTypeInfo;
  out len: integer): integer;
// returns 0 on error, or saved bytes + len=data^ length
var DynArray: TDynArray;
    itemtype: PTypeInfo;
    itemsize,size,i: integer;
    P: PPtrUInt absolute data;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  case info^.Kind of // should match tkManagedTypes
  tkLString,tkWString{$ifdef FPC},tkLStringOld{$endif}: begin
    len := SizeOf(pointer); // length stored within WideString is in bytes
    if P^=0 then
      result := 1 else
      result := ToVarUInt32LengthWithData(PStrRec(Pointer(P^-STRRECSIZE))^.length);
  end;
  {$ifdef HASVARUSTRING}
  tkUString: begin
    len := SizeOf(pointer);
    if P^=0 then
      result := 1 else
      result := ToVarUInt32LengthWithData(PStrRec(Pointer(P^-STRRECSIZE))^.length*2);
  end;
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    result := RecordSaveLength(data^,info,@len);
  tkArray: begin
    itemtype := ArrayItemType(info,len);
    result := 0;
    if info<>nil then
      if itemtype=nil then
        result := len else
        for i := 1 to info^.elCount do begin
          size := ManagedTypeSaveLength(data,itemtype,itemsize);
          if size=0 then begin
            result := 0;
            exit;
          end;
          inc(result,size);
          inc(data,itemsize);
        end;
  end;
  {$ifndef NOVARIANTS}
  tkVariant: begin
    len := SizeOf(variant);
    result := VariantSaveLength(PVariant(data)^);
  end;
  {$endif}
  tkDynArray: begin
    DynArray.Init(info,data^);
    len := SizeOf(pointer);
    result := DynArray.SaveToLength;
  end;
  tkInterface: begin
    len := SizeOf(Int64); // consume 64-bit even on CPU32
    result := SizeOf(PtrUInt);
  end;
  else
    result := 0; // invalid/unhandled record content
  end;
end;

function ManagedTypeSave(data, dest: PAnsiChar; info: PTypeInfo;
  out len: integer): PAnsiChar;
// returns nil on error, or final dest + len=data^ length
var DynArray: TDynArray;
    itemtype: PTypeInfo;
    itemsize,i: integer;
    P: PPtrUInt absolute data;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  case info^.Kind of
  tkLString, tkWString {$ifdef HASVARUSTRING}, tkUString{$endif}
  {$ifdef FPC}, tkLStringOld{$endif}:
    if P^=0 then begin
      dest^ := #0;
      result := dest+1;
      len := SizeOf(PtrUInt); // size of tkLString+tkWString+tkUString in record
    end else begin
      itemsize := PStrRec(Pointer(P^-STRRECSIZE))^.length;
      {$ifdef HASVARUSTRING} // WideString has length in bytes, UnicodeString in WideChars
      if info^.Kind=tkUString then
        itemsize := itemsize*2;
      {$endif}
      result := pointer(ToVarUInt32(itemsize,pointer(dest)));
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(P^)^,result^,itemsize);
      inc(result,itemsize);
      len := SizeOf(PtrUInt); // size of tkLString+tkWString+tkUString in record
    end;
  tkRecord{$ifdef FPC},tkObject{$endif}:
    result := RecordSave(data^,dest,info,len);
  tkArray: begin
    itemtype := ArrayItemType(info,len);
    if info=nil then
      result := nil else
      if itemtype=nil then begin
        {$ifdef FPC}Move{$else}MoveFast{$endif}(data^,dest^,len);
        result := dest+len;
      end else begin
        for i := 1 to info^.elCount do begin
          dest := ManagedTypeSave(data,dest,itemtype,itemsize);
          if dest=nil then
            break; // invalid/unhandled content
          inc(data,itemsize)
        end;
        result := dest;
      end;
  end;
  {$ifndef NOVARIANTS}
  tkVariant: begin
    result := VariantSave(PVariant(data)^,dest);
    len := SizeOf(Variant); // size of tkVariant in record
  end;
  {$endif}
  tkDynArray: begin
    DynArray.Init(info,data^);
    result := DynArray.SaveTo(dest);
    len := SizeOf(PtrUInt); // size of tkDynArray in record
  end;
  {$ifndef DELPHI5OROLDER}
  tkInterface: begin
    PIInterface(dest)^ := PIInterface(data)^; // with proper refcount
    result := dest+SizeOf(Int64); // consume 64-bit even on CPU32
    len := SizeOf(PtrUInt);
  end;
  {$endif}
  else
    result := nil; // invalid/unhandled record content
  end;
end;

function ManagedTypeLoad(data: PAnsiChar; var source: PAnsiChar; info: PTypeInfo): integer;
// returns source=nil on error, or final source + result=data^ length
var DynArray: TDynArray;
    itemtype: PTypeInfo;
    itemsize,i: integer;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  case info^.Kind of
  tkLString: begin // most used type of string
    itemsize := FromVarUInt32(PByte(source));
    FastSetStringCP(data^,source,itemsize,PWord({$ifdef FPC}
      GetFPCTypeData(pointer(info)){$else}PtrUInt(info)+info^.NameLen+2{$endif})^);
    inc(source,itemsize);
    result := SizeOf(PtrUInt); // size of tkLString
  end;
  tkWString {$ifdef HASVARUSTRING}, tkUString{$endif}
  {$ifdef FPC}, tkLStringOld{$endif}: begin
    itemsize := FromVarUInt32(PByte(source));
    case info^.Kind of
      {$ifdef FPC}
      tkLStringOld:
        SetString(PRawByteString(data)^,source,itemsize);
      {$endif}
      tkWString:
        SetString(PWideString(data)^,PWideChar(source),itemsize shr 1);
      {$ifdef HASVARUSTRING}
      tkUString:
        SetString(PUnicodeString(data)^,PWideChar(source),itemsize shr 1);
      {$endif}
    end;
    inc(source,itemsize);
    result := SizeOf(PtrUInt); // size of tkWString+tkUString in record
  end;
  tkRecord{$ifdef FPC},tkObject{$endif}:
    source := RecordLoad(data^,source,info,@result);
  tkArray: begin
    itemtype := ArrayItemType(info,result);
    if info=nil then
      source := nil else
      if itemtype=nil then begin
        {$ifdef FPC}Move{$else}MoveFast{$endif}(source^,data^,result);
        inc(source,result);
      end else
        for i := 1 to info^.elCount do begin
          inc(data,ManagedTypeLoad(data,source,itemtype));
          if source=nil then
            exit;
        end;
  end;
  {$ifndef NOVARIANTS}
  tkVariant: begin
    source := VariantLoad(PVariant(data)^,source,@JSON_OPTIONS[true]);
    result := SizeOf(Variant); // size of tkVariant in record
  end;
  {$endif}
  tkDynArray: begin
    DynArray.Init(info,data^);
    source := DynArray.LoadFrom(source);
    result := SizeOf(PtrUInt); // size of tkDynArray in record
  end;
  {$ifndef DELPHI5OROLDER}
  tkInterface: begin
    PIInterface(data)^ := PIInterface(source)^; // with proper refcount
    inc(source,SizeOf(Int64)); // consume 64-bit even on CPU32
    result := SizeOf(PtrUInt);
  end;
  {$endif}
  else begin
    source := nil;
    result := 0;
  end;
  end;
end;

function GetManagedFields(info: PTypeInfo; out firstfield: PFieldInfo): integer;
  {$ifdef HASINLINE}inline;{$endif}
{$ifdef FPC_NEWRTTI}
var recInitData: PRecInitData; // low-level structure from typinfo.pp
begin
  recInitData := GetFPCRecInitData(AlignTypeData(PByte(info)+2));
  firstfield := pointer(PtrUInt(recInitData)+SizeOf(recInitData^)); // =ManagedFields[0]
  result := recInitData^.ManagedFieldCount;
{$else}
begin
  firstfield := @info^.ManagedFields[0];
  result := info^.ManagedCount;
{$endif}
end;

function RecordEquals(const RecA, RecB; TypeInfo: pointer;
  PRecSize: PInteger): boolean;
var info,fieldinfo: PTypeInfo;
    F, offset: PtrInt;
    field: PFieldInfo;
    A, B: PAnsiChar;
begin
  A := @RecA;
  B := @RecB;
  result := false;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if info=nil then
    exit; // raise Exception.CreateUTF8('% is not a record',[Typ^.Name]);
  if PRecSize<>nil then
    PRecSize^ := info^.recSize;
  if A=B then begin // both nil or same pointer
    result := true;
    exit;
  end;
  offset := 0;
  for F := 1 to GetManagedFields(info,field) do begin
    fieldinfo := DeRef(field^.TypeInfo);
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif}
    offset := integer(field^.Offset)-offset;
    if offset<>0 then begin
      if not CompareMemFixed(A,B,offset) then
        exit; // binary block not equal
      inc(A,offset);
      inc(B,offset);
    end;
    offset := ManagedTypeCompare(A,B,fieldinfo);
    if offset<=0 then
      if offset=0 then // A^<>B^
        exit else    // Diff=-1 for unexpected type
        raise ESynException.CreateUTF8('RecordEquals: unexpected %',
          [ToText(fieldinfo^.Kind)^]);
    inc(A,offset);
    inc(B,offset);
    inc(offset,field^.Offset);
    inc(field);
  end;
  if CompareMemFixed(A,B,integer(info^.recSize)-offset) then
    result := true;
end;

function RecordSaveLength(const Rec; TypeInfo: pointer; Len: PInteger): integer;
var info,fieldinfo: PTypeInfo;
    F, recsize,saved: integer;
    field: PFieldInfo;
    R: PAnsiChar;
begin
  R := @Rec;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (R=nil) or (info=nil) then begin
    result := 0; // should have been checked before
    exit;
  end;
  result := info^.recSize;
  if Len<>nil then
    Len^ := result;
  for F := 1 to GetManagedFields(info,field) do begin
    fieldinfo := DeRef(field^.TypeInfo);
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields! :)
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif};
    saved := ManagedTypeSaveLength(R+field^.Offset,fieldinfo,recsize);
    if saved=0 then begin
      result := 0; // invalid type
      exit;
    end;
    inc(result,saved-recsize); // extract recsize from info^.recSize
    inc(field);
  end;
end;

function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer;
  out Len: integer): PAnsiChar;
var info,fieldinfo: PTypeInfo;
    F, offset: integer;
    field: PFieldInfo;
    R: PAnsiChar;
begin
  R := @Rec;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (R=nil) or (info=nil) then begin
    result := nil; // should have been checked before
    exit;
  end;
  Len := info^.recSize;
  offset := 0;
  for F := 1 to GetManagedFields(info,field) do begin
    {$ifdef HASDIRECTTYPEINFO} // inlined DeRef()
    fieldinfo := field^.TypeInfo;
    {$else}
    {$ifdef CPUINTEL}
    fieldinfo := PPointer(field^.TypeInfo)^;
    {$else}
    fieldinfo := DeRef(field^.TypeInfo);
    {$endif}
    {$endif}
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields! :)
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif};
    offset := integer(field^.Offset)-offset;
    if offset>0 then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(R^,Dest^,offset);
      inc(R,offset);
      inc(Dest,offset);
    end;
    Dest := ManagedTypeSave(R,Dest,fieldinfo,offset);
    if Dest=nil then begin
      result := nil; // invalid/unhandled record content
      exit;
    end;
    inc(R,offset);
    inc(offset,field.Offset);
    inc(field);
  end;
  offset := integer(info^.recSize)-offset;
  if offset<0 then
    raise ESynException.Create('RecordSave offset<0') else
  if offset<>0 then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(R^,Dest^,offset);
    result := Dest+offset;
  end else
    result := Dest;
end;

function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer): PAnsiChar;
var dummylen: integer;
begin
  result := RecordSave(Rec,Dest,TypeInfo,dummylen);
end;

function RecordSave(const Rec; TypeInfo: pointer): RawByteString;
var destlen,dummylen: integer;
    dest: PAnsiChar;
begin
  destlen := RecordSaveLength(Rec,TypeInfo);
  SetString(result,nil,destlen);
  if destlen<>0 then begin
    dest := RecordSave(Rec,pointer(result),TypeInfo,dummylen);
    if (dest=nil) or (dest-pointer(result)<>destlen) then // paranoid check
      raise ESynException.CreateUTF8('RecordSave % len=%<>%',
        [TypeInfoToShortString(TypeInfo)^,dest-pointer(result),destlen]);
  end;
end;

function RecordSaveBytes(const Rec; TypeInfo: pointer): TBytes;
var destlen,dummylen: integer;
    dest: PAnsiChar;
begin
  destlen := RecordSaveLength(Rec,TypeInfo);
  result := nil; // don't reallocate TBytes data from a previous call
  SetLength(result,destlen);
  if destlen<>0 then begin
    dest := RecordSave(Rec,pointer(result),TypeInfo,dummylen);
    if (dest=nil) or (dest-pointer(result)<>destlen) then // paranoid check
      raise ESynException.CreateUTF8('RecordSave % len=%<>%',
        [TypeInfoToShortString(TypeInfo)^,dest-pointer(result),destlen]);
  end;
end;

procedure RecordSave(const Rec; var Dest: TSynTempBuffer; TypeInfo: pointer);
var dummy: integer;
begin
  Dest.Init(RecordSaveLength(Rec,TypeInfo));
  RecordSave(Rec,Dest.buf,TypeInfo,dummy);
end;

function RecordSaveBase64(const Rec; TypeInfo: pointer; UriCompatible: boolean): RawUTF8;
var len,dummy: integer;
    temp: TSynTempBuffer;
begin
  result := '';
  len := RecordSaveLength(Rec,TypeInfo);
  if len=0 then
    exit;
  temp.Init(len+4); 
  RecordSave(Rec,PAnsiChar(temp.buf)+4,TypeInfo,dummy);
  PCardinal(temp.buf)^ := crc32c(0,PAnsiChar(temp.buf)+4,len);
  if UriCompatible then
    result := BinToBase64uri(temp.buf,temp.len) else
    result := BinToBase64(temp.buf,temp.len);
  temp.Done;
end;

function RecordLoadBase64(Source: PAnsiChar; Len: integer; var Rec;
  TypeInfo: pointer; UriCompatible: boolean): boolean;
var temp: TSynTempBuffer;
begin
  result := false;
  if Len<=6 then
    exit;
  if UriCompatible then
    result := Base64uriToBin(Source,Len,temp) else
    result := Base64ToBin(Source,Len,temp);
  result := result and (temp.len>=4) and
    (crc32c(0,PAnsiChar(temp.buf)+4,temp.len-4)=PCardinal(temp.buf)^) and
    (RecordLoad(Rec,PAnsiChar(temp.buf)+4,TypeInfo)<>nil);
  temp.Done;
end;

function RecordLoad(var Rec; Source: PAnsiChar; TypeInfo: pointer;
  Len: PInteger): PAnsiChar;
var info,fieldinfo: PTypeInfo;
    n, F, offset: integer;
    field: PFieldInfo;
    R: PAnsiChar;
begin
  result := nil; // indicates error
  R := @Rec;
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (R=nil) or (info=nil) then // should have been checked before
    exit;
  if Len<>nil then
    Len^ := info^.recSize;
  n := GetManagedFields(info,field);
  if Source=nil then begin  // inline RecordClear() function
    for F := 1 to n do begin
      {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(R+field^.Offset,Deref(field^.TypeInfo));
      inc(field);
    end;
    exit;
  end;
  offset := 0;
  for F := 1 to n do begin
    {$ifdef HASDIRECTTYPEINFO} // inlined DeRef()
    fieldinfo := field^.TypeInfo;
    {$else}
    {$ifdef CPUINTEL}
    fieldinfo := PPointer(field^.TypeInfo)^;
    {$else}
    fieldinfo := DeRef(field^.TypeInfo);
    {$endif}
    {$endif}
    {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields! :)
    if not (fieldinfo^.Kind in tkManagedTypes) then begin
      inc(field);
      continue; // as with Delphi
    end;
    {$endif};
    offset := integer(field^.Offset)-offset;
    if offset<>0 then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,R^,offset);
      inc(Source,offset);
      inc(R,offset);
    end;
    offset := ManagedTypeLoad(R,Source,fieldinfo);
    if Source=nil then
      exit; // error at loading
    inc(R,offset);
    inc(offset,field^.Offset);
    inc(field);
  end;
  offset := integer(info^.recSize)-offset;
  if offset<0 then
    raise ESynException.Create('RecordLoad offset<0') else
  if offset<>0 then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,R^,offset);
    result := Source+offset;
  end else
    result := Source;
end;

function RecordLoad(var Res; const Source: RawByteString; TypeInfo: pointer): boolean; overload;
var P: PAnsiChar;
begin
  P := RecordLoad(Res,pointer(Source),TypeInfo,nil);
  result := (P<>nil) and (P-pointer(Source)=length(Source));
end;

{$ifndef FPC}

  {$ifdef USEPACKAGES}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}
  {$ifdef DELPHI5OROLDER}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}
  {$ifdef PUREPASCAL}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}
  {$ifndef DOPATCHTRTL}
    {$define EXPECTSDELPHIRTLRECORDCOPYCLEAR}
  {$endif}

{$ifdef EXPECTSDELPHIRTLRECORDCOPYCLEAR}
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
asm // same params than _CopyRecord{ dest, source, typeInfo: Pointer }
  {$ifdef CPU64}
  .NOFRAME
  {$endif}
  jmp System.@CopyRecord
end;

procedure RecordClear(var Dest; TypeInfo: pointer);
asm
  {$ifdef CPU64}
  .NOFRAME
  {$endif}
  jmp System.@FinalizeRecord
end;
{$endif EXPECTSDELPHIRTLRECORDCOPYCLEAR}


{$ifdef DOPATCHTRTL}

function SystemRecordCopyAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@CopyRecord
  {$else}
  mov eax,offset System.@CopyRecord
  {$endif}
end;

function SystemFinalizeRecordAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@FinalizeRecord
  {$else}
  mov eax,offset System.@FinalizeRecord
  {$endif}
end;

function SystemInitializeRecordAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@InitializeRecord
  {$else}
  mov eax,offset System.@InitializeRecord
  {$endif}
end;

{$ifdef CPUX86}
procedure _InitializeRecord(P: Pointer; TypeInfo: Pointer);
asm // faster version by AB
        { ->    EAX pointer to record to be finalized   }
        {       EDX pointer to type info                }
(* // this TObject.Create-like initialization sounds slower
  movzx ecx,byte ptr [edx].TTypeInfo.NameLen
  mov edx,[edx+ecx].TTypeInfo.Size
  xor ecx,ecx
  jmp dword ptr [FillCharFast] *)
        movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        push    ebx
        mov     ebx, eax
        push    esi
        push    edi
        mov     edi, [edx + ecx].TTypeInfo.ManagedCount
        lea     esi, [edx + ecx].TTypeInfo.ManagedFields
        test    edi, edi
        jz      @end
@loop:  mov     edx, [esi].TFieldInfo.TypeInfo
        mov     eax, [esi].TFieldInfo.&Offset
        mov     edx, [edx]
        add     esi, 8
        movzx   ecx, [edx].TTypeInfo.Kind
        add     eax, ebx // eax=data to be initialized
        jmp     dword ptr[@tab + ecx * 4 - tkLString * 4]
@tab:   dd      @ptr, @ptr, @varrec, @array, @array, @ptr, @ptr, @ptr, @ptr
@ptr:   dec     edi
        mov     dword ptr[eax], 0 // pointer initialization
        jg      @loop
@end:   pop     edi
        pop     esi
        pop     ebx
        ret
@varrec:xor     ecx, ecx
        dec     edi
        mov     dword ptr[eax], ecx
        mov     dword ptr[eax + 4], ecx
        mov     dword ptr[eax + 8], ecx
        mov     dword ptr[eax + 12], ecx
        jg      @loop
        pop     edi
        pop     esi
        pop     ebx
        ret
@array: mov     ecx, 1 // here eax=data edx=typeinfo
        call    System.@InitializeArray
        dec     edi
        jg      @loop
        pop     edi
        pop     esi
        pop     ebx
end;

{$ifndef UNICODE} // TMonitor.Destroy is not available ! -> apply to D2007 only
procedure TObjectCleanupInstance;
asm // faster version by AB
        push    ebx
        mov     ebx, eax
@loop:  mov     ebx, [ebx] // handle three VMT levels per iteration
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jnz     @loop
@end:   pop     ebx
        ret
@clr:   push    offset @loop // TObject has no vmtInitTable -> safe
        jmp     RecordClear // eax=self edx=typeinfo
end;
{$endif}

procedure RecordClear(var Dest; TypeInfo: pointer);
asm // faster version by AB (direct call to finalization procedures)
        { ->    EAX pointer to record to be finalized   }
        {       EDX pointer to type info                }
        { <-    EAX pointer to record to be finalized   }
        movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        push    ebx
        mov     ebx, eax
        push    esi
        push    edi
        mov     edi, [edx + ecx].TTypeInfo.ManagedCount
        lea     esi, [edx + ecx].TTypeInfo.ManagedFields
        test    edi, edi
        jz      @end
@loop:  mov     edx, [esi].TFieldInfo.TypeInfo
        mov     eax, [esi].TFieldInfo.&Offset
        mov     edx, [edx]
        add     esi, 8
        movzx   ecx, [edx].TTypeInfo.Kind
        add     eax, ebx // eax=data to be initialized
        sub     cl, tkLString
{$ifdef UNICODE}
        cmp     cl, tkUString - tkLString + 1
{$else} cmp     cl, tkDynArray - tkLString + 1
{$endif}
        jnb     @err
        call    dword ptr[@Tab + ecx * 4]
        dec     edi
        jg      @loop
@end:   mov     eax, ebx // keep eax at return (see e.g. TObject.CleanupInstance)
        pop     edi
        pop     esi
        pop     ebx
        ret
        nop
        nop
        nop // align @Tab
@Tab:   dd      System.@LStrClr
{$IFDEF LINUX} // under Linux, WideString are refcounted as AnsiString
        dd      System.@LStrClr
{$else} dd      System.@WStrClr
{$endif}
{$ifdef LVCL}
        dd      @err
{$else} dd      System.@VarClr
{$endif}
        dd      @array
        dd      RecordClear
        dd      System.@IntfClear
        dd      @err
        dd      System.@DynArrayClear
        {$ifdef UNICODE}
        dd      System.@UStrClr
        {$endif}
@err:   mov     al, reInvalidPtr
        pop     edi
        pop     esi
        pop     ebx
        jmp     System.Error
@array: movzx   ecx, [edx].TTypeInfo.NameLen
        add     ecx, edx
        mov     edx, dword ptr[ecx].TTypeInfo.ManagedFields[0] // Fields[0].TypeInfo^
        mov     ecx, [ecx].TTypeInfo.ManagedCount
        mov     edx, [edx]
        call    System.@FinalizeArray
        // we made Call @Array -> ret to continue
end;

procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
asm  // faster version of _CopyRecord{dest, source, typeInfo: Pointer} by AB
        { ->    EAX pointer to dest             }
        {       EDX pointer to source           }
        {       ECX pointer to typeInfo         }
        push    ebp
        push    ebx
        push    esi
        push    edi
        movzx   ebx, byte ptr[ecx].TTypeInfo.NameLen
        mov     esi, edx                     // esi = source
        mov     edi, eax                     // edi = dest
        add     ebx, ecx                     // ebx = TFieldTable
        xor     eax, eax                     // eax = current offset
        mov     ebp, [ebx].TTypeInfo.ManagedCount // ebp = TFieldInfo count
        mov     ecx, [ebx].TTypeInfo.recSize
        test    ebp, ebp
        jz      @fullcopy
        push    ecx                          // SizeOf(record) on stack
        add     ebx, offset TTypeInfo.ManagedFields[0] // ebx = first TFieldInfo
@next:  mov     ecx, [ebx].TFieldInfo.&Offset
        mov     edx, [ebx].TFieldInfo.TypeInfo
        sub     ecx, eax
        mov     edx, [edx]
        jle     @nomov
        add     esi, ecx
        add     edi, ecx
        neg     ecx
@mov1:  mov     al, [esi + ecx] // fast copy not destructable data
        mov     [edi + ecx], al
        inc     ecx
        jnz     @mov1
@nomov: mov     eax, edi
        movzx   ecx, [edx].TTypeInfo.Kind
        cmp     ecx, tkLString
        je      @LString
        jb      @err
{$ifdef UNICODE}
        cmp     ecx, tkUString
        je      @UString
{$else} cmp     ecx, tkDynArray
        je      @dynaray
{$endif}        ja      @err
        jmp     dword ptr[ecx * 4 + @tab - tkWString * 4]

@Tab:   dd      @WString, @variant, @array, @record, @interface, @err
{$ifdef UNICODE}
        dd      @dynaray
{$endif}
@errv:  mov     al, reVarInvalidOp
        jmp     @err2
@err:   mov     al, reInvalidPtr
@err2:  pop     edi
        pop     esi
        pop     ebx
        pop     ebp
        jmp     System.Error
        nop // all functions below have esi=source edi=dest
@array: movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        push    dword ptr[edx + ecx].TTypeInfo.recSize
        push    dword ptr[edx + ecx].TTypeInfo.ManagedCount
        mov     ecx, dword ptr[edx + ecx].TTypeInfo.ManagedFields[0] // Fields[0].TypeInfo^
        mov     ecx, [ecx]
        mov     edx, esi
        call    System.@CopyArray
        pop     eax // restore SizeOf(Array)
        jmp     @finish
@record:movzx   ecx, byte ptr[edx].TTypeInfo.NameLen
        mov     ecx, [edx + ecx].TTypeInfo.recSize
        push    ecx
        mov     ecx, edx
        mov     edx, esi
        call    RecordCopy
        pop     eax // restore SizeOf(Record)
        jmp     @finish
        nop
        nop
        nop
@variant:
{$ifdef NOVARCOPYPROC}
        mov     edx, esi
        call    System.@VarCopy
{$else} mov     edx, esi
        cmp     dword ptr[VarCopyProc], 0
        jz      @errv
        call    [VarCopyProc]
{$endif}
        mov     eax, 16
        jmp     @finish
{$ifdef DELPHI6OROLDER}
        nop
        nop
{$endif}
@interface:
        mov     edx, [esi]
        call    System.@IntfCopy
        jmp     @fin4
        nop
        nop
        nop
@dynaray:
        mov     ecx, edx // ecx=TypeInfo
        mov     edx, [esi]
        call    System.@DynArrayAsg
        jmp     @fin4
@WString:
{$ifndef LINUX}
        mov     edx, [esi]
        call    System.@WStrAsg
        jmp     @fin4
{$endif}
@LString:
        mov     edx, [esi]
        call    System.@LStrAsg
{$ifdef UNICODE}
        jmp     @fin4
        nop
        nop
@UString:
        mov     edx, [esi]
        call    System.@UStrAsg
{$endif}
@fin4: mov     eax, 4
@finish:
        add     esi, eax
        add     edi, eax
        add     eax, [ebx].TFieldInfo.&Offset
        add     ebx, 8
        dec     ebp    // any other TFieldInfo?
        jnz     @next
        pop     ecx // ecx= SizeOf(record)
@fullcopy:
        mov     edx, edi
        sub     ecx, eax
        mov     eax, esi
        jle     @nomov2
        call    dword ptr[MoveFast]
@nomov2:        pop     edi
        pop     esi
        pop     ebx
        pop     ebp
end;

{$endif CPUX86}
{$endif DOPATCHTRTL}

{$ifndef CPUARM}

function SystemFillCharAddress: Pointer;
asm
  {$ifdef CPU64}
  mov rax,offset System.@FillChar
  {$else}
  mov eax,offset System.@FillChar
  {$endif}
end;

{$ifdef CPU64}

{ Some notes about MOVNTI opcode use below:
  - Delphi inline assembler is not able to compile the instruction -> so we
    had to write some manual DB $... values instead :(
  - The I in MOVNTI means "non-temporal hint". It is implemented by using a
    write combining (WC) memory type protocol when writing the data to memory.
    The processor does not write the data into the cache hierarchy, nor does
    it fetch the corresponding cache line from memory into the cache hierarchy.
    By-passing the cache should enhance move() speed of big memory blocks. }

procedure Movex64; // A. Bouchez' version
asm // rcx=Source, rdx=Dest, r8=Count
        .noframe
        mov     rax, r8
        sub     rcx, rdx
        je      @11
        jnc     @03
        add     rax, rcx
        jc      @17
@03:    cmp     r8, 8
        jl      @09
        test    dl, 07H
        jz      @06
        test    dl, 01H
        jz      @04
        mov     al, byte ptr[rcx + rdx]
        dec     r8
        mov     byte ptr[rdx], al
        add     rdx, 1
@04:    test    dl, 02H
        jz      @05
        mov     ax, word ptr[rcx + rdx]
        sub     r8, 2
        mov     word ptr[rdx], ax
        add     rdx, 2
@05:    test    dl, 04H
        jz      @06
        mov     eax, dword ptr[rcx + rdx]
        sub     r8, 4
        mov     dword ptr[rdx], eax
        add     rdx, 4
@06:    mov     r9, r8
        shr     r9, 5
        jnz     @12
@07:    mov     r9, r8
        shr     r9, 3
        jz      @09
        nop
@08:    mov     rax, qword ptr[rcx + rdx]
        mov     qword ptr[rdx], rax
        add     rdx, 8
        dec     r9
        jnz     @08
        and     r8, 07H
@09:    test    r8, r8
        jle     @11
@10:    mov     al, byte ptr[rcx + rdx]
        mov     byte ptr[rdx], al
        add     rdx, 1
        dec     r8
        jnz     @10
@11:    ret
@12:    cmp     r9, 8192
        jc      @13
        cmp     rcx, 4096
        jnc     @14
@13:    add     rdx, 32
        mov     rax, qword ptr[rcx + rdx - 20H]
        mov     r10, qword ptr[rcx + rdx - 18H]
        mov     qword ptr[rdx - 20H], rax
        mov     qword ptr[rdx - 18H], r10
        mov     rax, qword ptr[rcx + rdx - 10H]
        mov     r10, qword ptr[rcx + rdx - 8H]
        mov     qword ptr[rdx - 10H], rax
        mov     qword ptr[rdx - 8H], r10
        dec     r9
        jnz     @13
        and     r8, 1FH
        jmp     @07
@14:    mov     eax, 32
@15:    prefetchnta [rcx + rdx]
        prefetchnta [rcx + rdx + 40H]
        add     rdx, 128
        dec     eax
        jnz     @15
        sub     rdx, 4096
        mov     eax, 64
@16:    add     rdx, 64
        mov     r9, qword ptr[rcx + rdx - 40H]
        mov     r10, qword ptr[rcx + rdx - 38H]
        db      $4C, $0F, $C3, $4A, $C0 // movnti qword ptr [rdx-40H],r9
        db      $4C, $0F, $C3, $52, $C8 // movnti qword ptr [rdx-38H],r10
        mov     r9, qword ptr[rcx + rdx - 30H]
        mov     r10, qword ptr[rcx + rdx - 28H]
        db      $4C, $0F, $C3, $4A, $D0 // movnti qword ptr [rdx-30H],r9
        db      $4C, $0F, $C3, $52, $D8 // movnti qword ptr [rdx-28H],r10
        dec     eax
        mov     r9, qword ptr[rcx + rdx - 20H]
        mov     r10, qword ptr[rcx + rdx - 18H]
        db      $4C, $0F, $C3, $4A, $E0 // movnti qword ptr [rdx-20H],r9
        db      $4C, $0F, $C3, $52, $E8 // movnti qword ptr [rdx-18H],r10
        mov     r9, qword ptr[rcx + rdx - 10H]
        mov     r10, qword ptr[rcx + rdx - 8H]
        db      $4C, $0F, $C3, $4A, $F0 // movnti qword ptr [rdx-10H],r9
        db      $4C, $0F, $C3, $52, $F8 // movnti qword ptr [rdx-8H],r10
        jnz     @16
        sub     r8, 4096
        cmp     r8, 4096
        jnc     @14
        mfence
        jmp     @06
@17:    add     rdx, r8
        cmp     r8, 8
        jl      @23
        test    dl, 07H
        jz      @20
        test    dl, 01H
        jz      @18
        dec     rdx
        mov     al, byte ptr[rcx + rdx]
        dec     r8
        mov     byte ptr[rdx], al
@18:    test    dl, 02H
        jz      @19
        sub     rdx, 2
        mov     ax, word ptr[rcx + rdx]
        sub     r8, 2
        mov     word ptr[rdx], ax
@19:    test    dl, 04H
        jz      @20
        sub     rdx, 4
        mov     eax, dword ptr[rcx + rdx]
        sub     r8, 4
        mov     dword ptr[rdx], eax
@20:    mov     r9, r8
        shr     r9, 5
        jnz     @26
@21:    mov     r9, r8
        shr     r9, 3
        jz      @23
@22:    sub     rdx, 8
        mov     rax, qword ptr[rcx + rdx]
        dec     r9
        mov     qword ptr[rdx], rax
        jnz     @22
        and     r8, 07H
@23:    test    r8, r8
        jle     @25
@24:    dec     rdx
        mov     al, byte ptr[rcx + rdx]
        dec     r8
        mov     byte ptr[rdx], al
        jnz     @24
@25:    ret
@26:    cmp     r9, 8192
        jc      @27
        cmp     rcx,  - 4096
        jc      @28
@27:    sub     rdx, 32
        mov     rax, qword ptr[rcx + rdx + 18H]
        mov     r10, qword ptr[rcx + rdx + 10H]
        mov     qword ptr[rdx + 18H], rax
        mov     qword ptr[rdx + 10H], r10
        dec     r9
        mov     rax, qword ptr[rcx + rdx + 8H]
        mov     r10, qword ptr[rcx + rdx]
        mov     qword ptr[rdx + 8H], rax
        mov     qword ptr[rdx], r10
        jnz     @27
        and     r8, 1FH
        jmp     @21
@28:    mov     eax, 32
@29:    sub     rdx, 128
        prefetchnta [rcx + rdx]
        prefetchnta [rcx + rdx + 40H]
        dec     eax
        jnz     @29
        add     rdx, 4096
        mov     eax, 64
@30:    sub     rdx, 64
        sub     r8, 4096
        mov     r9, qword ptr[rcx + rdx + 38H]
        mov     r10, qword ptr[rcx + rdx + 30H]
        db      $4C, $0F, $C3, $4A, $38 // movnti qword ptr [rdx+38H],r9
        db      $4C, $0F, $C3, $52, $30 // movnti qword ptr [rdx+30H],r10
        mov     r9, qword ptr[rcx + rdx + 28H]
        mov     r10, qword ptr[rcx + rdx + 20H]
        db      $4C, $0F, $C3, $4A, $28 // movnti qword ptr [rdx+28H],r9
        db      $4C, $0F, $C3, $52, $20 // movnti qword ptr [rdx+20H],r10
        dec     eax
        mov     r9, qword ptr[rcx + rdx + 18H]
        mov     r10, qword ptr[rcx + rdx + 10H]
        db      $4C, $0F, $C3, $4A, $18 // movnti qword ptr [rdx+18H],r9
        db      $4C, $0F, $C3, $52, $10 // movnti qword ptr [rdx+10H],r10
        mov     r9, qword ptr[rcx + rdx + 8H]
        mov     r10, qword ptr[rcx + rdx]
        db      $4C, $0F, $C3, $4A, $08 // movnti qword ptr [rdx+8H],r9
        db      $4C, $0F, $C3, $12 // movnti qword ptr [rdx],r10
        jnz     @30
        cmp     r8, 4096
        jnc     @28
        mfence
        jmp     @20
end;

procedure FillCharx64; // A. Bouchez' version
asm  // rcx=Dest rdx=Count r8=Value
        .noframe
        mov     rax, r8
        cmp     rdx, 32
        jle     @small
        and     r8, 0FFH
        mov     r9, 101010101010101H
        imul    r8, r9
        test    cl, 07H
        jz      @27C5
        test    cl, 01H
        jz      @27A4
        mov     byte ptr[rcx], r8b
        add     rcx, 1
        sub     rdx, 1
@27A4:  test    cl, 02H
        jz      @27B5
        mov     word ptr[rcx], r8w
        add     rcx, 2
        sub     rdx, 2
@27B5:  test    cl, 04H
        jz      @27C5
        mov     dword ptr[rcx], r8d
        add     rcx, 4
        sub     rdx, 4
@27C5:  mov     rax, rdx
        and     rdx, 3FH
        shr     rax, 6
        jnz     @27FD
@27D2:  mov     rax, rdx
        and     rdx, 07H
        shr     rax, 3
        jz      @27EC
@27E0:  mov     qword ptr[rcx], r8
        add     rcx, 8
        dec     rax
        jnz     @27E0
@27EC:  test    rdx, rdx
        jle     @27FC
@27F1:  mov     byte ptr[rcx], r8b
        inc     rcx
        dec     rdx
        jnz     @27F1
@27FC:  ret
@27FD:  cmp     rax, 8192
        jnc     @2840
@2810:  add     rcx, 64
        mov     qword ptr[rcx - 40H], r8
        mov     qword ptr[rcx - 38H], r8
        mov     qword ptr[rcx - 30H], r8
        mov     qword ptr[rcx - 28H], r8
        dec     rax
        mov     qword ptr[rcx - 20H], r8
        mov     qword ptr[rcx - 18H], r8
        mov     qword ptr[rcx - 10H], r8
        mov     qword ptr[rcx - 8H], r8
        jnz     @2810
        jmp     @27D2
@2840:  add     rcx, 64
        db      $4C, $0F, $C3, $41, $C0 // movnti  qword ptr [rcx-40H],r8
        db      $4C, $0F, $C3, $41, $C8 // movnti  qword ptr [rcx-38H],r8
        db      $4C, $0F, $C3, $41, $D0 // movnti  qword ptr [rcx-30H],r8
        db      $4C, $0F, $C3, $41, $D8 // movnti  qword ptr [rcx-28H],r8
        dec     rax
        db      $4C, $0F, $C3, $41, $E0 // movnti  qword ptr [rcx-20H],r8
        db      $4C, $0F, $C3, $41, $E8 // movnti  qword ptr [rcx-18H],r8
        db      $4C, $0F, $C3, $41, $F0 // movnti  qword ptr [rcx-10H],r8
        db      $4C, $0F, $C3, $41, $F8 // movnti  qword ptr [rcx-8H],r8
        jnz     @2840
        mfence
        jmp     @27D2
@small: // rcx=Dest rdx=Count r8=Value<=32
        test    rdx, rdx
        jle     @@done
        mov     ah, al
        mov     [rcx + rdx - 1], al
        lea     r8, [@table]
        and     rdx,  - 2
        neg     rdx
        lea     rdx, [r8 + rdx * 2 + 64]
        jmp     rdx
@table: mov     [rcx + 30], ax
        mov     [rcx + 28], ax
        mov     [rcx + 26], ax
        mov     [rcx + 24], ax
        mov     [rcx + 22], ax
        mov     [rcx + 20], ax
        mov     [rcx + 18], ax
        mov     [rcx + 16], ax
        mov     [rcx + 14], ax
        mov     [rcx + 12], ax
        mov     [rcx + 10], ax
        mov     [rcx + 8], ax
        mov     [rcx + 6], ax
        mov     [rcx + 4], ax
        mov     [rcx + 2], ax
        mov     [rcx], ax
        ret
@@done:
end;

{$ifdef WITH_ERMS} // x64 version only for Windows ABI
procedure MoveERMSB; // Ivy Bridge+ Enhanced REP MOVSB/STOSB CPUs
asm // rcx=Source, rdx=Dest, r8=Count
        .noframe
        test    r8, r8
        jle     @none
        cld
        push    rsi
        push    rdi
        cmp     rdx, rcx
        ja      @down
        mov     rsi, rcx
        mov     rdi, rdx
        mov     rcx, r8
        rep     movsb
        pop     rdi
        pop     rsi
@none:  ret
@down:  lea     rsi, [rcx + r8 - 1]
        lea     rdi, [rdx + r8 - 1]
        mov     rcx, r8
        std
        rep     movsb
        cld
        pop     rdi
        pop     rsi
end;

procedure FillCharERMSB; // Ivy Bridge+ Enhanced REP MOVSB/STOSB CPUs
asm // rcx=Dest, rdx=Count, r8b=Value
        .noframe
        test    rdx, rdx
        jle     @none
        cld
        push    rdi
        mov     rdi, rcx
        mov     rax, r8
        mov     rcx, rdx
        rep     stosb
        pop     rdi
@none:
end;
{$endif WITH_ERMS}

{$else CPU64}

{$ifndef PUREPASCAL}

procedure FillCharX87;
asm // eax=Dest edx=Count cl=Value
        // faster version by John O'Harrow  (Code Size = 153 Bytes)
        mov     ch, cl                 // copy value into both bytes of cx
        cmp     edx, 32
        jl      @small
        mov     [eax], cx              // fill first 8 bytes
        mov     [eax + 2], cx
        mov     [eax + 4], cx
        mov     [eax + 6], cx
        sub     edx, 16
        fld     qword ptr[eax]
        fst     qword ptr[eax + edx]    // fill last 16 bytes
        fst     qword ptr[eax + edx + 8]
        mov     ecx, eax
        and     ecx, 7                 // 8-byte align writes
        sub     ecx, 8
        sub     eax, ecx
        add     edx, ecx
        add     eax, edx
        neg     edx
@loop:  fst     qword ptr[eax + edx]    // fill 16 bytes per loop
        fst     qword ptr[eax + edx + 8]
        add     edx, 16
        jl      @loop
        ffree   st(0)
        fincstp
        ret
        nop
@small: test    edx, edx
        jle     @done
        mov     [eax + edx - 1], cl      // fill last byte
        and     edx, -2                  // no. of words to fill
        neg     edx
        lea     edx, [@fill + 60 + edx * 2]
        jmp     edx
        nop                              // align jump destinations
        nop
@fill:  mov     [eax + 28], cx
        mov     [eax + 26], cx
        mov     [eax + 24], cx
        mov     [eax + 22], cx
        mov     [eax + 20], cx
        mov     [eax + 18], cx
        mov     [eax + 16], cx
        mov     [eax + 14], cx
        mov     [eax + 12], cx
        mov     [eax + 10], cx
        mov     [eax + 8], cx
        mov     [eax + 6], cx
        mov     [eax + 4], cx
        mov     [eax + 2], cx
        mov     [eax], cx
        ret                         // for alignment
@done:  db      $f3 // rep ret AMD trick here
end;

/// faster implementation of Move() for Delphi versions with no FastCode inside
procedure MoveX87;
asm // eax=source edx=dest ecx=count
         // original code by John O'Harrow - included since delphi 2007
        cmp     eax, edx
        jz      @exit                  // exit if source=dest
        cmp     ecx, 32
        ja      @lrg                   // count > 32 or count < 0
        sub     ecx, 8
        jg      @sml                   // 9..32 byte move
        jmp     dword ptr[@table + 32 + ecx * 4]   // 0..8 byte move
@sml:   fild    qword ptr[eax + ecx]   // load last 8
        fild    qword ptr[eax]         // load first 8
        cmp     ecx, 8
        jle     @sml16
        fild    qword ptr[eax + 8]     // load second 8
        cmp     ecx, 16
        jle     @sml24
        fild    qword ptr[eax + 16]    // load third 8
        fistp   qword ptr[edx + 16]    // save third 8
@sml24: fistp   qword ptr[edx + 8]     // save second 8
@sml16: fistp   qword ptr[edx]         // save first 8
        fistp   qword ptr[edx + ecx]   // save last 8
        ret
@exit:  rep     ret
@table: dd      @exit, @m01, @m02, @m03, @m04, @m05, @m06, @m07, @m08
@lrgfwd:push    edx
        fild    qword ptr[eax]       // first 8
        lea     eax, [eax + ecx - 8]
        lea     ecx, [ecx + edx - 8]
        fild    qword ptr[eax]       // last 8
        push    ecx
        neg     ecx
        and     edx,  -8             // 8-byte align writes
        lea     ecx, [ecx + edx + 8]
        pop     edx
@fwd:   fild    qword ptr[eax + ecx]
        fistp   qword ptr[edx + ecx]
        add     ecx, 8
        jl      @fwd
        fistp   qword ptr[edx]       // last 8
        pop     edx
        fistp   qword ptr[edx]       // first 8
        ret
@lrg:   jng     @exit                // count < 0
        cmp     eax, edx
        ja      @lrgfwd
        sub     edx, ecx
        cmp     eax, edx
        lea     edx, [edx + ecx]
        jna     @lrgfwd
        sub     ecx, 8               // backward move
        push    ecx
        fild    qword ptr[eax + ecx] // last 8
        fild    qword ptr[eax]       // first 8
        add     ecx, edx
        and     ecx, -8              // 8-byte align writes
        sub     ecx, edx
@bwd:   fild    qword ptr[eax + ecx]
        fistp   qword ptr[edx + ecx]
        sub     ecx, 8
        jg      @bwd
        pop     ecx
        fistp   qword ptr[edx]       // first 8
        fistp   qword ptr[edx + ecx] // last 8
        ret
@m01:   movzx   ecx, byte ptr[eax]
        mov     [edx], cl
        ret
@m02:   movzx   ecx, word ptr[eax]
        mov     [edx], cx
        ret
@m03:   mov     cx, [eax]
        mov     al, [eax + 2]
        mov     [edx], cx
        mov     [edx + 2], al
        ret
@m04:   mov     ecx, [eax]
        mov     [edx], ecx
        ret
@m05:   mov     ecx, [eax]
        mov     al, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], al
        ret
@m06:   mov     ecx, [eax]
        mov     ax, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], ax
        ret
@m07:   mov     ecx, [eax]
        mov     eax, [eax + 3]
        mov     [edx], ecx
        mov     [edx + 3], eax
        ret
@m08:   mov     ecx, [eax]
        mov     eax, [eax + 4]
        mov     [edx], ecx
        mov     [edx + 4], eax
end;

procedure FillCharERMSB; // Ivy Bridge+ Enhanced REP MOVSB/STOSB CPUs
asm // eax=Dest edx=Count cl=Value
      test    edx, edx
      jle     @none
      cld
      push    edi
      mov     edi, eax
      mov     al, cl
      mov     ecx, edx
      rep     stosb
      pop     edi
@none:
end;

procedure MoveERMSB; // Ivy Bridge+ Enhanced REP MOVSB/STOSB CPUs
asm // eax=source edx=dest ecx=count
      test    ecx, ecx
      jle     @none
      cld
      push    esi
      push    edi
      cmp     edx, eax
      ja      @down
      mov     esi, eax
      mov     edi, edx
      rep     movsb
      pop     edi
      pop     esi
@none:ret
@down:lea     esi, [eax + ecx - 1]
      lea     edi, [edx + ecx - 1]
      std
      rep     movsb
      pop     edi
      pop     esi
      cld
end;

function StrLenX86(S: pointer): PtrInt;
// pure x86 function (if SSE2 not available) - faster than SysUtils' version
asm
        test    eax, eax
        jz      @0
        cmp     byte ptr[eax + 0], 0
        je      @0
        cmp     byte ptr[eax + 1], 0
        je      @1
        cmp     byte ptr[eax + 2], 0
        je      @2
        cmp     byte ptr[eax + 3], 0
        je      @3
        push    eax
        and     eax, -4              { DWORD Align Reads }
@Loop:  add     eax, 4
        mov     edx, [eax]           { 4 Chars per Loop }
        lea     ecx, [edx - $01010101]
        not     edx
        and     edx, ecx
        and     edx, $80808080       { Set Byte to $80 at each #0 Position }
        jz      @Loop                { Loop until any #0 Found }
        pop     ecx
        bsf     edx, edx             { Find First #0 Position }
        shr     edx, 3               { Byte Offset of First #0 }
        add     eax, edx             { Address of First #0 }
        sub     eax, ecx             { Returns Length }
        ret
@0:     xor     eax, eax
        ret
@1:     mov     eax, 1
        ret
@2:     mov     eax, 2
        ret
@3:     mov     eax, 3
end;

{$ifndef DELPHI5OROLDER} // need SSE2 asm instruction set

procedure FillCharSSE2;
asm // Dest=eax Count=edx Value=cl
        mov     ch, cl                {copy value into both bytes of cx}
        cmp     edx, 32
        jl      @small
        sub     edx, 16
        movd    xmm0, ecx
        pshuflw xmm0, xmm0, 0
        pshufd  xmm0, xmm0, 0
        movups  [eax], xmm0           {fill first 16 bytes}
        movups  [eax + edx], xmm0     {fill last 16 bytes}
        mov     ecx, eax              {16-byte align writes}
        and     ecx, 15
        sub     ecx, 16
        sub     eax, ecx
        add     edx, ecx
        add     eax, edx
        neg     edx
        cmp     edx,  - 512 * 1024
        jb      @large
@loop:  movaps  [eax + edx], xmm0     {fill 16 bytes per loop}
        add     edx, 16
        jl      @loop
        ret
@large: movntdq [eax + edx], xmm0     {fill 16 bytes per loop}
        add     edx, 16
        jl      @large
        ret
@small: test    edx, edx
        jle     @done
        mov     [eax + edx - 1], cl   {fill last byte}
        and     edx,  -2              {no. of words to fill}
        neg     edx
        lea     edx, [@smallfill + 60 + edx * 2]
        jmp     edx
        nop                           {align jump destinations}
        nop
@smallfill:
        mov     [eax + 28], cx
        mov     [eax + 26], cx
        mov     [eax + 24], cx
        mov     [eax + 22], cx
        mov     [eax + 20], cx
        mov     [eax + 18], cx
        mov     [eax + 16], cx
        mov     [eax + 14], cx
        mov     [eax + 12], cx
        mov     [eax + 10], cx
        mov     [eax + 8], cx
        mov     [eax + 6], cx
        mov     [eax + 4], cx
        mov     [eax + 2], cx
        mov     [eax], cx
        ret {do not remove - this is for alignment}
@done:
end;

{$endif DELPHI5OROLDER}

{$endif PUREPASCAL}

{$endif CPU64}

procedure InitRedirectCode;
begin
  {$ifdef DELPHI5OROLDER}
  StrLen := @StrLenX86;
  MoveFast := @MoveX87;
  FillcharFast := @FillCharX87;
  {$else DELPHI5OROLDER}
  {$ifdef CPU64}
  {$ifdef HASAESNI}
  {$ifdef FORCE_STRSSE42}
  if cfSSE42 in CpuFeatures then begin
    StrLen := @StrLenSSE42;
    StrComp := @StrCompSSE42;
  end else
  {$endif FORCE_STRSSE42}
  {$endif HASAESNI}
    StrLen := @StrLenSSE2;
  {$ifdef WITH_ERMS}{$ifdef MSWINDOWS} // disabled (slower for small blocks)
  if cfERMS in CpuFeatures then begin
    MoveFast := @MoveERMSB;
    FillcharFast := @FillCharERMSB;
  end else {$endif}{$endif} begin
    MoveFast := @Movex64;
    FillCharFast := @Fillcharx64;
  end;
  {$else CPU64}
  {$ifdef CPUINTEL}
  if cfSSE2 in CpuFeatures then begin
    {$ifdef FORCE_STRSSE42}
    if cfSSE42 in CpuFeatures then
      StrLen := @StrLenSSE42 else
    {$endif FORCE_STRSSE42}
      StrLen := @StrLenSSE2;
    FillcharFast := @FillCharSSE2;
  end else begin
    StrLen := @StrLenX86;
    FillcharFast := @FillCharX87;
  end;
  {$ifdef WITH_ERMS} // disabled by default (much slower for small blocks)
  if cfERMS in CpuFeatures then begin
    MoveFast := @MoveERMSB;
    FillcharFast := @FillCharERMSB;
  end else {$endif}
    MoveFast := @MoveX87; // SSE2 is not faster than X87 version on 32-bit CPU
  {$endif CPUINTEL}
  {$endif CPU64}
  {$endif DELPHI5OROLDER}
  // do redirection from RTL to our fastest version
  {$ifdef DOPATCHTRTL}
  if DebugHook=0 then begin // patch only outside debugging
    RedirectCode(SystemFillCharAddress,@FillcharFast);
    RedirectCode(@System.Move,@MoveFast);
    {$ifdef CPUX86}
    RedirectCode(SystemRecordCopyAddress,@RecordCopy);
    RedirectCode(SystemFinalizeRecordAddress,@RecordClear);
    RedirectCode(SystemInitializeRecordAddress,@_InitializeRecord);
    {$ifndef UNICODE} // buggy Delphi 2009+ RTL expects a TMonitor.Destroy call
    RedirectCode(@TObject.CleanupInstance,@TObjectCleanupInstance);
    {$endif UNICODE}
    {$endif}
  end;
  {$endif DOPATCHTRTL}
end;

{$endif CPUARM}

{$endif FPC}


{ ************  Custom record / dynamic array JSON serialization }

procedure SaveJSON(const Value; TypeInfo: pointer;
  Options: TTextWriterOptions; var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
  try
    fCustomOptions := fCustomOptions+Options;
    AddTypedJSON(TypeInfo,Value);
    SetText(result);
  finally
    Free;
  end;
end;

function SaveJSON(const Value; TypeInfo: pointer; EnumSetsAsText: boolean): RawUTF8;
var options: TTextWriterOptions;
begin
  if EnumSetsAsText then
    options := [twoEnumSetsAsTextInRecord,twoFullSetsAsStar] else
    options := [twoFullSetsAsStar];
  SaveJSON(Value,TypeInfo,options,result);
end;

type
  /// information about one customized JSON serialization
  TJSONCustomParserRegistration = record
    RecordTypeName: RawUTF8;
    RecordTextDefinition: RawUTF8;
    DynArrayTypeInfo: pointer;
    RecordTypeInfo: pointer;
    Reader: TDynArrayJSONCustomReader;
    Writer: TDynArrayJSONCustomWriter;
    RecordCustomParser: TJSONRecordAbstract;
  end;
  PJSONCustomParserRegistration = ^TJSONCustomParserRegistration;
  TJSONCustomParserRegistrations = array of TJSONCustomParserRegistration;

  PTJSONCustomParserAbstract = ^TJSONRecordAbstract;

  /// used internally to manage custom record / dynamic array JSON serialization
  // - e.g. used by TTextWriter.RegisterCustomJSONSerializer*()
  TJSONCustomParsers = class
  protected
    fLastDynArrayIndex: integer;
    fLastRecordIndex: integer;
    fParser: TJSONCustomParserRegistrations;
    fParsersCount: Integer;
    fParsers: TDynArrayHashed;
    {$ifndef NOVARIANTS}
    fVariants: array of record
      TypeClass: TCustomVariantType;
      Reader: TDynArrayJSONCustomReader;
      Writer: TDynArrayJSONCustomWriter;
    end;
    function VariantSearch(aClass: TCustomVariantType): integer;
    procedure VariantWrite(aClass: TCustomVariantType;
      aWriter: TTextWriter; const aValue: variant; Escape: TTextWriterKind);
    {$endif}
    function TryToGetFromRTTI(aDynArrayTypeInfo, aRecordTypeInfo: pointer): integer;
    function Search(aTypeInfo: pointer; var Reg: TJSONCustomParserRegistration;
      AddIfNotExisting: boolean): integer;
    function DynArraySearch(aDynArrayTypeInfo, aRecordTypeInfo: pointer;
      AddIfNotExisting: boolean=true): integer; overload;
    function RecordSearch(aRecordTypeInfo: pointer;
      AddIfNotExisting: boolean=true): integer; overload;
    function RecordSearch(aRecordTypeInfo: pointer;
      out Reader: TDynArrayJSONCustomReader): boolean; overload;
    function RecordSearch(aRecordTypeInfo: pointer;
      out Writer: TDynArrayJSONCustomWriter; PParser: PTJSONCustomParserAbstract): boolean; overload;
    function RecordSearch(const aTypeName: RawUTF8): integer; overload;
    function RecordRTTITextHash(aRecordTypeInfo: pointer; var crc: cardinal;
      out recsize: integer): boolean;
  public
    constructor Create;
    procedure RegisterCallbacks(aTypeInfo: pointer;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    function RegisterFromText(aTypeInfo: pointer;
      const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
    {$ifndef NOVARIANTS}
    procedure RegisterCallbacksVariant(aClass: TCustomVariantType;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    {$endif}
    property Parser: TJSONCustomParserRegistrations read fParser;
    property ParsersCount: Integer read fParsersCount;
  end;

var
  GlobalJSONCustomParsers: TJSONCustomParsers;

constructor TJSONCustomParsers.Create;
begin
  fParsers.InitSpecific(TypeInfo(TJSONCustomParserRegistrations),
    fParser,djRawUTF8,@fParsersCount,true);
  GarbageCollectorFreeAndNil(GlobalJSONCustomParsers,self);
end;

function TJSONCustomParsers.TryToGetFromRTTI(aDynArrayTypeInfo,
  aRecordTypeInfo: pointer): integer;
var Reg: TJSONCustomParserRegistration;
    RegRoot: TJSONCustomParserRTTI;
    {$ifdef ISDELPHI2010}
    info: PTypeInfo;
    {$endif}
    added: boolean;
    ndx, len: integer;
    name: PShortString;
begin
  result := -1;
  Reg.RecordTypeInfo := aRecordTypeInfo;
  Reg.DynArrayTypeInfo := aDynArrayTypeInfo;
  TypeInfoToName(Reg.RecordTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then begin
    name := TypeInfoToShortString(Reg.DynArrayTypeInfo);
    if name=nil then
      exit; // we need a type name!
    len := length(name^); // try to guess from T*DynArray or T*s names
    if (len>12) and (IdemPropName('DynArray',@name^[len-7],8)) then
      FastSetString(Reg.RecordTypeName,@name^[1],len-8) else
    if (len>3) and (name^[len]='s') then
      FastSetString(Reg.RecordTypeName,@name^[1],len-1) else
      exit;
  end;
  RegRoot := TJSONCustomParserRTTI.CreateFromTypeName('',Reg.RecordTypeName);
  {$ifdef ISDELPHI2010}
  if RegRoot=nil then begin
    info := GetTypeInfo(aRecordTypeInfo,tkRecordKinds);
    if info=nil then
      exit; // not enough RTTI
    inc(PByte(info),info^.ManagedCount*SizeOf(TFieldInfo)-SizeOf(TFieldInfo));
    inc(PByte(info),info^.NumOps*SizeOf(pointer)); // jump RecOps[]
    if info^.AllCount=0 then
      exit; // not enough RTTI -> avoid exception in constructor below
  end;
  {$else}
  if RegRoot=nil then
    exit; // not enough RTTI for older versions of Delphi
  {$endif}
  Reg.RecordCustomParser := TJSONRecordRTTI.Create(Reg.RecordTypeInfo,RegRoot);
  Reg.Reader := Reg.RecordCustomParser.CustomReader;
  Reg.Writer := Reg.RecordCustomParser.CustomWriter;
  if self=nil then
    if GlobalJSONCustomParsers<>nil then // may have been set just above
      self := GlobalJSONCustomParsers else
      self := TJSONCustomParsers.Create;
  ndx := fParsers.FindHashedForAdding(Reg.RecordTypeName,added);
  if not added then
    exit; // name should be unique
  fParser[ndx] := Reg;
  result := ndx;
end;

function TJSONCustomParsers.DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo: pointer;
  AddIfNotExisting: boolean): Integer;
var threadsafe: integer;
    parser: PJSONCustomParserRegistration;
begin // O(n) brute force is fast enough, since n remains small (mostly<64)
  if self<>nil then
  if (aDynArrayTypeInfo<>nil) and (fParsersCount<>0) then begin
    threadsafe := fLastDynArrayIndex;
    if (cardinal(threadsafe)<cardinal(fParsersCount)) and
       (fParser[threadsafe].DynArrayTypeInfo=aDynArrayTypeInfo) then begin
      result := threadsafe;
      exit;
    end else begin
      if aRecordTypeInfo=nil then // record RTTI not specified: guess now
        aRecordTypeInfo := DynArrayTypeInfoToRecordInfo(aDynArrayTypeInfo);
      if aRecordTypeInfo=nil then begin
        parser := pointer(fParser);
        for result := 0 to fParsersCount-1 do
          if parser^.DynArrayTypeInfo=aDynArrayTypeInfo then begin
            fLastDynArrayIndex := result;
            exit;
          end else
          inc(parser);
      end else begin
        threadsafe := fLastRecordIndex;
        if (cardinal(threadsafe)<cardinal(fParsersCount)) and
           (fParser[threadsafe].RecordTypeInfo=aRecordTypeInfo) then begin
          result := threadsafe;
          exit;
        end else begin
          parser := pointer(fParser);
          for result := 0 to fParsersCount-1 do
            if (parser^.DynArrayTypeInfo=aDynArrayTypeInfo) or
               (parser^.RecordTypeInfo=aRecordTypeInfo) then begin
              fLastDynArrayIndex := result;
              fLastRecordIndex := result;
              exit;
            end else
            inc(parser);
        end;
      end;
    end;
  end;
  if AddIfNotExisting then begin
    result := TryToGetFromRTTI(aDynArrayTypeInfo,aRecordTypeInfo);
    if result>=0 then
      fLastRecordIndex := result;
  end else
    result := -1;
end;

function TJSONCustomParsers.RecordSearch(aRecordTypeInfo: pointer;
  AddIfNotExisting: boolean): integer;
begin
  if aRecordTypeInfo=nil then begin
    result := -1;
    exit;
  end;
  if self<>nil then
    if (cardinal(fLastRecordIndex)<cardinal(fParsersCount)) and
       (fParser[fLastRecordIndex].RecordTypeInfo=aRecordTypeInfo) then begin
      result := fLastRecordIndex;
      exit;
    end else
    for result := 0 to fParsersCount-1 do
      if fParser[result].RecordTypeInfo=aRecordTypeInfo then begin
        fLastRecordIndex := result;
        exit;
      end;
  if AddIfNotExisting then begin
    result := TryToGetFromRTTI(nil,aRecordTypeInfo);
    if result>=0 then
      fLastRecordIndex := result;
  end else
    result := -1;
end;

function TJSONCustomParsers.RecordSearch(const aTypeName: RawUTF8): integer;
begin
  if self=nil then
    result := -1 else
    if (cardinal(fLastRecordIndex)<cardinal(fParsersCount)) and
       IdemPropNameU(fParser[fLastRecordIndex].RecordTypeName,aTypeName) then
      result := fLastRecordIndex else begin
      result := fParsers.FindHashed(aTypeName);
      if result>=0 then
        fLastRecordIndex := result;
    end;
end;

function TJSONCustomParsers.RecordSearch(aRecordTypeInfo: pointer;
  out Reader: TDynArrayJSONCustomReader): boolean;
var ndx: integer;
begin
  ndx := RecordSearch(aRecordTypeInfo);
  if (ndx>=0) and Assigned(fParser[ndx].Reader) then begin
    Reader := fParser[ndx].Reader;
    result := true;
  end else
    result := false;
end;

function TJSONCustomParsers.RecordRTTITextHash(aRecordTypeInfo: pointer;
  var crc: cardinal; out recsize: integer): boolean;
var ndx: integer;
begin
  if (self<>nil) and (aRecordTypeInfo<>nil) then
  for ndx := 0 to fParsersCount-1 do
    with fParser[ndx] do
    if RecordTypeInfo=aRecordTypeInfo then begin
      if RecordTextDefinition='' then
        break;
      crc := crc32c(crc,pointer(RecordTextDefinition),length(RecordTextDefinition));
      recsize := RecordTypeInfoSize(aRecordTypeInfo);
      result := true;
      exit;
    end;
  result := false;
end;

function TJSONCustomParsers.RecordSearch(aRecordTypeInfo: pointer;
  out Writer: TDynArrayJSONCustomWriter; PParser: PTJSONCustomParserAbstract): boolean;
var ndx: integer;
begin
  result := false;
  ndx := RecordSearch(aRecordTypeInfo);
  if (ndx>=0) and Assigned(fParser[ndx].Writer) then begin
    Writer := fParser[ndx].Writer;
    if PParser<>nil then
      PParser^ := fParser[ndx].RecordCustomParser;
    result := true;
  end;
end;

function TJSONCustomParsers.Search(aTypeInfo: pointer;
  var Reg: TJSONCustomParserRegistration; AddIfNotExisting: boolean): integer;
var added: boolean;
begin
  if (aTypeInfo=nil) or (self=nil) then
    raise ESynException.CreateUTF8('%.Search(%)',[self,aTypeInfo]);
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(Reg,SizeOf(Reg),0);
  case PTypeKind(aTypeInfo)^ of
  tkDynArray: begin
    Reg.DynArrayTypeInfo := aTypeInfo;
    Reg.RecordTypeInfo := DynArrayTypeInfoToRecordInfo(aTypeInfo);
    result := DynArraySearch(Reg.DynArrayTypeInfo,Reg.RecordTypeInfo,false);
  end;
  tkRecord{$ifdef FPC},tkObject{$endif}: begin
    Reg.DynArrayTypeInfo := nil;
    Reg.RecordTypeInfo := aTypeInfo;
    result := RecordSearch(Reg.RecordTypeInfo,false);
  end;
  else raise ESynException.CreateUTF8('%.Search: % not a tkDynArray/tkRecord',
    [self,ToText(PTypeKind(aTypeInfo)^)^]);
  end;
  if not AddIfNotExisting then
    exit;
  TypeInfoToName(Reg.RecordTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then
    TypeInfoToName(Reg.DynArrayTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then
    raise ESynException.CreateUTF8('%.Search(%) has no type name',[self,aTypeInfo]);
  if result<0 then
    result := fParsers.FindHashedForAdding(Reg.RecordTypeName,added);
end;

{$ifndef NOVARIANTS}
function TJSONCustomParsers.VariantSearch(aClass: TCustomVariantType): integer;
begin
  if self<>nil then
    for result := 0 to length(fVariants)-1 do
      if fVariants[result].TypeClass=aClass then
        exit;
  result := -1;
end;

procedure TJSONCustomParsers.VariantWrite(aClass: TCustomVariantType;
  aWriter: TTextWriter; const aValue: variant; Escape: TTextWriterKind);
var ndx: integer;
    temp: string;
begin
  ndx := VariantSearch(aClass);
  if (ndx>=0) and Assigned(fVariants[ndx].Writer) then
    fVariants[ndx].Writer(aWriter,aValue) else begin
    temp := aValue; // fallback to JSON string from variant-to-string conversion
    if Escape=twJSONEscape then
      aWriter.Add('"');
    {$ifdef UNICODE}
    aWriter.AddW(pointer(temp),length(temp),Escape);
    {$else}
    aWriter.AddAnsiString(temp,Escape);
    {$endif}
    if Escape=twJSONEscape then
      aWriter.Add('"');
  end;
end;

procedure TJSONCustomParsers.RegisterCallbacksVariant(aClass: TCustomVariantType;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var ndx: integer;
begin
  if self=nil then
    self := TJSONCustomParsers.Create;
  ndx := VariantSearch(aClass);
  if ndx<0 then begin
    ndx := length(fVariants);
    SetLength(fVariants,ndx+1);
    fVariants[ndx].TypeClass := aClass;
  end;
  fVariants[ndx].Writer := aWriter;
  fVariants[ndx].Reader := aReader;
end;
{$endif}

procedure TJSONCustomParsers.RegisterCallbacks(aTypeInfo: pointer;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var Reg: TJSONCustomParserRegistration;
    ForAdding: boolean;
    ndx: integer;
begin
  if self=nil then
    self := TJSONCustomParsers.Create;
  ForAdding := Assigned(aReader) or Assigned(aWriter);
  ndx := Search(aTypeInfo,Reg,ForAdding);
  if ForAdding then begin
    Reg.Writer := aWriter;
    Reg.Reader := aReader;
    fParser[ndx] := Reg;
  end else
    if ndx>=0 then begin
      fParsers.Delete(ndx);
      fParsers.ReHash;
    end;
end;

function TJSONCustomParsers.RegisterFromText(aTypeInfo: pointer;
  const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
var Reg: TJSONCustomParserRegistration;
    ForAdding: boolean;
    ndx: integer;
begin
  if self=nil then
    self := TJSONCustomParsers.Create;
  ForAdding := aRTTIDefinition<>'';
  ndx := Search(aTypeInfo,Reg,ForAdding);
  if ForAdding then begin
    result := TJSONRecordTextDefinition.FromCache(Reg.RecordTypeInfo,aRTTIDefinition);
    Reg.RecordTextDefinition := aRTTIDefinition;
    Reg.Reader := result.CustomReader;
    Reg.Writer := result.CustomWriter;
    Reg.RecordCustomParser := result;
    fParser[ndx] := Reg;
  end else begin
    result := nil;
    if ndx>=0 then begin
      fParsers.Delete(ndx);
      fParsers.ReHash;
    end;
  end;
end;

function ManagedTypeSaveRTTIHash(info: PTypeInfo; var crc: cardinal): integer;
var itemtype: PTypeInfo;
    i, unmanagedsize: integer;
    field: PFieldInfo;
    dynarray: TDynArray;
begin // info is expected to come from a DeRef() if retrieved from RTTI
  result := 0;
  if info=nil then
    exit;
  {$ifdef FPC} // storage binary layout as Delphi's ordinal value
  crc := crc32c(crc,@FPCTODELPHI[info^.Kind],1);
  {$else}
  crc := crc32c(crc,@info^.Kind,1); // hash RTTI kind, but not name
  {$endif}
  case info^.Kind of // handle nested RTTI
  tkLString,{$ifdef FPC}tkLStringOld,{$endif}{$ifdef HASVARUSTRING}tkUString,{$endif}
  tkWString,tkInterface:
    result := SizeOf(pointer);
  {$ifndef NOVARIANTS}
  tkVariant:
    result := SizeOf(variant);
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}: // first search from custom RTTI text
    if not GlobalJSONCustomParsers.RecordRTTITextHash(info,crc,result) then begin
      itemtype := GetTypeInfo(info,tkRecordKinds);
      if itemtype<>nil then begin
        unmanagedsize := itemtype^.recsize;
        for i := 1 to GetManagedFields(itemtype,field) do begin
          info := DeRef(field^.TypeInfo);
          {$ifdef FPC_OLDRTTI} // old FPC did include RTTI for unmanaged fields
          if info^.Kind in tkManagedTypes then // as with Delphi
          {$endif}
            dec(unmanagedsize,ManagedTypeSaveRTTIHash(info,crc));
          inc(field);
        end;
        crc := crc32c(crc,@unmanagedsize,4);
        result := itemtype^.recSize;
      end;
  end;
  tkArray: begin
    itemtype := ArrayItemType(info,result);
    if info=nil then
      exit;
    unmanagedsize := result;
    if itemtype<>nil then
      for i := 1 to info^.elCount do
        dec(unmanagedsize,ManagedTypeSaveRTTIHash(itemtype,crc));
    crc := crc32c(crc,@unmanagedsize,4);
  end;
  tkDynArray: begin
    dynarray.Init(info,field); // fake void array pointer
    crc := dynarray.SaveToTypeInfoHash(crc);
    result := SizeOf(pointer);
  end;
  end;
end;

function TypeInfoToHash(aTypeInfo: pointer): cardinal;
begin
  result := 0;
  ManagedTypeSaveRTTIHash(aTypeInfo,result);
end;

function RecordSaveJSON(const Rec; TypeInfo: pointer; EnumSetsAsText: boolean): RawUTF8;
begin
  result := SaveJSON(Rec,TypeInfo,EnumSetsAsText);
end;

const
  NULCHAR: AnsiChar = #0;

function RecordLoadJSON(var Rec; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char;
var wasString, wasValid: boolean;
    Reader: TDynArrayJSONCustomReader;
    FirstChar,EndOfObj: AnsiChar;
    Val: PUTF8Char;
    ValLen: integer;
begin // code below must match TTextWriter.AddRecordJSON
  result := nil; // indicates error
  if JSON=nil then
    exit;
  if (@Rec=nil) or (TypeInfo=nil) then
    raise ESynException.CreateUTF8('Invalid RecordLoadJSON(%) call',[TypeInfo]);
  if JSON^=' ' then repeat inc(JSON); if JSON^=#0 then exit; until JSON^<>' ';
  if PCardinal(JSON)^=JSON_BASE64_MAGIC_QUOTE then begin
    if not (PTypeKind(TypeInfo)^ in tkRecordTypes) then
      raise ESynException.CreateUTF8('RecordLoadJSON(%/%)',
        [PShortString(@PTypeInfo(TypeInfo).NameLen)^,ToText(PTypeKind(TypeInfo)^)^]);
    Val := GetJSONField(JSON,JSON,@wasString,@EndOfObj,@ValLen);
    if (Val=nil) or not wasString or (ValLen<3) or
       (PInteger(Val)^ and $00ffffff<>JSON_BASE64_MAGIC) or
       (RecordLoad(Rec,pointer(Base64ToBin(PAnsiChar(Val)+3,ValLen-3)),TypeInfo)=nil) then
      exit; // invalid content
  end else begin
    if not GlobalJSONCustomParsers.RecordSearch(TypeInfo,Reader) then
      exit;
    FirstChar := JSON^;
    JSON := Reader(JSON,Rec,wasValid);
    if not wasValid then
      exit;
    if (JSON<>nil) and (JSON^ in [#1..' ']) then
      repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if (JSON<>nil) and (JSON^<>#0) then
      if FirstChar='"' then // special case e.g. for TGUID string
        EndOfObj := FirstChar else begin
        EndOfObj := JSON^;
        inc(JSON);
      end else
      EndOfObj := #0;
  end;
  if JSON=nil then // end reached, but valid content decoded
    result := @NULCHAR else
    result := JSON;
  if EndOfObject<>nil then
    EndOfObject^ := EndOfObj;
end;

function RecordLoadJSON(var Rec; const JSON: RawUTF8; TypeInfo: pointer): boolean;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    result := RecordLoadJSON(Rec,tmp.buf,TypeInfo)<>nil;
  finally
    tmp.Done;
  end;
end;


{ TJSONCustomParserCustom }

constructor TJSONCustomParserCustom.Create(const aPropertyName, aCustomTypeName: RawUTF8);
begin
  inherited Create(aPropertyName,ptCustom);
  fCustomTypeName := aCustomTypeName;
end;

procedure TJSONCustomParserCustom.FinalizeItem(Data: Pointer);
begin // nothing to be done by default
end;


{ TJSONCustomParserCustomSimple }

constructor TJSONCustomParserCustomSimple.Create(
  const aPropertyName, aCustomTypeName: RawUTF8; aCustomType: pointer);
var info: PTypeInfo;
    kind: TTypeKind;
begin
  inherited Create(aPropertyName,aCustomTypeName);
  fCustomTypeInfo := aCustomType;
  if IdemPropNameU(aCustomTypeName,'TGUID') then begin
    fKnownType := ktGUID;
    fDataSize := SizeOf(TGUID);
  end else
  if fCustomTypeInfo<>nil then begin
    TypeInfoToName(fCustomTypeInfo,fCustomTypeName,aCustomTypeName);
    kind := PTypeKind(fCustomTypeInfo)^;
    info := GetTypeInfo(fCustomTypeInfo,[tkEnumeration,tkSet,tkArray,tkDynArray]);
    fTypeData := info;
    if info<>nil then
    case kind of
    tkEnumeration, tkSet: begin
      case info^.EnumType of
        otSByte,otUByte: fDataSize := 1;
        otSWord,otUWord: fDataSize := 2;
        otSLong,otULong: fDataSize := 4;
        {$ifdef FPC_NEWRTTI}
        otSQWord,otUQWord: fDataSize := 8;
        {$endif}
      end;
      if kind=tkEnumeration then
        fKnownType := ktEnumeration else
        fKnownType := ktSet;
      exit; // success
    end;
    tkArray: begin
      if info^.dimCount<>1 then
        raise ESynException.CreateUTF8('%.Create("%") supports only single '+
          'dimension static array)',[self,fCustomTypeName]);
      fKnownType := ktStaticArray;
      {$ifdef VER2_6}
      fFixedSize := info^.arraySize; // is elSize in fact
      fDataSize := fFixedSize*info^.elCount;
      {$else}
      fDataSize := info^.arraySize;
      fFixedSize := fDataSize div info^.elCount;
      {$endif}
      fNestedArray := TJSONCustomParserRTTI.CreateFromRTTI(
        '',Deref(info^.arrayType),fFixedSize);
      exit; // success
    end;
    tkDynArray: begin
      fKnownType := ktDynamicArray;
      exit; // success
    end;
    end;
    raise ESynException.CreateUTF8('%.Create("%") unsupported type: % (%)',
      [self,fCustomTypeName,ToText(kind)^,ord(kind)]);
  end;
end;

constructor TJSONCustomParserCustomSimple.CreateFixedArray(
  const aPropertyName: RawUTF8; aFixedSize: cardinal);
begin
  inherited Create(aPropertyName,FormatUTF8('Fixed%Byte',[aFixedSize]));
  fKnownType := ktFixedArray;
  fFixedSize := aFixedSize;
  fDataSize := aFixedSize;
end;

constructor TJSONCustomParserCustomSimple.CreateBinary(
  const aPropertyName: RawUTF8; aDataSize, aFixedSize: cardinal);
begin
  inherited Create(aPropertyName,FormatUTF8('BinHex%Byte',[aFixedSize]));
  fKnownType := ktBinary;
  fFixedSize := aFixedSize;
  fDataSize := aDataSize;
end;

destructor TJSONCustomParserCustomSimple.Destroy;
begin
  inherited;
  fNestedArray.Free;
end;

procedure TJSONCustomParserCustomSimple.CustomWriter(
  const aWriter: TTextWriter; const aValue);
var i: integer;
    V: PByte;
begin
  case fKnownType of
  ktStaticArray: begin
    aWriter.Add('[');
    V := @aValue;
    for i := 1 to PTypeInfo(fTypeData)^.elCount do begin
      fNestedArray.WriteOneLevel(aWriter,V,[]);
      aWriter.Add(',');
    end;
    aWriter.CancelLastComma;
    aWriter.Add(']');
  end;
  ktEnumeration, ktSet:
    aWriter.AddTypedJSON(fCustomTypeInfo,aValue);
  ktDynamicArray:
    raise ESynException.CreateUTF8('%.CustomWriter("%"): unsupported',
        [self,fCustomTypeName]);
  ktBinary:
    if (fFixedSize<=SizeOf(QWord)) and IsZero(@aValue,fFixedSize) then
      aWriter.AddShort('""') else // 0 -> ""
      aWriter.AddBinToHexDisplayQuoted(@aValue,fFixedSize);
  else begin // encoded as JSON strings
    aWriter.Add('"');
    case fKnownType of
    ktGUID:
      aWriter.Add(TGUID(aValue));
    ktFixedArray:
      aWriter.AddBinToHex(@aValue,fFixedSize);
    end;
    aWriter.Add('"');
  end;
  end;
end;

function TJSONCustomParserCustomSimple.CustomReader(P: PUTF8Char;
  var aValue; out EndOfObject: AnsiChar): PUTF8Char;
var PropValue: PUTF8Char;
    i, PropValueLen, i32: integer;
    u64: QWord;
    wasString: boolean;
    Val: PByte;
begin
  result := nil; // indicates error
  case fKnownType of
  ktStaticArray: begin
    if P^<>'[' then
      exit; // we expect a true array here
    P := GotoNextNotSpace(P+1);
    if JSONArrayCount(P)<>PTypeInfo(fTypeData)^.elCount then
      exit; // invalid number of items
    Val := @aValue;
    for i := 1 to PTypeInfo(fTypeData)^.elCount do
      if not fNestedArray.ReadOneLevel(P,Val,[]) then
        exit else
      if P=nil then
        exit;
    P := GotoNextNotSpace(P);
    EndOfObject := P^;
    if P^ in [',','}'] then
      inc(P);
    result := P;
  end;
  ktDynamicArray:
    raise ESynException.CreateUTF8('%.CustomReader("%"): unsupported',
        [self,fCustomTypeName]);
  ktSet: begin
    i32 := GetSetNameValue(fCustomTypeInfo,P,EndOfObject);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(i32,aValue,fDataSize);
    result := P;
  end;
  else begin // encoded as JSON strings or number
    PropValue := GetJSONField(P,P,@wasString,@EndOfObject,@PropValueLen);
    if PropValue=nil then
      exit; // not a JSON string or number
    if P=nil then // result=nil=error + caller may dec(P); P^:=EndOfObject;
      P := PropValue+PropValueLen;
    case fKnownType of
    ktGUID:
      if wasString and (TextToGUID(PropValue,@aValue)<>nil) then
        result := P;
    ktEnumeration: begin
      if wasString then
        i32 := GetEnumNameValue(fCustomTypeInfo,PropValue,PropValueLen,true) else
        i32 := GetCardinal(PropValue);
      if i32<0 then
        exit;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(i32,aValue,fDataSize);
      result := P;
    end;
    ktFixedArray:
      if wasString and (PropValueLen=fFixedSize*2) and
         SynCommons.HexToBin(PAnsiChar(PropValue),@aValue,fFixedSize) then
        result := P;
    ktBinary:
      if wasString then begin // default hexa serialization
        {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(aValue,fDataSize,0);
        if (PropValueLen=0) or ((PropValueLen=fFixedSize*2) and
           HexDisplayToBin(PAnsiChar(PropValue),@aValue,fFixedSize)) then
          result := P;
      end else
        if fFixedSize<=SizeOf(u64) then begin // allow integer serialization
          SetQWord(PropValue,u64);
          {$ifdef FPC}Move{$else}MoveFast{$endif}(u64,aValue,fDataSize);
          result := P;
        end;
    end;
  end;
  end;
end;


{ TJSONCustomParserCustomRecord }

constructor TJSONCustomParserCustomRecord.Create(
  const aPropertyName: RawUTF8; aCustomTypeIndex: integer);
begin
  fCustomTypeIndex := aCustomTypeIndex;
  with GlobalJSONCustomParsers.fParser[fCustomTypeIndex] do begin
    inherited Create(aPropertyName,RecordTypeName);
    fCustomTypeInfo := RecordTypeInfo;
    fCustomTypeName := RecordTypeName;
  end;
  fDataSize := RecordTypeInfoSize(fCustomTypeInfo);
end;

function TJSONCustomParserCustomRecord.GetJSONCustomParserRegistration: pointer;
begin
  result := nil;
  if GlobalJSONCustomParsers<>nil then begin
    if (Cardinal(fCustomTypeIndex)>=Cardinal(GlobalJSONCustomParsers.fParsersCount)) or
       not IdemPropNameU(fCustomTypeName,
         GlobalJSONCustomParsers.fParser[fCustomTypeIndex].RecordTypeName) then
      fCustomTypeIndex := GlobalJSONCustomParsers.RecordSearch(fCustomTypeInfo);
    if fCustomTypeIndex>=0 then
      result := @GlobalJSONCustomParsers.fParser[fCustomTypeIndex];
  end;
  if result=nil then
    raise ESynException.CreateUTF8(
      '%: "%" type should not have been un-registered',[self,fCustomTypeName]);
end;

procedure TJSONCustomParserCustomRecord.CustomWriter(
  const aWriter: TTextWriter; const aValue);
var parser: PJSONCustomParserRegistration;
begin
  parser := GetJSONCustomParserRegistration;
  parser^.Writer(aWriter,aValue);
end;

function TJSONCustomParserCustomRecord.CustomReader(P: PUTF8Char;
  var aValue; out EndOfObject: AnsiChar): PUTF8Char;
var valid: boolean;
    callback: PJSONCustomParserRegistration; // D5/D6 Internal error: C3890
begin
  callback := GetJSONCustomParserRegistration;
  result := callback^.Reader(P,aValue,valid);
  if not valid then
    result := nil;
  if result=nil then
    exit;
  EndOfObject := result^;
  if result^ in [',','}',']'] then
    inc(result);
end;

procedure TJSONCustomParserCustomRecord.FinalizeItem(Data: Pointer);
begin
  RecordClear(Data^,fCustomTypeInfo);
end;


{ TJSONCustomParserRTTI }

type
  TJSONSerializerFromTextSimple = record
    TypeInfo: pointer;
    BinaryDataSize, BinaryFieldSize: integer;
  end;
  TJSONSerializerFromTextSimpleDynArray = array of TJSONSerializerFromTextSimple;
var // RawUTF8/TJSONSerializerFromTextSimpleDynArray
  GlobalCustomJSONSerializerFromTextSimpleType: TSynDictionary;

procedure JSONSerializerFromTextSimpleTypeAdd(aTypeName: RawUTF8;
  aTypeInfo: pointer; aDataSize, aFieldSize: integer);
var simple: TJSONSerializerFromTextSimple;
begin
  if aTypeName='' then
    TypeInfoToName(aTypeInfo,aTypeName);
  if aDataSize<>0 then
    if aFieldSize>aDataSize then
      raise ESynException.CreateUTF8('JSONSerializerFromTextSimpleTypeAdd(%) fieldsize=%>%',
        [aTypeName,aFieldSize,aDataSize]) else
    if aFieldSize=0 then
      aFieldSize := aDataSize; // not truncated
  simple.TypeInfo := aTypeInfo;
  simple.BinaryDataSize := aDataSize;
  simple.BinaryFieldSize := aFieldSize;
  UpperCaseSelf(aTypeName);
  if GlobalCustomJSONSerializerFromTextSimpleType.Add(aTypeName,simple)<0 then
    raise ESynException.CreateUTF8('JSONSerializerFromTextSimpleTypeAdd(%) duplicated', [aTypeName]);
end;

/// if defined, will try to mimic the default record alignment
// -> is buggy, and compiler revision specific -> we would rather use packed records
{.$define ALIGNCUSTOMREC}

constructor TJSONCustomParserRTTI.Create(const aPropertyName: RawUTF8;
  aPropertyType: TJSONCustomParserRTTIType);
begin
  fPropertyName := aPropertyName;
  fPropertyType := aPropertyType;
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(TypeName: PUTF8Char;
  TypeNameLen: Integer; var ItemTypeName: RawUTF8): TJSONCustomParserRTTIType;
const
  SORTEDMAX = {$ifdef NOVARIANTS}32{$else}33{$endif};
  SORTEDNAMES: array[0..SORTEDMAX] of PUTF8Char =
    ('ARRAY','BOOLEAN','BYTE','CARDINAL','CURRENCY',
     'DOUBLE','EXTENDED','INT64','INTEGER','PTRINT','PTRUINT','QWORD',
     'RAWBYTESTRING','RAWJSON','RAWUTF8','RECORD','SINGLE',
     'STRING','SYNUNICODE','TCREATETIME','TDATETIME','TDATETIMEMS','TGUID',
     'TID','TMODTIME','TRECORDREFERENCE','TRECORDREFERENCETOBEDELETED',
     'TRECORDVERSION','TSQLRAWBLOB','TTIMELOG','UTF8STRING',
     {$ifndef NOVARIANTS}'VARIANT',{$endif}
     'WIDESTRING','WORD');
   // warning: recognized types should match at binary storage level!
   SORTEDTYPES: array[0..SORTEDMAX] of TJSONCustomParserRTTIType =
     (ptArray,ptBoolean,ptByte,ptCardinal,ptCurrency,
      ptDouble,ptExtended,ptInt64,ptInteger,ptPtrInt,ptPtrUInt,ptQWord,
      ptRawByteString,ptRawJSON,ptRawUTF8,ptRecord,ptSingle,
      ptString,ptSynUnicode,ptTimeLog,ptDateTime,ptDateTimeMS,ptGUID,
      ptID,ptTimeLog,ptInt64,ptInt64,
      ptInt64,ptRawByteString,ptTimeLog,ptRawUTF8,
      {$ifndef NOVARIANTS}ptVariant,{$endif}
      ptWideString,ptWord);
var ndx: integer;
begin
  UpperCaseCopy(TypeName,TypeNameLen,ItemTypeName);
//for ndx := 1 to SORTEDMAX do assert(StrComp(SORTEDNAMES[ndx],SORTEDNAMES[ndx-1])>0,SORTEDNAMES[ndx]);
  ndx := FastFindPUTF8CharSorted(@SORTEDNAMES,SORTEDMAX,pointer(ItemTypeName));
  if ndx>=0 then
    result := SORTEDTYPES[ndx] else
    result := ptCustom;
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
  const TypeName: RawUTF8): TJSONCustomParserRTTIType;
var ItemTypeName: RawUTF8;
begin
  if TypeName='' then
    result := ptCustom else
    result := TypeNameToSimpleRTTIType(Pointer(TypeName),length(TypeName),ItemTypeName);
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
  TypeName: PShortString): TJSONCustomParserRTTIType;
var ItemTypeName: RawUTF8;
begin
  if TypeName=nil then
    result := ptCustom else
    result := TypeNameToSimpleRTTIType(@TypeName^[1],Ord(TypeName^[0]),ItemTypeName);
end;

class function TJSONCustomParserRTTI.TypeInfoToSimpleRTTIType(Info: pointer;
  ItemSize: integer): TJSONCustomParserRTTIType;
begin
  result := ptCustom;
  if Info=nil then
    exit;
  case PTypeKind(Info)^ of
  tkLString{$ifdef FPC},tkLStringOld{$endif}: result := ptRawUTF8;
  tkWString: result := ptWideString;
  {$ifdef UNICODE}
  tkUString: result := ptSynUnicode;
  tkClassRef, tkPointer, tkProcedure:
    case ItemSize of
    1: result := ptByte;
    2: result := ptWord;
    4: result := ptCardinal;
    8: result := ptQWord;
    else result := ptPtrInt;
    end;
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant: result := ptVariant;
  {$endif}
  tkDynArray: result := ptArray;
  tkChar: result := ptByte;
  tkWChar: result := ptWord;
  tkClass, tkMethod, tkInterface: result := ptPtrInt;
  tkInteger:
    case GetTypeInfo(Info)^.IntegerType of
    otSByte,otUByte: result := ptByte;
    otSWord,otUWord: result := ptWord;
    otSLong: result := ptInteger;
    otULong: result := ptCardinal;
    {$ifdef FPC_NEWRTTI}
    otSQWord: result := ptInt64;
    otUQWord: result := ptQWord;
    {$endif}
    end;
  tkInt64:
    {$ifndef FPC} if Info=TypeInfo(QWord) then result := ptQWord else
      {$ifdef UNICODE}with GetTypeInfo(Info)^ do // detect QWord/UInt64
      if MinInt64Value>MaxInt64Value then result := ptQWord else{$endif}{$endif}
      result := ptInt64;
  {$ifdef FPC}
  tkQWord: result := ptQWord;
  tkBool:  result := ptBoolean;
  {$else}
  tkEnumeration:
    if Info=TypeInfo(boolean) then
      result := ptBoolean;
      // other enumerates (or tkSet) will use TJSONCustomParserCustomSimple
  {$endif}
  tkFloat:
    case GetTypeInfo(Info)^.FloatType of
    ftSingle:   result := ptSingle;
    ftDoub:     result := ptDouble;
    ftCurr:     result := ptCurrency;
    ftExtended: result := ptExtended;
    // ftComp: not implemented yet
    end;
  end;
end;

class function TJSONCustomParserRTTI.TypeNameToSimpleBinary(const aTypeName: RawUTF8;
  out aDataSize, aFieldSize: integer): boolean;
var simple: ^TJSONSerializerFromTextSimple;
begin
  simple := GlobalCustomJSONSerializerFromTextSimpleType.FindValue(aTypeName);
  if (simple<>nil) and (simple^.BinaryFieldSize<>0) then begin
    aDataSize := simple^.BinaryDataSize;
    aFieldSize := simple^.BinaryFieldSize;
    result := true;
  end else
    result := false;
end;

class function TJSONCustomParserRTTI.CreateFromRTTI(
  const PropertyName: RawUTF8; Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
var Item: PTypeInfo absolute Info;
    ItemType: TJSONCustomParserRTTIType;
    ItemTypeName: RawUTF8;
    ndx: integer;
begin
  if Item=nil then // no RTTI -> stored as hexa string
    result := TJSONCustomParserCustomSimple.CreateFixedArray(PropertyName,ItemSize) else begin
    ItemType := TypeNameToSimpleRTTIType(PUTF8Char(@Item.NameLen)+1,Item.NameLen,ItemTypeName);
    if ItemType=ptCustom then
      ItemType := TypeInfoToSimpleRTTIType(Info,ItemSize);
    if ItemType=ptCustom then
      if Item^.kind in [tkEnumeration,tkArray,tkDynArray,tkSet] then
        result := TJSONCustomParserCustomSimple.Create(
          PropertyName,ItemTypeName,Item) else begin
        ndx := GlobalJSONCustomParsers.RecordSearch(Item);
        if ndx<0 then
          ndx := GlobalJSONCustomParsers.RecordSearch(ItemTypeName);
        if ndx<0 then
          raise ESynException.CreateUTF8('%.CreateFromRTTI("%") unsupported %',
            [self,ItemTypeName,ToText(Item^.kind)^]);
        result := TJSONCustomParserCustomRecord.Create(PropertyName,ndx);
      end else
      result := TJSONCustomParserRTTI.Create(PropertyName,ItemType);
  end;
  if ItemSize<>0 then
    result.fDataSize := ItemSize;
end;

class function TJSONCustomParserRTTI.CreateFromTypeName(
  const aPropertyName, aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
var ndx: integer;
    simple: ^TJSONSerializerFromTextSimple;
begin
  simple := GlobalCustomJSONSerializerFromTextSimpleType.FindValue(aCustomRecordTypeName);
  if simple<>nil then
    if simple^.BinaryFieldSize<>0 then
      result := TJSONCustomParserCustomSimple.CreateBinary(
        aPropertyName,simple^.BinaryDataSize,simple^.BinaryFieldSize) else
      result := TJSONCustomParserCustomSimple.Create(
        aPropertyName,aCustomRecordTypeName,simple^.TypeInfo) else begin
    ndx := GlobalJSONCustomParsers.RecordSearch(aCustomRecordTypeName);
    if ndx<0 then
      result := nil else
      result := TJSONCustomParserCustomRecord.Create(aPropertyName,ndx);
  end;
end;

procedure TJSONCustomParserRTTI.ComputeFullPropertyName;
var i: PtrInt;
begin
  for i := 0 to high(NestedProperty) do begin
    NestedProperty[i].ComputeFullPropertyName;
    if fFullPropertyName<>'' then
      NestedProperty[i].fFullPropertyName :=
        fFullPropertyName+'.'+NestedProperty[i].fPropertyName;
  end;
end;

procedure TJSONCustomParserRTTI.ComputeNestedDataSize;
var i: PtrInt;
begin
  assert(fNestedDataSize=0);
  fNestedDataSize := 0;
  for i := 0 to high(NestedProperty) do begin
    NestedProperty[i].ComputeDataSizeAfterAdd;
    inc(fNestedDataSize,NestedProperty[i].fDataSize);
    if fFullPropertyName<>'' then
      NestedProperty[i].fFullPropertyName :=
        fFullPropertyName+'.'+NestedProperty[i].fPropertyName;
  end;
end;

procedure TJSONCustomParserRTTI.ComputeDataSizeAfterAdd;
const // binary size (in bytes) of each kind of property - 0 for ptRecord/ptCustom
  JSONRTTI_SIZE: array[TJSONCustomParserRTTIType] of byte = (
    SizeOf(PtrUInt),SizeOf(Boolean),SizeOf(Byte),SizeOf(Cardinal),SizeOf(Currency),
    SizeOf(Double),SizeOf(Extended),SizeOf(Int64),SizeOf(Integer),SizeOf(QWord),
    SizeOf(RawByteString),SizeOf(RawJSON),SizeOf(RawUTF8),0,SizeOf(Single),
    SizeOf(String),SizeOf(SynUnicode),SizeOf(TDateTime),SizeOf(TDateTimeMS),
    SizeOf(TGUID),SizeOf(Int64),SizeOf(TTimeLog),
    {$ifndef NOVARIANTS}SizeOf(Variant),{$endif}
    SizeOf(WideString),SizeOf(Word),0);
var i: PtrInt;
begin
  if fFullPropertyName='' then begin
    fFullPropertyName := fPropertyName;
    ComputeFullPropertyName;
  end;
  if fDataSize=0 then begin
    ComputeNestedDataSize;
    case PropertyType of
    ptRecord:
      for i := 0 to high(NestedProperty) do
        inc(fDataSize,NestedProperty[i].fDataSize);
    //ptCustom: fDataSize already set in TJSONCustomParserCustom.Create()
    else
      fDataSize := JSONRTTI_SIZE[PropertyType];
    end;
    {$ifdef ALIGNCUSTOMREC}
    inc(fDataSize,fDataSize and 7);
    {$endif}
  end;
end;

procedure TJSONCustomParserRTTI.FinalizeNestedRecord(var Data: PByte);
var j: PtrInt;
begin
  for j := 0 to length(NestedProperty)-1 do begin
    case NestedProperty[j].PropertyType of
    ptRawByteString,
    ptRawJSON,
    ptRawUTF8: {$ifdef FPC}Finalize(PRawByteString(Data)^){$else}PRawByteString(Data)^ := ''{$endif};
    ptString:     PString(Data)^ := '';
    ptSynUnicode: PSynUnicode(Data)^ := '';
    ptWideString: PWideString(Data)^ := '';
    ptArray:      NestedProperty[j].FinalizeNestedArray(PPtrUInt(Data)^);
    {$ifndef NOVARIANTS}
    ptVariant:    VarClear(PVariant(Data)^);
    {$endif}
    ptRecord: begin
      NestedProperty[j].FinalizeNestedRecord(Data);
      continue;
    end;
    ptCustom:
      TJSONCustomParserCustom(NestedProperty[j]).FinalizeItem(Data);
    end;
    inc(Data,NestedProperty[j].fDataSize);
  end;
end;

procedure TJSONCustomParserRTTI.FinalizeNestedArray(var Data: PtrUInt);
var i: integer;
    Rec: PDynArrayRec;
    ItemData: PByte;
begin
  if Data=0 then
    exit;
  ItemData := pointer(Data);
  Rec := pointer(Data);
  dec(PtrUInt(Rec),SizeOf(TDynArrayRec));
  Data := 0;
  if Rec^.refCnt>1 then begin
    InterlockedDecrement(PInteger(@Rec^.refCnt)^); // FPC has refCnt: PtrInt
    exit;
  end;
  for i := 1 to Rec.length do
    FinalizeNestedRecord(ItemData);
  FreeMem(Rec);
end;

procedure TJSONCustomParserRTTI.AllocateNestedArray(var Data: PtrUInt;
  NewLength: integer);
begin
  FinalizeNestedArray(Data);
  if NewLength<=0 then
    exit;
  pointer(Data) := AllocMem(SizeOf(TDynArrayRec)+fNestedDataSize*NewLength);
  PDynArrayRec(Data)^.refCnt := 1;
  PDynArrayRec(Data)^.length := NewLength;
  inc(Data,SizeOf(TDynArrayRec));
end;

procedure TJSONCustomParserRTTI.ReAllocateNestedArray(var Data: PtrUInt;
  NewLength: integer);
var OldLength: integer;
begin
  if Data=0 then
    raise ESynException.CreateUTF8('%.ReAllocateNestedArray(nil)',[self]);
  dec(Data,SizeOf(TDynArrayRec));
  ReAllocMem(pointer(Data),SizeOf(TDynArrayRec)+fNestedDataSize*NewLength);
  OldLength := PDynArrayRec(Data)^.length;
  if NewLength>OldLength then
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(
      PByteArray(Data)[SizeOf(TDynArrayRec)+fNestedDataSize*OldLength],
      fNestedDataSize*(NewLength-OldLength),0);
  PDynArrayRec(Data)^.length := NewLength;
  inc(Data,SizeOf(TDynArrayRec));
end;

function TJSONCustomParserRTTI.ReadOneLevel(var P: PUTF8Char; var Data: PByte;
  Options: TJSONCustomParserSerializationOptions): boolean;
var EndOfObject: AnsiChar;
  function ProcessValue(const Prop: TJSONCustomParserRTTI; var P: PUTF8Char;
    var Data: PByte): boolean;
  var DynArray: PByte;
      ArrayLen, ArrayCapacity, n, PropValueLen: integer;
      wasString: boolean;
      PropValue, ptr: PUTF8Char;
  label Error;
  begin
    result := false;
    P := GotoNextNotSpace(P);
    case Prop.PropertyType of
    ptRecord: begin
      if not Prop.ReadOneLevel(P,Data,Options) then
        exit;
      EndOfObject := P^;
      if P^ in [',','}'] then
        inc(P);
      result := true;
      exit;
    end;
    ptArray:
    if (PInteger(P)^=NULL_LOW) and (P[4] in EndOfJSONValueField) then begin
      P := GotoNextNotSpace(P+4);
      EndOfObject := P^;
      if P^<>#0 then //if P^=',' then
        inc(P);
      Prop.FinalizeNestedArray(PPtrUInt(Data)^); // null -> void array
    end else begin
      if P^<>'[' then
        exit; // we expect a true array here
      repeat inc(P) until P^<>' ';
      // try to allocate nested array at once (if not too slow)
      ArrayLen := JSONArrayCount(P,P+131072); // parse up to 128 KB here
      if ArrayLen<0 then // mostly JSONArrayCount()=nil due to PMax -> 512
        ArrayCapacity := 512 else
        ArrayCapacity := ArrayLen;
      Prop.AllocateNestedArray(PPtrUInt(Data)^,ArrayCapacity);
      // read array content
      if ArrayLen=0 then begin
        if not NextNotSpaceCharIs(P,']') then
          exit;
      end else begin
        n := 0;
        DynArray := PPointer(Data)^;
        repeat
          inc(n);
          if (ArrayLen<0) and (n>ArrayCapacity) then begin
            ArrayCapacity := NextGrow(ArrayCapacity);
            Prop.ReAllocateNestedArray(PPtrUInt(Data)^,ArrayCapacity);
            DynArray := PPointer(Data)^;
            inc(DynArray,pred(n)*Prop.fNestedDataSize);
          end;
          if Prop.NestedProperty[0].PropertyName='' then begin
            // array of simple type
            ptr := P;
            if not ProcessValue(Prop.NestedProperty[0],ptr,DynArray) or (ptr=nil) then
              goto Error;
            P := ptr;
          end else begin
            // array of record
            ptr := P;
            if not Prop.ReadOneLevel(ptr,DynArray,Options) or (ptr=nil) then
              goto Error;
            P := GotoNextNotSpace(ptr);
            EndOfObject := P^;
            if not(P^ in [',',']']) then
              goto Error;
            inc(P);
          end;
          case EndOfObject of
          ',': continue;
          ']': begin
            if ArrayLen<0 then
              Prop.ReAllocateNestedArray(PPtrUInt(Data)^,n) else
              if n<>ArrayLen then
                goto Error;
            break; // we reached end of array
          end;
          else begin
Error:      Prop.FinalizeNestedArray(PPtrUInt(Data)^);
            exit;
           end;
          end;
        until false;
      end;
      if P=nil then
        exit;
      P := GotoNextNotSpace(P);
      EndOfObject := P^;
      if P^<>#0 then //if P^=',' then
        inc(P);
    end;
    ptCustom: begin
      ptr := TJSONCustomParserCustom(Prop).CustomReader(P,Data^,EndOfObject);
      if ptr=nil then
        exit;
      P := ptr;
    end;
    {$ifndef NOVARIANTS}
    ptVariant:
      P := VariantLoadJSON(PVariant(Data)^,P,@EndOfObject,
        @JSON_OPTIONS[soCustomVariantCopiedByReference in Options]);
    {$endif}
    ptRawByteString: begin
      PropValue := GetJSONField(P,ptr,@wasString,@EndOfObject,@PropValueLen);
      if PropValue=nil then // null -> Blob=''
        PRawByteString(Data)^ := '' else
        if not Base64MagicCheckAndDecode(PropValue,PropValueLen,PRawByteString(Data)^) then
          exit;
      P := ptr;
    end;
    ptRawJSON:
      GetJSONItemAsRawJSON(P,PRawJSON(Data)^,@EndOfObject);
    else begin
      PropValue := GetJSONField(P,ptr,@wasString,@EndOfObject,@PropValueLen);
      if (PropValue<>nil) and // PropValue=nil for null
         (wasString<>(Prop.PropertyType in [ptRawUTF8,ptString,
           ptSynUnicode,ptDateTime,ptDateTimeMS,ptGUID,ptWideString])) then
         exit;
      P := ptr;
      case Prop.PropertyType of
      ptBoolean:   PBoolean(Data)^ := GetBoolean(PropValue);
      ptByte:      PByte(Data)^ := GetCardinal(PropValue);
      ptCardinal:  PCardinal(Data)^ := GetCardinal(PropValue);
      ptCurrency:  PInt64(Data)^ := StrToCurr64(PropValue);
      ptDouble:    PDouble(Data)^ := GetExtended(PropValue);
      ptExtended:  PExtended(Data)^ := GetExtended(PropValue);
      ptInt64,ptID,ptTimeLog: SetInt64(PropValue,PInt64(Data)^);
      ptQWord:     SetQWord(PropValue,PQWord(Data)^);
      ptInteger:   PInteger(Data)^ := GetInteger(PropValue);
      ptSingle:    PSingle(Data)^ := GetExtended(PropValue);
      ptRawUTF8:   FastSetString(PRawUTF8(Data)^,PropValue,PropValueLen);
      ptString:    UTF8DecodeToString(PropValue,PropValueLen,PString(Data)^);
      ptSynUnicode:UTF8ToSynUnicode(PropValue,PropValueLen,PSynUnicode(Data)^);
      ptDateTime, ptDateTimeMS:  Iso8601ToDateTimePUTF8CharVar(
                    PropValue,PropValueLen,PDateTime(Data)^);
      ptWideString:UTF8ToWideString(PropValue,PropValueLen,PWideString(Data)^);
      ptWord:      PWord(Data)^ := GetCardinal(PropValue);
      ptGUID:      TextToGUID(PropValue,pointer(Data));
      end;
    end;
    end;
    inc(Data,Prop.fDataSize);
    result := true;
  end;
var i,j: integer;
    PropName: shortstring;
    ptr: PUTF8Char;
    Values: array of PUTF8Char;
begin
  result := false;
  if P=nil then
    exit;
  P := GotoNextNotSpace(P);
  if (PInteger(P)^=NULL_LOW) and (P[4] in EndOfJSONValueField) then begin
    P := GotoNextNotSpace(P+4); // a record stored as null
    inc(Data,fDataSize);
    result := true;
    exit;
  end;
  EndOfObject := #0;
  if not (PropertyType in [ptRecord,ptArray]) then begin
    ptr := P;
    result := ProcessValue(Self,P,Data);
    exit;
  end;
  if P^<>'{' then
    exit; // we expect a true object here
  repeat inc(P) until (P^>' ') or (P^=#0);
  if P^='}' then begin
    inc(Data,fDataSize);
    EndOfObject := '}';
    inc(P);
  end else
  for i := 0 to length(NestedProperty)-1 do begin
    ptr := P;
    GetJSONPropName(ptr,PropName);
    if PropName='' then
      exit;  // invalid JSON content
    P := ptr;
    if IdemPropNameU(NestedProperty[i].PropertyName,@PropName[1],ord(PropName[0])) then begin
      // O(1) optimistic search
      if not ProcessValue(NestedProperty[i],P,Data) then
        exit;
      if EndOfObject='}' then begin // ignore missing properties
        for j := i+1 to length(NestedProperty)-1 do
          inc(Data,NestedProperty[j].fDataSize);
        break;
      end;
    end else begin
      SetLength(Values,length(NestedProperty)); // pessimistic check through all properties
      repeat
        for j := i to length(NestedProperty)-1 do
          if (Values[j]=nil) and
             IdemPropNameU(NestedProperty[j].PropertyName,@PropName[1],ord(PropName[0])) then begin
            Values[j] := P;
            PropName := '';
            break;
          end;
        if (PropName<>'') and not(soReadIgnoreUnknownFields in Options) then
          exit; // unexpected property
        ptr := GotoNextJSONItem(P,1,@EndOfObject);
        if ptr=nil then
          exit;
        P := ptr;
        if EndOfObject='}' then
          break;
        GetJSONPropName(ptr,PropName); // next name
        if PropName='' then
          exit;  // invalid JSON content
        P := ptr;
      until false;
      for j := i to length(NestedProperty)-1 do
        if Values[j]=nil then // ignore missing properties
          inc(Data,NestedProperty[j].fDataSize) else
          if not ProcessValue(NestedProperty[j],Values[j],Data) then
            exit;
      EndOfObject := '}'; // ProcessValue() did update EndOfObject
      break;
    end;
  end;
  if (P<>nil) and (EndOfObject=',') and (soReadIgnoreUnknownFields in Options) then begin
    ptr := GotoNextJSONObjectOrArray(P,'}');
    if ptr=nil then
      exit;
    P := ptr;
  end else
    if EndOfObject<>'}' then
      exit;
  if P<>nil then
    P := GotoNextNotSpace(P);
  result := true;
end;

procedure JSONBoolean(value: boolean; var result: RawUTF8);
begin // defined as a function and not an array[boolean] of RawUTF8 for FPC
  if value then
    result := 'true' else
    result := 'false';
end;

function Plural(const itemname: shortstring; itemcount: cardinal): shortstring;
var len: integer;
begin
  len := (AppendUInt32ToBuffer(@result[1],itemcount)-PUTF8Char(@result[1]))+1;
  result[len] := ' ';
  if ord(itemname[0])<240 then begin // avoid buffer overflow
    {$ifdef FPC}Move{$else}MoveFast{$endif}(itemname[1],result[len+1],ord(itemname[0]));
    inc(len,ord(itemname[0]));
    if itemcount>1 then begin
      inc(len);
      result[len] := 's';
    end;
  end;
  result[0] := AnsiChar(len);
end;

function TJSONCustomParserRTTI.IfDefaultSkipped(var Value: PByte): boolean;
begin
  case PropertyType of
    ptBoolean:   result := not PBoolean(Value)^;
    ptByte:      result := PByte(Value)^=0;
    ptWord:      result := PWord(Value)^=0;
    ptInteger,ptCardinal,ptSingle:
                 result := PInteger(Value)^=0;
    ptCurrency,ptDouble,ptInt64,ptQWord,ptID,ptTimeLog,ptDateTime,ptDateTimeMS:
                 result := PInt64(Value)^=0;
    ptExtended:  result := PExtended(Value)^=0;
    {$ifndef NOVARIANTS}
    ptVariant:   result := PVarData(Value)^.VType<=varNull;
    {$endif}
    ptRawJSON,ptRawByteString,ptRawUTF8,ptString,ptSynUnicode,ptWideString,ptArray:
                 result := PPointer(Value)^=nil;
    ptGUID:      result := IsNullGUID(PGUID(Value)^);
    ptRecord:    result := IsZero(Value,fDataSize);
    else         result := false;
  end;
  if result then
    inc(Value,fDataSize);
end;

procedure TJSONCustomParserRTTI.WriteOneSimpleValue(aWriter: TTextWriter; var Value: PByte;
  Options: TJSONCustomParserSerializationOptions);
var DynArray: PByte;
    j: integer;
begin
  case PropertyType of
  ptBoolean:   aWriter.Add(PBoolean(Value)^);
  ptByte:      aWriter.AddU(PByte(Value)^);
  ptCardinal:  aWriter.AddU(PCardinal(Value)^);
  ptCurrency:  aWriter.AddCurr64(PInt64(Value)^);
  ptDouble:    aWriter.AddDouble(unaligned(PDouble(Value)^));
  ptExtended:  aWriter.Add(PExtended(Value)^,EXTENDED_PRECISION);
  ptInt64,ptID,ptTimeLog:
               aWriter.Add(PInt64(Value)^);
  ptQWord:     aWriter.AddQ(PQWord(Value)^);
  ptInteger:   aWriter.Add(PInteger(Value)^);
  ptSingle:    aWriter.AddSingle(PSingle(Value)^);
  ptWord:      aWriter.AddU(PWord(Value)^);
  {$ifndef NOVARIANTS}
  ptVariant:   aWriter.AddVariant(PVariant(Value)^,twJSONEscape);
  {$endif}
  ptRawJSON:   aWriter.AddRawJSON(PRawJSON(Value)^);
  ptRawByteString:
    aWriter.WrBase64(PPointer(Value)^,length(PRawByteString(Value)^),{withMagic=}true);
  ptRawUTF8, ptString, ptSynUnicode,
  ptDateTime, ptDateTimeMS, ptGUID, ptWideString: begin
    aWriter.Add('"');
    case PropertyType of
    ptRawUTF8:       aWriter.AddJSONEscape(PPointer(Value)^);
    ptString:        aWriter.AddJSONEscapeString(PString(Value)^);
    ptSynUnicode,
    ptWideString:    aWriter.AddJSONEscapeW(PPointer(Value)^);
    ptDateTime:      aWriter.AddDateTime(unaligned(PDateTime(Value)^),false);
    ptDateTimeMS:    aWriter.AddDateTime(unaligned(PDateTime(Value)^),true);
    ptGUID:          aWriter.Add(PGUID(Value)^);
    end;
    aWriter.Add('"');
  end;
  ptArray: begin
    aWriter.Add('[');
    inc(aWriter.fHumanReadableLevel);
    DynArray := PPointer(Value)^;
    if DynArray<>nil then
      for j := 1 to DynArrayLength(DynArray) do begin
        if soWriteHumanReadable in Options then
          aWriter.AddCRAndIndent;
        if NestedProperty[0].PropertyName='' then  // array of simple
          NestedProperty[0].WriteOneSimpleValue(aWriter,DynArray,Options) else
          WriteOneLevel(aWriter,DynArray,Options); // array of record
        aWriter.Add(',');
        {$ifdef ALIGNCUSTOMREC}
        if PtrUInt(DynArray)and 7<>0 then
          inc(DynArray,8-(PtrUInt(DynArray)and 7));
        {$endif}
      end;
    aWriter.CancelLastComma;
    aWriter.Add(']');
    dec(aWriter.fHumanReadableLevel);
  end;
  ptRecord: begin
    WriteOneLevel(aWriter,Value,Options);
    exit;
  end;
  ptCustom:
    TJSONCustomParserCustom(self).CustomWriter(aWriter,Value^);
  end;
  inc(Value,fDataSize);
end;

procedure TJSONCustomParserRTTI.WriteOneLevel(aWriter: TTextWriter; var P: PByte;
  Options: TJSONCustomParserSerializationOptions);
var i: integer;
    SubProp: TJSONCustomParserRTTI;
begin
  if P=nil then begin
    aWriter.AddShort('null');
    exit;
  end;
  if not (PropertyType in [ptRecord,ptArray]) then begin
    WriteOneSimpleValue(aWriter,P,Options);
    exit;
  end;
  aWriter.Add('{');
  Inc(aWriter.fHumanReadableLevel);
  for i := 0 to length(NestedProperty)-1 do begin
    SubProp := NestedProperty[i];
    if soWriteIgnoreDefault in Options then
      if SubProp.IfDefaultSkipped(P) then
        continue;
    if soWriteHumanReadable in Options then
      aWriter.AddCRAndIndent;
    aWriter.AddFieldName(SubProp.PropertyName);
    if soWriteHumanReadable in Options then
      aWriter.Add(' ');
    SubProp.WriteOneSimpleValue(aWriter,P,Options);
    aWriter.Add(',');
  end;
  aWriter.CancelLastComma;
  dec(aWriter.fHumanReadableLevel);
  if soWriteHumanReadable in Options then
    aWriter.AddCRAndIndent;
  aWriter.Add('}');
end;


{ TJSONRecordAbstract }

constructor TJSONRecordAbstract.Create;
begin
  fItems := TObjectList.Create;
end;

function TJSONRecordAbstract.AddItem(const aPropertyName: RawUTF8;
  aPropertyType: TJSONCustomParserRTTIType;
  const aCustomRecordTypeName: RawUTF8): TJSONCustomParserRTTI;
begin
  if aPropertyType=ptCustom then begin
    result := TJSONCustomParserRTTI.CreateFromTypeName(
      aPropertyName,aCustomRecordTypeName);
    if result=nil then
      raise ESynException.CreateUTF8('Unregistered ptCustom for %.AddItem(%: %)',
        [self,aPropertyName,aCustomRecordTypeName]);
  end else
    result := TJSONCustomParserRTTI.Create(aPropertyName,aPropertyType);
  fItems.Add(result);
end;

function TJSONRecordAbstract.CustomReader(P: PUTF8Char; var aValue; out aValid: Boolean): PUTF8Char;
var Data: PByte;
    EndOfObject: AnsiChar;
begin
  if Root.PropertyType=ptCustom then begin
    result := TJSONCustomParserCustom(Root).CustomReader(P,aValue,EndOfObject);
    aValid := result<>nil;
    if (EndOfObject<>#0) and aValid then begin
       dec(result);
       result^ := EndOfObject; // emulates simple read
     end;
    exit;
  end;
  Data := @aValue;
  aValid := Root.ReadOneLevel(P,Data,Options);
  result := P;
end;

procedure TJSONRecordAbstract.CustomWriter(const aWriter: TTextWriter; const aValue);
var P: PByte;
    o: TJSONCustomParserSerializationOptions;
begin
  P := @aValue;
  o := Options;
  if twoIgnoreDefaultInRecord in aWriter.CustomOptions then
    include(o,soWriteIgnoreDefault);
  Root.WriteOneLevel(aWriter,P,o);
end;

destructor TJSONRecordAbstract.Destroy;
begin
  FreeAndNil(fItems);
  inherited;
end;


{ TJSONRecordTextDefinition }

var
  JSONCustomParserCache: TRawUTF8ListHashed;

class function TJSONRecordTextDefinition.FromCache(aTypeInfo: pointer;
  const aDefinition: RawUTF8): TJSONRecordTextDefinition;
var i: integer;
    added: boolean;
begin
  if JSONCustomParserCache=nil then
    GarbageCollectorFreeAndNil(JSONCustomParserCache,TRawUTF8ListHashed.Create(True));
  i := JSONCustomParserCache.AddObjectIfNotExisting(aDefinition,nil,@added);
  if not added then begin
    result := TJSONRecordTextDefinition(JSONCustomParserCache.fObjects[i]);
    exit;
  end;
  result := TJSONRecordTextDefinition.Create(aTypeInfo,aDefinition);
  JSONCustomParserCache.fObjects[i] := result;
end;

constructor TJSONRecordTextDefinition.Create(aRecordTypeInfo: pointer;
  const aDefinition: RawUTF8);
var P: PUTF8Char;
    recordInfoSize: integer;
begin
  inherited Create;
  fDefinition := aDefinition;
  fRoot := TJSONCustomParserRTTI.Create('',ptRecord);
  TypeInfoToName(aRecordTypeInfo,fRoot.fCustomTypeName);
  fItems.Add(fRoot);
  P := pointer(aDefinition);
  Parse(fRoot,P,eeNothing);
  fRoot.ComputeDataSizeAfterAdd;
  recordInfoSize := RecordTypeInfoSize(aRecordTypeInfo);
  if (recordInfoSize<>0) and (fRoot.fDataSize<>recordInfoSize) then
    raise ESynException.CreateUTF8('%.Create: % text definition is not accurate,'+
      ' or the type has not been defined as PACKED record: RTTI size is %'+
      ' bytes but text definition covers % bytes',
      [self,fRoot.fCustomTypeName,recordInfoSize,fRoot.fDataSize]);
end;

function DynArrayItemTypeLen(const aDynArrayTypeName: RawUTF8): integer;
begin
  result := length(aDynArrayTypeName);
  if (result>12) and IdemPropName('DynArray',@PByteArray(aDynArrayTypeName)[result-8],8) then
    dec(result,8) else
  if (result>3) and (NormToUpperAnsi7[aDynArrayTypeName[result]]='S') then
    dec(result) else
    result := 0;
end;

procedure TJSONRecordTextDefinition.Parse(Props: TJSONCustomParserRTTI;
  var P: PUTF8Char; PEnd: TJSONCustomParserRTTIExpectedEnd);
  function GetNextFieldType(var P: PUTF8Char;
    var TypIdent: RawUTF8): TJSONCustomParserRTTIType;
  begin
    if GetNextFieldProp(P,TypIdent) then
      result := TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
        pointer(TypIdent),length(TypIdent),TypIdent) else
      raise ESynException.CreateUTF8('%.Parse: missing field type',[self]);
  end;
var PropsName: TRawUTF8DynArray;
    PropsMax, ndx, len, firstNdx: cardinal;
    Typ, ArrayTyp: TJSONCustomParserRTTIType;
    TypIdent, ArrayTypIdent: RawUTF8;
    Item: TJSONCustomParserRTTI;
    ExpectedEnd: TJSONCustomParserRTTIExpectedEnd;
begin
  SetLength(PropsName,16);
  PropsMax := 0;
  while (P<>nil) and (P^<>#0) do begin
    // fill Props[]
    if not GetNextFieldProp(P,PropsName[PropsMax]) then
      break;
    case P^ of
    ',': begin
      inc(P);
      inc(PropsMax);
      if PropsMax=cardinal(length(PropsName)) then
        SetLength(PropsName,PropsMax+16);
      continue; // several properties defined with the same type
    end;
    ':': P := GotoNextNotSpace(P+1);
    end;
    // identify type
    ArrayTyp := ptRecord;
    if P^='{' then begin
      Typ := ptRecord;
      ExpectedEnd := eeCurly;
      repeat inc(P) until (P^>' ') or (P^=#0);
    end else
    if P^='[' then begin
      Typ := ptArray;
      ExpectedEnd := eeSquare;
      repeat inc(P) until (P^>' ') or (P^=#0);
    end else begin
      Typ := GetNextFieldType(P,TypIdent);
      case Typ of
        ptArray: begin
          if IdemPChar(P,'OF') then begin
            P := GotoNextNotSpace(P+2);
            ArrayTyp := GetNextFieldType(P,ArrayTypIdent);
            if ArrayTyp=ptArray then
              P := nil;
          end else
            P := nil;
          if P=nil then
            raise ESynException.CreateUTF8('%.Parse: expected syntax is '+
              '"array of record" or "array of SimpleType"',[self]);
          if ArrayTyp=ptRecord then
            ExpectedEnd := eeEndKeyWord else
            ExpectedEnd := eeNothing;
        end;
        ptRecord:
          ExpectedEnd := eeEndKeyWord;
        ptCustom: begin
          len := DynArrayItemTypeLen(TypIdent);
          if len>0 then begin
            ArrayTyp := TJSONCustomParserRTTI.TypeNameToSimpleRTTIType(
              @PByteArray(TypIdent)[1],len-1,ArrayTypIdent); // TByteDynArray -> byte
            if ArrayTyp=ptCustom then begin // TMyTypeDynArray/TMyTypes -> TMyType
              FastSetString(ArrayTypIdent,pointer(TypIdent),len);
              if GlobalCustomJSONSerializerFromTextSimpleType.Find(ArrayTypIdent)>=0 then
                Typ := ptArray;
            end else
              Typ := ptArray;
          end;
          ExpectedEnd := eeNothing;
        end;
        else ExpectedEnd := eeNothing;
      end;
    end;
    // add elements
    firstNdx := length(Props.fNestedProperty);
    SetLength(Props.fNestedProperty,firstNdx+PropsMax+1);
    for ndx := 0 to PropsMax do begin
      Item := AddItem(PropsName[ndx],Typ,TypIdent);
      Props.fNestedProperty[firstNdx+ndx] := Item;
      if (Typ=ptArray) and (ArrayTyp<>ptRecord) then begin
        SetLength(Item.fNestedProperty,1);
        Item.fNestedProperty[0] := AddItem('',ArrayTyp,ArrayTypIdent);
      end else
      if Typ in [ptArray,ptRecord] then
        if ndx=0 then // only parse once multiple fields nested type
          Parse(Item,P,ExpectedEnd) else
          Item.fNestedProperty := Props.fNestedProperty[firstNdx].fNestedProperty;
      Item.ComputeDataSizeAfterAdd;
    end;
    // validate expected end
    while P^ in [#1..' ',';'] do inc(P);
    case PEnd of
    eeEndKeyWord:
      if IdemPChar(P,'END') then begin
        inc(P,3);
        while P^ in [#1..' ',';'] do inc(P);
        break;
      end;
    eeSquare:
      if P^=']' then begin
        inc(P);
        break;
      end;
    eeCurly:
      if P^='}' then begin
        inc(P);
        break;
      end;
    end;
    PropsMax := 0;
  end;
end;


{ TJSONRecordRTTI }

constructor TJSONRecordRTTI.Create(aRecordTypeInfo: pointer;
  aRoot: TJSONCustomParserRTTI);
begin
  inherited Create;
  fRecordTypeInfo := aRecordTypeInfo;
  fRoot := aRoot;
  if fRoot=nil then begin
    {$ifdef ISDELPHI2010}
    fRoot := TJSONCustomParserRTTI.Create('',ptRecord);
    FromEnhancedRTTI(fRoot,aRecordTypeInfo);
    if fRoot.fNestedDataSize<>RecordTypeInfoSize(aRecordTypeInfo) then
      raise ESynException.CreateUTF8(
        '%.Create: error when retrieving enhanced RTTI for %',
          [self,fRoot.CustomTypeName]);
    {$else}
    raise ESynException.CreateUTF8('%.Create with no enhanced RTTI for %',
      [self,PShortString(@PTypeInfo(aRecordTypeInfo).NameLen)^]);
    {$endif}
  end;
  fItems.Add(fRoot);
  GarbageCollector.Add(self);
end;

function TJSONRecordRTTI.AddItemFromRTTI(
  const PropertyName: RawUTF8; Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
begin
  result := TJSONCustomParserRTTI.CreateFromRTTI(PropertyName,Info,ItemSize);
  fItems.Add(result);
end;

{$ifdef ISDELPHI2010}

procedure TJSONRecordRTTI.FromEnhancedRTTI(
  Props: TJSONCustomParserRTTI; Info: pointer);
var FieldTable: PTypeInfo;
    i: integer;
    FieldSize: cardinal;
    RecField: PEnhancedFieldInfo;
    ItemFields: array of PEnhancedFieldInfo;
    ItemField: PTypeInfo;
    ItemFieldName: RawUTF8;
    ItemFieldSize: cardinal;
    Item, ItemArray: TJSONCustomParserRTTI;
begin // only tkRecord is needed here
  FieldTable := GetTypeInfo(Info,tkRecord);
  if FieldTable=nil then
    raise ESynException.CreateUTF8('%.FromEnhancedRTTI(%=record?)',[self,Info]);
  FieldSize := FieldTable^.recSize;
  inc(PByte(FieldTable),FieldTable^.ManagedCount*SizeOf(TFieldInfo)-SizeOf(TFieldInfo));
  inc(PByte(FieldTable),FieldTable^.NumOps*SizeOf(pointer)); // jump RecOps[]
  if FieldTable^.AllCount=0 then
    exit; // not enough RTTI -> will raise an error in Create()
  TypeInfoToName(Info,Props.fCustomTypeName);
  RecField := @FieldTable^.AllFields[0];
  SetLength(ItemFields,FieldTable^.AllCount);
  for i := 0 to FieldTable^.AllCount-1 do begin
    ItemFields[i] := RecField;
    inc(PByte(RecField),RecField^.NameLen); // Delphi: no AlignPtr() needed
    inc(RecField);
    inc(PByte(RecField),PWord(RecField)^);
  end;
  SetLength(Props.fNestedProperty,FieldTable^.AllCount);
  for i := 0 to FieldTable^.AllCount-1 do begin
    if i=FieldTable^.AllCount-1 then
      ItemFieldSize := FieldSize-ItemFields[i].Offset else
      ItemFieldSize := ItemFields[i+1].Offset-ItemFields[i].Offset;
    ItemField := Deref(ItemFields[i]^.TypeInfo);
    FastSetString(ItemFieldName,PAnsiChar(@ItemFields[i]^.NameLen)+1,ItemFields[i]^.NameLen);
    Item := AddItemFromRTTI(ItemFieldName,ItemField,ItemFieldSize);
    Props.fNestedProperty[i] := Item;
    case Item.PropertyType of
    ptArray: begin
      inc(PByte(ItemField),ItemField^.NameLen);
      ItemArray := AddItemFromRTTI('',Deref(ItemField^.elType2),
        ItemField^.elSize {$ifdef FPC}and $7FFFFFFF{$endif});
      if (ItemArray.PropertyType=ptCustom) and
         (ItemArray.ClassType=TJSONCustomParserRTTI) then
        FromEnhancedRTTI(Item,Deref(ItemField^.elType2)) else begin
        SetLength(Item.fNestedProperty,1);
        Item.fNestedProperty[0] := ItemArray;
        Item.ComputeNestedDataSize;
      end;
    end;
    ptCustom:
      if (ItemField<>nil) and (Item.ClassType=TJSONCustomParserRTTI) then
        FromEnhancedRTTI(Item,ItemField);
    end;
  end;
  Props.ComputeNestedDataSize;
end;

{$endif ISDELPHI2010}


{ ************ variant-based process, including JSON/BSON document content }

function SetVariantUnRefSimpleValue(const Source: variant; var Dest: TVarData): boolean;
var typ: word;
begin
  if TVarData(Source).VType and varByRef<>0 then begin
    typ := TVarData(Source).VType and not varByRef;
    case typ of
    varVariant:
      if PVarData(TVarData(Source).VPointer)^.VType in
          [varEmpty..varDate,varBoolean,varShortInt..varWord64] then begin
        Dest := PVarData(TVarData(Source).VPointer)^;
        result := true;
      end else
        result := false;
    varEmpty..varDate,varBoolean,varShortInt..varWord64: begin
      Dest.VType := typ;
      Dest.VInt64 :=  PInt64(TVarData(Source).VAny)^;
      result := true;
    end;
    else
      result := false;
    end;
  end else
    result := false;
end;

{$ifndef LVCL}

procedure RawByteStringToVariant(Data: PByte; DataLen: Integer; var Value: variant);
begin
  with TVarData(Value) do begin
    {$ifndef FPC}if VType and VTYPE_STATIC<>0 then{$endif}
      VarClear(Value);
    if (Data=nil) or (DataLen<=0) then
      VType := varNull else begin
      VType := varString;
      VAny := nil; // avoid GPF below when assigning a string variable to VAny
      SetString(RawByteString(VAny),PAnsiChar(Data),DataLen);
    end;
  end;
end;

procedure RawByteStringToVariant(const Data: RawByteString; var Value: variant);
begin
  with TVarData(Value) do begin
    {$ifndef FPC}if VType and VTYPE_STATIC<>0 then{$endif}
      VarClear(Value);
    if Data='' then
      VType := varNull else begin
      VType := varString;
      VAny := nil; // avoid GPF below when assigning a string variable to VAny
      RawByteString(VAny) := Data;
    end;
  end;
end;

procedure VariantToRawByteString(const Value: variant; var Dest: RawByteString);
begin
  case TVarData(Value).VType of
  varEmpty, varNull:
    Dest := '';
  varString:
    Dest := RawByteString(TVarData(Value).VAny);
  else // not from RawByteStringToVariant() -> conversion to string
    Dest := {$ifdef UNICODE}RawByteString{$else}string{$endif}(Value);
  end;
end;

procedure SetVariantNull(var Value: variant);
begin // slightly faster than Value := Null
  VarClear(Value);
  TVarData(Value).VType := varNull;
end;

{$endif LVCL}

function VarIsEmptyOrNull(const V: Variant): Boolean;
begin
  result := VarDataIsEmptyOrNull(@V);
end;

function VarDataIsEmptyOrNull(VarData: pointer): Boolean;
begin
  repeat
    if PVarData(VarData)^.VType<>varVariant or varByRef then
      break;
    VarData := PVarData(VarData)^.VPointer;
    if VarData=nil then begin
      result := true;
      exit;
    end;
  until false;
  result := (PVarData(VarData)^.VType<=varNull) or
            (PVarData(VarData)^.VType=varNull or varByRef);
end;

function VarIs(const V: Variant; const VTypes: TVarDataTypes): Boolean;
var VD: PVarData;
begin
  VD := @V;
  repeat
    if VD^.VType<>varVariant or varByRef then
      break;
    VD := VD^.VPointer;
    if VD=nil then begin
      result := false;
      exit;
    end;
  until false;
  result := VD^.VType in VTypes;
end;

function VarIsVoid(const V: Variant): boolean;
begin
  with TVarData(V) do
    case VType of
    varEmpty,varNull:
      result := true;
    varBoolean:
      result := not VBoolean;
    varString,varOleStr{$ifdef HASVARUSTRING},varUString{$endif}:
      result := VAny=nil;
    varDate:
      result := VInt64=0;
    else
      if VType=varVariant or varByRef then
        result := VarIsVoid(PVariant(VPointer)^) else
      if (VType=varByRef or varString) or (VType=varByRef or varOleStr)
         {$ifdef HASVARUSTRING} or (VType=varByRef or varUString) {$endif} then
        result := PPointer(VAny)^=nil else
      {$ifndef NOVARIANTS}
      if VType=word(DocVariantVType) then
        result := TDocVariantData(V).Count=0 else
      {$endif}
        result := false;
    end;
end;


{$ifndef NOVARIANTS}

/// internal method used by VariantLoadJSON(), GetVariantFromJSON() and
// TDocVariantData.InitJSONInPlace()
procedure GetJSONToAnyVariant(var Value: variant; var JSON: PUTF8Char;
  EndOfObject: PUTF8Char; Options: PDocVariantOptions; AllowDouble: boolean); forward;

procedure SetVariantByRef(const Source: Variant; var Dest: Variant);
begin
  {$ifndef FPC}if TVarData(Dest).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(Dest);
  if (TVarData(Source).VType=varVariant or varByRef) or
     (TVarData(Source).VType in // already byref or simple
       [varEmpty..varDate,varBoolean,varShortInt..varWord64]) then
    TVarData(Dest) := TVarData(Source) else
  if not SetVariantUnRefSimpleValue(Source,TVarData(Dest)) then begin
    TVarData(Dest).VType := varVariant or varByRef;
    TVarData(Dest).VPointer := @Source;
  end;
end;

procedure SetVariantByValue(const Source: Variant; var Dest: Variant);
var s: TVarData absolute Source;
    d: TVarData absolute Dest;
begin
  {$ifndef FPC}if d.VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(Dest);
  case s.VType of
  varEmpty..varDate,varBoolean,varShortInt..varWord64: begin
    d.VType := s.VType;
    d.VInt64 := s.VInt64;
  end;
  varString: begin
    d.VType := varString;
    d.VAny := nil;
    RawByteString(d.VAny) := RawByteString(s.VAny);
  end;
  varVariant or varByRef:
    Dest := PVariant(s.VPointer)^;
  varByRef or varString: begin
    d.VType := varString;
    d.VAny := nil;
    RawByteString(d.VAny) := PRawByteString(s.VAny)^;
  end;
  {$ifdef HASVARUSTRING} varUString, varByRef or varUString, {$endif}
  varOleStr, varByRef or varOleStr: begin
    d.VType := varString;
    d.VAny := nil;
    VariantToUTF8(Source,RawUTF8(d.VAny)); // store a RawUTF8 instance
  end;
  else
    if not SetVariantUnRefSimpleValue(Source,d) then
      Dest := Source;
  end;
end;

procedure ZeroFill(Value: PVarData);
begin // slightly faster than FillChar(Value,SizeOf(Value),0);
  PInt64Array(Value)^[0] := 0;
  PInt64Array(Value)^[1] := 0;
  {$ifdef CPU64}
  //assert(SizeOf(TVarData)=24);
  PInt64Array(Value)^[2] := 0;
  {$endif}
end;

procedure FillZero(var value: variant); overload;
begin
  with TVarData(Value) do
    case VType of
    varString: FillZero(RawByteString(VAny));
    end;
  VarClear(Value);
end;

procedure RawUTF8ToVariant(Txt: PUTF8Char; TxtLen: integer; var Value: variant);
begin
  with TVarData(Value) do begin
    if VType<>varString then begin // in-place replacement of a RawUTF8 value
      {$ifndef FPC}if VType and VTYPE_STATIC<>0 then{$endif}
        VarClear(Value);
      VType := varString;
      VAny := nil; // avoid GPF below when assigning a string variable to VAny
    end;
    FastSetString(RawUTF8(VString),Txt,TxtLen);
  end;
end;

procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: variant);
begin
  with TVarData(Value) do begin
    if VType<>varString then begin // in-place replacement of a RawUTF8 value
      {$ifndef FPC}if VType and VTYPE_STATIC<>0 then{$endif}
        VarClear(Value);
      VType := varString;
      VAny := nil; // avoid GPF below when assigning a string variable to VAny
      if Txt='' then
        exit;
    end;
    RawByteString(VAny) := Txt;
    {$ifdef HASCODEPAGE}
    if (Txt<>'') and (StringCodePage(Txt)=CP_RAWBYTESTRING) then
      SetCodePage(RawByteString(VAny),CP_UTF8,false); // force explicit UTF-8
    {$endif}
  end;
end;

procedure FormatUTF8ToVariant(const Fmt: RawUTF8; const Args: array of const;
  var Value: variant);
begin
  RawUTF8ToVariant(FormatUTF8(Fmt,Args),Value);
end;

function RawUTF8ToVariant(const Txt: RawUTF8): variant;
begin
  RawUTF8ToVariant(Txt,result);
end;

procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: TVarData;
  ExpectedValueType: word);
begin
  {$ifndef FPC}if Value.VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(variant(Value));
  Value.VType := ExpectedValueType;
  Value.VAny := nil; // avoid GPF below
  if Txt<>'' then
  case ExpectedValueType of
    varString: begin
      RawByteString(Value.VAny) := Txt;
      {$ifdef HASCODEPAGE}
      if (Txt<>'') and  (StringCodePage(Txt)=CP_RAWBYTESTRING) then
        SetCodePage(RawByteString(Value.VAny),CP_UTF8,false); // force explicit UTF-8
      {$endif}
    end;
    varOleStr:
      UTF8ToWideString(Txt,WideString(Value.VAny));
    {$ifdef HASVARUSTRING}
    varUString:
      UTF8DecodeToUnicodeString(pointer(Txt),length(Txt),UnicodeString(Value.VAny));
    {$endif}
    else raise ESynException.CreateUTF8('RawUTF8ToVariant(ExpectedValueType=%)',
      [ExpectedValueType]);
  end;
end;

function VariantSave(const Value: variant; Dest: PAnsiChar): PAnsiChar;
  procedure ComplexType;
  begin
    try
      Dest := pointer(ToVarString(VariantSaveJSON(Value),PByte(Dest)));
    except
      on Exception do
        Dest := nil; // notify invalid/unhandled variant content
    end;
  end;
var LenBytes: integer;
    tmp: TVarData;
begin
  with TVarData(Value) do
    if VType and varByRef<>0 then
      if VType=varVariant or varByRef then begin
        result := VariantSave(PVariant(VPointer)^,Dest);
        exit;
      end else
      if SetVariantUnRefSimpleValue(Value,tmp) then begin
        result := VariantSave(variant(tmp),Dest-SizeOf(VType));
        exit;
      end;
  with TVarData(Value) do begin
    PWord(Dest)^ := VType;
    inc(Dest,SizeOf(VType));
    case VType of
    varNull, varEmpty: ;
    varShortInt, varByte: begin
      Dest^ := AnsiChar(VByte);
      inc(Dest);
    end;
    varSmallint, varWord, varBoolean: begin
      PWord(Dest)^ := VWord;
      inc(Dest,SizeOf(VWord));
    end;
    varSingle, varLongWord, varInteger: begin
      PInteger(Dest)^ := VInteger;
      inc(Dest,SizeOf(VInteger));
    end;
    varInt64, varWord64, varDouble, varDate, varCurrency:begin
      PInt64(Dest)^ := VInt64;
      inc(Dest,SizeOf(VInt64));
    end;
    varString, varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
      if PtrUInt(VAny)=0 then
        LenBytes := 0 else begin
        LenBytes := PStrRec(Pointer(PtrUInt(VAny)-STRRECSIZE))^.length;
        {$ifdef HASVARUSTRING}
        if VType=varUString then
          LenBytes := LenBytes*2; // stored length is in bytes, not (wide)chars
        {$endif}
      end;
      Dest := pointer(ToVarUInt32(LenBytes,pointer(Dest)));
      if LenBytes>0 then begin // direct raw copy
        {$ifdef FPC}Move{$else}MoveFast{$endif}(PPtrUInt(VAny)^,Dest^,LenBytes);
        inc(Dest,LenBytes);
      end;
    end;
    else ComplexType; // complex types are stored as JSON
    end;
  end;
  result := Dest;
end;

function VariantSaveLength(const Value: variant): integer;
var tmp: TVarData;
begin // match VariantSave() storage
  with TVarData(Value) do
    if VType and varByRef<>0 then
      if VType=varVariant or varByRef then begin
        result := VariantSaveLength(PVariant(VPointer)^);
        exit;
      end else
      if SetVariantUnRefSimpleValue(Value,tmp) then begin
        result := VariantSaveLength(variant(tmp));
        exit;
      end;
  with TVarData(Value) do
  case VType of
  varEmpty, varNull:
    result := SizeOf(VType);
  varShortInt, varByte:
    result := SizeOf(VByte)+SizeOf(VType);
  varSmallint, varWord, varBoolean:
    result := SizeOf(VSmallint)+SizeOf(VType);
  varSingle, varLongWord, varInteger:
    result := SizeOf(VInteger)+SizeOf(VType);
  varInt64, varWord64, varDouble, varDate, varCurrency:
    result := SizeOf(VInt64)+SizeOf(VType);
  varString, varOleStr:
    if PtrUInt(VAny)=0 then
      result := 1+SizeOf(VType) else
      result := ToVarUInt32LengthWithData(PStrRec(Pointer(PtrUInt(VAny)-STRRECSIZE))^.length)
        +SizeOf(VType);
  {$ifdef HASVARUSTRING}
  varUString:
    if PtrUInt(VAny)=0 then // stored length is in bytes, not (wide)chars
      result := 1+SizeOf(VType) else
      result := ToVarUInt32LengthWithData(PStrRec(Pointer(PtrUInt(VAny)-STRRECSIZE))^.length*2)
        +SizeOf(VType);
  {$endif}
  else
    try // complex types will be stored as JSON
      result := ToVarUInt32LengthWithData(VariantSaveJSONLength(Value))+SizeOf(VType);
    except
      on Exception do
        result := 0; // notify invalid/unhandled variant content
    end;
  end;
end;

function VariantSave(const Value: variant): RawByteString;
var P: PAnsiChar;
begin
  SetString(result,nil,VariantSaveLength(Value));
  P := VariantSave(Value,pointer(result));
  if P-pointer(result)<>length(result) then
    raise ESynException.Create('VariantSave length');
end;

function VariantLoad(const Bin: RawByteString;
  CustomVariantOptions: PDocVariantOptions): variant;
begin
  if VariantLoad(result,Pointer(Bin),CustomVariantOptions)=nil then
    VarClear(result);
end;

function VariantLoad(var Value: variant; Source: PAnsiChar;
  CustomVariantOptions: PDocVariantOptions): PAnsiChar;
var JSON: PUTF8Char;
    tmp: TSynTempBuffer; // GetJSON*() does in-place unescape -> private copy
begin
  with TVarData(Value) do begin
    {$ifndef FPC}if VType and VTYPE_STATIC<>0 then{$endif}
      VarClear(Value);
    VType := PWord(Source)^;
    inc(Source,SizeOf(VType));
    case VType of
    varNull, varEmpty: ;
    varShortInt, varByte: begin
      VByte := byte(Source^);
      inc(Source);
    end;
    varSmallint, varWord, varBoolean: begin
      VWord := PWord(Source)^;
      inc(Source,SizeOf(VWord));
    end;
    varSingle, varLongWord, varInteger: begin
      VInteger := PInteger(Source)^;
      inc(Source,SizeOf(VInteger));
    end;
    varInt64, varWord64, varDouble, varDate, varCurrency: begin
      VInt64 := PInt64(Source)^;
      inc(Source,SizeOf(VInt64));
    end;
    varString, varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
      VAny := nil; // avoid GPF below when assigning a string variable to VAny
      tmp.Len := FromVarUInt32(PByte(Source));
      case VType of
      varString:
        FastSetString(RawUTF8(VString),Source,tmp.Len); // explicit RawUTF8
      varOleStr:
        SetString(WideString(VAny),PWideChar(Source),tmp.Len shr 1);
      {$ifdef HASVARUSTRING}
      varUString:
        SetString(UnicodeString(VAny),PWideChar(Source),tmp.Len shr 1);
      {$endif}
      end;
      inc(Source,tmp.Len);
    end;
    else
      if CustomVariantOptions<>nil then begin
        try // expected format for complex type is JSON (VType may differ)
          FromVarString(PByte(Source),tmp);
          try
            JSON := tmp.buf;
            VType := varEmpty; // avoid GPF below
            GetJSONToAnyVariant(Value,JSON,nil,CustomVariantOptions,false);
          finally
            tmp.Done;
          end;
        except
          on Exception do
            Source := nil; // notify invalid/unhandled variant content
        end;
      end else
        Source := nil; // notify unhandled type
    end;
  end;
  result := Source;
end;

procedure FromVarVariant(var Source: PByte; var Value: variant;
  CustomVariantOptions: PDocVariantOptions);
begin
  Source := PByte(VariantLoad(Value,PAnsiChar(Source),CustomVariantOptions));
end;

function VariantLoadJSON(var Value: variant; JSON: PUTF8Char; EndOfObject: PUTF8Char;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean): PUTF8Char;
var wasString: boolean;
    Val: PUTF8Char;
begin
  result := JSON;
  if JSON=nil then
    exit;
  if TryCustomVariants<>nil then begin
    if dvoJSONObjectParseWithinString in TryCustomVariants^ then begin
      JSON := GotoNextNotSpace(JSON);
      if JSON^='"' then begin
        Val := GetJSONField(result,result,@wasString,EndOfObject);
        GetJSONToAnyVariant(Value,Val,EndOfObject,TryCustomVariants,AllowDouble);
      end else
        GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,AllowDouble);
    end else
      GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants,AllowDouble);
  end else begin
    Val := GetJSONField(result,result,@wasString,EndOfObject);
    GetVariantFromJSON(Val,wasString,Value,nil,AllowDouble);
  end;
  if result=nil then
    result := @NULCHAR; // reached end, but not invalid input
end;

procedure VariantLoadJSON(var Value: Variant; const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    VariantLoadJSON(Value,tmp.buf,nil,TryCustomVariants,AllowDouble);
  finally
    tmp.Done;
  end;
end;

function VariantLoadJSON(const JSON: RawUTF8; TryCustomVariants: PDocVariantOptions;
  AllowDouble: boolean): variant;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    VariantLoadJSON(result,tmp.buf,nil,TryCustomVariants,AllowDouble);
  finally
    tmp.Done;
  end;
end;

function VariantSaveJSON(const Value: variant; Escape: TTextWriterKind): RawUTF8;
begin
  VariantSaveJSON(Value,Escape,result);
end;

procedure VariantSaveJSON(const Value: variant; Escape: TTextWriterKind;
  var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin // not very optimized, but fast enough in practice, and creates valid JSON
  with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
  try
    AddVariant(Value,Escape);
    SetText(result);
  finally
    Free;
  end;
end;

function VariantSaveJSONLength(const Value: variant; Escape: TTextWriterKind): integer;
var Fake: TFakeWriterStream;
    temp: TTextWriterStackBuffer;
begin // will avoid most memory allocations
  Fake := TFakeWriterStream.Create;
  try
    with DefaultTextWriterJSONClass.Create(Fake,@temp,SizeOf(temp)) do
    try
      AddVariant(Value,Escape);
      FlushFinal;
      result := fTotalFileSize;
    finally
      Free;
    end;
  finally
    Fake.Free;
  end;
end;

procedure VariantToVarRec(const V: variant; var result: TVarRec);
begin
  result.VType := vtVariant;
  if TVarData(V).VType=varByRef or varVariant then
    result.VVariant := TVarData(V).VPointer else
    result.VVariant := @V;
end;

function VarRecToVariant(const V: TVarRec): variant;
begin
  VarRecToVariant(V,result);
end;

procedure VarRecToVariant(const V: TVarRec; var result: variant);
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC=0 then
    TVarData(result).VType := varEmpty else{$endif}
    VarClear(result);
  with TVarData(result) do
  case V.VType of
    vtPointer:
      VType := varNull;
    vtBoolean: begin
      VType := varBoolean;
      VBoolean := V.VBoolean;
    end;
    vtInteger: begin
      VType := varInteger;
      VInteger := V.VInteger;
    end;
    vtInt64: begin
      VType := varInt64;
      VInt64 := V.VInt64^;
    end;
    {$ifdef FPC}
    vtQWord: begin
      VType := varQWord;
      VQWord := V.VQWord^;
    end;
    {$endif}
    vtCurrency: begin
      VType := varCurrency;
      VCurrency := V.VCurrency^;
    end;
    vtExtended: begin
      VType := varDouble;
      VDouble := V.VExtended^;
    end;
    vtVariant:
      result := V.VVariant^;
    vtAnsiString: begin
      VType := varString;
      VAny := nil;
      RawByteString(VAny) := RawByteString(V.VAnsiString);
    end;
    vtString, {$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString, vtClass: begin
      VType := varString;
      VString := nil; // avoid GPF on next line
      VarRecToUTF8(V,RawUTF8(VString)); // convert to a new RawUTF8 instance
    end;
    vtObject: // class instance will be serialized as a TDocVariant
      ObjectToVariant(V.VObject,result,[woDontStoreDefault]);
    else raise ESynException.CreateUTF8('Unhandled TVarRec.VType=%',[V.VType]);
  end;
end;


{ TSynInvokeableVariantType }

procedure TSynInvokeableVariantType.Lookup(var Dest: TVarData; const V: TVarData;
  FullName: PUTF8Char);
var itemName: RawUTF8;
    Handler: TSynInvokeableVariantType;
    DestVar,LookupVar: TVarData;
    docv: word;
begin
  Dest.VType := varEmpty; // left to Unassigned if not found
  DestVar := V;
  while DestVar.VType=varByRef or varVariant do
    DestVar := PVarData(DestVar.VPointer)^;
  docv := DocVariantVType;
  repeat
    GetNextItem(FullName,'.',itemName);
    if itemName='' then
      exit;
    if DestVar.VType=docv then begin
      if not TDocVariantData(DestVar).GetVarData(itemName,DestVar) then
        exit;
    end else
    if FindCustomVariantType(DestVar.VType,TCustomVariantType(Handler)) and
       Handler.InheritsFrom(TSynInvokeableVariantType) then
    try // handle any kind of document storage: TSynTableVariant,TBSONVariant...
      LookupVar.VType := varEmpty;
      Handler.IntGet(LookupVar,DestVar,pointer(itemName));
      if LookupVar.VType<=varNull then
        exit; // assume varNull means not found
      DestVar := LookupVar;
    except
      on Exception do begin
        DestVar.VType := varEmpty;
        exit;
      end;
    end else
      exit;
    while DestVar.VType=varByRef or varVariant do
      DestVar := PVarData(DestVar.VPointer)^;
    if (DestVar.VType=docv) and
       (TDocVariantData(DestVar).VCount=0) then
      DestVar.VType := varNull; // recognize void TDocVariant as null
    if FullName=nil then begin // found full name scope
      Dest := DestVar;
      exit;
    end;
    // if we reached here, we should try for the next scope within Dest
    if DestVar.VType=VarType then // most likely to be of the same exact type
      continue;
    if FindCustomVariantType(DestVar.VType,TCustomVariantType(Handler)) and
       Handler.InheritsFrom(TSynInvokeableVariantType) then
      Handler.Lookup(Dest,DestVar,FullName);
    break;
  until false;
end;

function TSynInvokeableVariantType.IterateCount(const V: TVarData): integer;
begin
  result := -1; // this is not an array
end;

procedure TSynInvokeableVariantType.Iterate(var Dest: TVarData; const V: TVarData;
  Index: integer);
begin // do nothing
end;

{$ifndef FPC}
{$ifndef DELPHI6OROLDER}
function TSynInvokeableVariantType.FixupIdent(const AText: string): string;
begin
  result := AText; // NO uppercased identifier for our custom types!
end;
{$endif DELPHI6OROLDER}
{$endif FPC}

function TSynInvokeableVariantType.GetProperty(var Dest: TVarData;
  const V: TVarData; const Name: String): Boolean;
{$ifdef UNICODE}
var Buf: array[byte] of AnsiChar; // to avoid heap allocation
{$endif}
begin
{$ifdef UNICODE}
  RawUnicodeToUtf8(Buf,SizeOf(Buf),pointer(Name),length(Name),[]);
  IntGet(Dest,V,Buf);
{$else}
  IntGet(Dest,V,pointer(Name));
{$endif}
  result := True;
end;

{$ifdef FPC_VARIANTSETVAR} // see http://mantis.freepascal.org/view.php?id=26773
function TSynInvokeableVariantType.SetProperty(var V: TVarData;
  const Name: string; const Value: TVarData): Boolean;
{$else}
function TSynInvokeableVariantType.SetProperty(const V: TVarData;
  const Name: string; const Value: TVarData): Boolean;
{$endif}
var ValueSet: TVarData;
    PropName: PAnsiChar;
{$ifdef UNICODE}
    Buf: array[byte] of AnsiChar; // to avoid heap allocation
{$endif}
begin
{$ifdef UNICODE}
  RawUnicodeToUtf8(Buf,SizeOf(Buf),pointer(Name),length(Name),[]);
  PropName := @Buf[0];
{$else}
  PropName := pointer(Name);
{$endif}
  ValueSet.VString := nil; // to avoid GPF in RawUTF8(ValueSet.VString) below
  if Value.VType=varByRef or varOleStr then
    RawUnicodeToUtf8(PPointer(Value.VAny)^,length(PWideString(Value.VAny)^),
      RawUTF8(ValueSet.VString)) else
  if Value.VType=varOleStr then
    RawUnicodeToUtf8(Value.VAny,length(WideString(Value.VAny)),
      RawUTF8(ValueSet.VString)) else
  {$ifdef HASVARUSTRING}
  if Value.VType=varByRef or varUString then
    RawUnicodeToUtf8(PPointer(Value.VAny)^,length(PUnicodeString(Value.VAny)^),
      RawUTF8(ValueSet.VString)) else
  if Value.VType=varUString then
    RawUnicodeToUtf8(Value.VAny,length(UnicodeString(Value.VAny)),
      RawUTF8(ValueSet.VString)) else
  {$endif}
  if SetVariantUnRefSimpleValue(variant(Value),ValueSet) then begin
    IntSet(V,ValueSet,PropName);
    result := true;
    exit;
  end else begin
    IntSet(V,Value,PropName);
    result := true;
    exit;
  end;
  try // unpatched RTL does not like Unicode values :( -> transmit a RawUTF8
    ValueSet.VType := varString;
    IntSet(V,ValueSet,PropName);
  finally
    RawUTF8(ValueSet.VString) := ''; // avoid memory leak
  end;
  result := True;
end;

procedure TSynInvokeableVariantType.Clear(var V: TVarData);
begin
  ZeroFill(@V); // will set V.VType := varEmpty
end;

procedure TSynInvokeableVariantType.Copy(var Dest: TVarData;
  const Source: TVarData; const Indirect: Boolean);
begin
  if Indirect then
    SimplisticCopy(Dest,Source,true) else begin
    {$ifndef FPC}if Dest.VType and VTYPE_STATIC<>0 then{$endif}
      VarClear(variant(Dest)); // Dest may be a complex type
    Dest := Source;
  end;
end;

procedure TSynInvokeableVariantType.CopyByValue(var Dest: TVarData; const Source: TVarData);
begin
  Copy(Dest,Source,false);
end;

function TSynInvokeableVariantType.TryJSONToVariant(var JSON: PUTF8Char;
  var Value: variant; EndOfObject: PUTF8Char): boolean;
begin
  result := false;
end;

procedure TSynInvokeableVariantType.ToJSON(W: TTextWriter; const Value: variant;
  Escape: TTextWriterKind);
begin
  raise ESynException.CreateUTF8('%.ToJSON: unimplemented variant type',[self]);
end;

function TSynInvokeableVariantType.IsOfType(const V: variant): boolean;
begin
  if self=nil then
    result := false else
    if TVarData(V).VType=varByRef or varVariant then
      result := IsOfType(PVariant(TVarData(V).VPointer)^) else
      result := TVarData(V).VType=VarType;
end;


var
  SynVariantTypes: TObjectList = nil;

function FindSynVariantType(aVarType: Word; out CustomType: TSynInvokeableVariantType): boolean;
var i: integer;
begin
  if SynVariantTypes<>nil then begin
    for i := 0 to SynVariantTypes.Count-1 do
      if TSynInvokeableVariantType(SynVariantTypes.List[i]).VarType=aVarType then begin
        CustomType := TSynInvokeableVariantType(SynVariantTypes.List[i]);
        result := true;
        exit;
      end;
  end;
  result := false;
end;

procedure GetJSONToAnyVariant(var Value: variant; var JSON: PUTF8Char;
  EndOfObject: PUTF8Char; Options: PDocVariantOptions; AllowDouble: boolean);
// internal method used by VariantLoadJSON(), GetVariantFromJSON() and
// TDocVariantData.InitJSON()
var wasString: boolean;
  procedure ProcessSimple(Val: PUTF8Char); {$ifdef FPC}inline;{$endif}
  begin
    GetVariantFromJSON(Val,wasString,Value,nil,AllowDouble);
    if JSON=nil then
      JSON := @NULCHAR;
  end;
var i: integer;
    VariantType: ^TSynInvokeableVariantType;
    ToBeParsed: PUTF8Char;
    wasParsedWithinString: boolean;
begin
  {$ifndef FPC}if TVarData(Value).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(Value);
  if (Options<>nil) and (dvoAllowDoubleValue in Options^) then
    AllowDouble := true; // for ProcessSimple() above
  if EndOfObject<>nil then
    EndOfObject^ := ' ';
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if (Options=nil) or (JSON^ in ['-','1'..'9']) then begin // obvious simple type
    ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
    exit;
  end;
  if JSON^='"' then
    if dvoJSONObjectParseWithinString in Options^ then begin
      ToBeParsed := GetJSONField(JSON,JSON,@wasString,EndOfObject);
      EndOfObject := nil; // already set just above
      wasParsedWithinString := true;
    end else begin
      ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
      exit;
    end else begin
      ToBeParsed := JSON;
      wasParsedWithinString := false;
    end;
  if (SynVariantTypes<>nil) and
     not (dvoJSONParseDoNotTryCustomVariants in Options^) then begin
    VariantType := pointer(SynVariantTypes.List);
    for i := 1 to SynVariantTypes.Count do
      if VariantType^.TryJSONToVariant(ToBeParsed,Value,EndOfObject) then begin
        if not wasParsedWithinString then
          JSON := ToBeParsed;
        exit;
      end else
        inc(VariantType);
  end;
  if ToBeParsed^ in ['[','{'] then begin
    // default JSON parsing and conversion to TDocVariant instance
    ToBeParsed := TDocVariantData(Value).InitJSONInPlace(ToBeParsed,Options^,EndOfObject);
    if not wasParsedWithinString then
      JSON := ToBeParsed;
  end else
    // process to simple variant types
    if wasParsedWithinString then
      ProcessSimple(ToBeParsed) else
      ProcessSimple(GetJSONField(JSON,JSON,@wasString,EndOfObject));
end;

function TextToVariantNumberTypeNoDouble(JSON: PUTF8Char): word;
var start: PUTF8Char;
begin
  start := json;
  if (json[0] in ['1'..'9']) or // is first char numeric?
     ((json[0]='0') and not (json[1] in ['0'..'9'])) or // '012' is invalid JSON
     ((json[0]='-') and (json[1] in ['0'..'9'])) then begin
    inc(json);
    repeat
      case json^ of
      '0'..'9':
        inc(json);
      '.':
        if (json[1] in ['0'..'9']) and (json[2] in [#0,'e','E','0'..'9']) then
          if (json[2]=#0) or (json[3]=#0) or
             ((json[3] in ['0'..'9']) and
              (json[4]=#0) or
              ((json[4] in ['0'..'9']) and (json[5]=#0))) then begin
            result := varCurrency; // currency ###.1234 number
            exit;
          end else
            break else // we expect exact digit representation
          break;
      #0:
        if json-start<=19 then begin // signed Int64 precision
          result := varInt64;
          exit;
        end else
          break;
      else break;
      end;
    until false;
  end;
  result := varString;
end;

function TextToVariantNumberType(json: PUTF8Char): word;
var start: PUTF8Char;
    exp,err: integer;
label exponent;
begin
  start := json;
  if (json[0] in ['1'..'9']) or // is first char numeric?
     ((json[0]='0') and not (json[1] in ['0'..'9'])) or // '012' is invalid JSON
     ((json[0]='-') and (json[1] in ['0'..'9'])) then begin
    inc(json);
    repeat
      case json^ of
      '0'..'9':
        inc(json);
      '.':
        if (json[1] in ['0'..'9']) and (json[2] in [#0,'e','E','0'..'9']) then
          if (json[2]=#0) or (json[3]=#0) or
             ((json[3] in ['0'..'9']) and (json[4]=#0) or
             ((json[4] in ['0'..'9']) and (json[5]=#0))) then begin
            result := varCurrency; // currency ###.1234 number
            exit;
          end else begin
            repeat // more than 4 decimals
              inc(json)
            until not (json^ in ['0'..'9']);
            case json^ of
            #0: begin
              result := varDouble;
              exit;
            end;
            'e','E': begin
exponent:     exp := GetInteger(json+1,err);
              if (err=0) and (exp>-324) and (exp<308) then begin
                result := varDouble; // 5.0 x 10^-324 .. 1.7 x 10^308
                exit;
              end;
            end;
            end;
            break;
          end else
          break;
      'e','E':
        goto exponent;
      #0:
        if json-start<=19 then begin // signed Int64 precision
          result := varInt64;
          exit;
        end else begin
          result := varDouble; // we may lost precision, but it is a number
          exit;
        end;
      else break;
      end;
    until false;
  end;
  result := varString;
end;

function GetNumericVariantFromJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowVarDouble: boolean): boolean;
var err: integer;
    typ: word;
label dbl;
begin
  if JSON<>nil then begin
    if AllowVarDouble then
      typ := TextToVariantNumberType(JSON) else
      typ := TextToVariantNumberTypeNoDouble(JSON);
    with Value do
    case typ of
    varInt64: begin
      VInt64 := GetInt64(JSON,err);
      if err<>0 then // overflow (>$7FFFFFFFFFFFFFFF) -> try floating point
        if AllowVarDouble then
          goto dbl else begin
          result:= false;
          exit;
        end;
      if (VInt64<=high(integer)) and (VInt64>=low(integer)) then
        VType := varInteger else
        VType := varInt64;
      result := true;
      exit;
    end;
    varCurrency: begin
      VInt64 := StrToCurr64(JSON);
      VType := varCurrency;
      result := true;
      exit;
    end;
    varDouble: begin
dbl:  VDouble := GetExtended(JSON,err);
      if err=0 then begin
        VType := varDouble;
        result := true;
        exit;
      end;
    end;
    end;
  end;
  result := false;
end;

procedure TextToVariant(const aValue: RawUTF8; AllowVarDouble: boolean;
  out aDest: variant);
begin
  if not GetNumericVariantFromJSON(pointer(aValue),TVarData(aDest),AllowVarDouble) then
    RawUTF8ToVariant(aValue,aDest);
end;

function GetNextItemToVariant(var P: PUTF8Char; out Value: Variant;
  Sep: AnsiChar; AllowDouble: boolean): boolean;
var temp: RawUTF8;
begin
  if P=nil then
    result := false else begin
    GetNextItem(P,Sep,temp);
    if not GetNumericVariantFromJSON(pointer(temp),TVarData(Value),AllowDouble) then
      RawUTF8ToVariant(temp,Value);
    result := true;
  end;
end;

function GetVariantFromNotStringJSON(JSON: PUTF8Char; var Value: TVarData;
  AllowDouble: boolean): boolean;
begin
  if (JSON<>nil) and (JSON^ in [#1..' ']) then
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if (JSON=nil) or
     ((PInteger(JSON)^=NULL_LOW) and (JSON[4] in EndOfJSONValueField)) then
    Value.VType := varNull else
  if (PInteger(JSON)^=FALSE_LOW) and (JSON[4]='e') and
     (JSON[5] in EndOfJSONValueField) then begin
    Value.VType := varBoolean;
    Value.VBoolean := false;
  end else
  if (PInteger(JSON)^=TRUE_LOW) and (JSON[4] in EndOfJSONValueField) then begin
    Value.VType := varBoolean;
    Value.VBoolean := true;
  end else
    if not GetNumericVariantFromJSON(JSON,Value,AllowDouble) then begin
      result := false;
      exit;
    end;
  result := true;
end;

procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions; AllowDouble: boolean);
begin
  // first handle any strict-JSON syntax objects or arrays into custom variants
  // (e.g. when called directly from TSQLPropInfoRTTIVariant.SetValue)
  if (TryCustomVariants<>nil) and (JSON<>nil) then
    if (GotoNextNotSpace(JSON)^ in ['{','[']) and not wasString then begin
      GetJSONToAnyVariant(Value,JSON,nil,TryCustomVariants,AllowDouble);
      exit;
    end else
    AllowDouble := dvoAllowDoubleValue in TryCustomVariants^;
  // handle simple text or numerical values
  with TVarData(Value) do begin
    {$ifndef FPC}if VType and VTYPE_STATIC=0 then
      VType := varEmpty else{$endif}
      VarClear(Value);
    if not wasString and GetVariantFromNotStringJSON(JSON,TVarData(Value),AllowDouble) then
      exit;
    // found no numerical value -> return a string in the expected format
    VType := varString;
    VString := nil; // avoid GPF below when assigning a string variable to VAny
    FastSetString(RawUTF8(VString),JSON,StrLen(JSON));
  end;
end;

{$ifndef FPC} // better not try it with FPC - rely on the current implementation

function ParseParamPointer(P: pointer; aType: cardinal; var Value: TVarData): pointer;
var Size: Cardinal;
    ByRef: Boolean;
    V: Variant absolute Value;
const TYPE_BYREF = 128;
      TYPE_BYREF_MASK = TYPE_BYREF-1;
begin // this code should copy parameters without any reference count handling
  ZeroFill(@Value); // TVarData is expected to be bulk stack: no VarClear needed
  ByRef := (aType and TYPE_BYREF)<>0;
  Size := SizeOf(pointer);
  case aType and TYPE_BYREF_MASK of
  varShortInt, varSmallint, varInteger, varByte, varWord, varLongWord, varSingle: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := aType and TYPE_BYREF_MASK;
    Value.VInteger := PInteger(P)^;
    {$ifdef CPU64}
    if not ByRef then
      Size := SizeOf(Integer);
    {$endif}
  end;
  varDouble, varCurrency, varDate, varInt64, varWord64, varOleStr: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := aType and TYPE_BYREF_MASK;
    Value.VInt64 := PInt64(P)^;
    {$ifndef CPU64}
    if not ByRef then
      Size := SizeOf(Int64);
    {$endif}
  end;
  varStrArg: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := varString;
    Value.VString := PPointer(P)^;
  end;
  {$ifdef HASVARUSTRARG}
  varUStrArg: begin
    if ByRef then
      P := pointer(P^);
    Value.VType := varUString;
    Value.VUString := PPointer(P)^;
  end;
  {$endif}
  varBoolean:
    if ByRef then
      V := PWordBool(pointer(P^))^ else
      V := PWordBool(P)^;
  varVariant:
    {$ifdef CPU64} // circumvent Delphi x64 compiler oddiness
    Value := PVarData(pointer(P^))^
    {$else}
    if ByRef then
      Value := PVarData(pointer(P^))^ else begin
      Value := PVarData(P)^;
      Size := SizeOf(Value);
    end;
    {$endif}
  else
    raise EInvalidCast.CreateFmt('ParseParamPointer: Invalid VarType=%d',
      [aType and TYPE_BYREF_MASK]);
  end;
  result := PAnsiChar(P)+Size;
end;

var
  LastDispInvokeType: TSynInvokeableVariantType;

procedure SynVarDispProc(Result: PVarData; const Instance: TVarData;
  CallDesc: PCallDesc; Params: Pointer); cdecl;
const DO_PROP = 1; GET_PROP = 2; SET_PROP = 4;
var Value: TVarData;
    Handler: TSynInvokeableVariantType;
    CacheDispInvokeType: TSynInvokeableVariantType; // to be thread-safe
begin
  if Instance.VType=varByRef or varVariant then // handle By Ref variants
    SynVarDispProc(Result,PVarData(Instance.VPointer)^,CallDesc,Params) else begin
    if Result<>nil then
      VarClear(Variant(Result^));
    case Instance.VType of
    varDispatch, varDispatch or varByRef,
    varUnknown, varUnknown or varByRef, varAny:
      // process Ole Automation variants
      if Assigned(VarDispProc) then
        VarDispProc(pointer(Result),Variant(Instance),CallDesc,@Params);
    else begin
      // first we check for our own TSynInvokeableVariantType types
      if SynVariantTypes<>nil then begin
        // simple cache for the latest type: most gets are grouped
        CacheDispInvokeType := LastDispInvokeType;
        if (CacheDispInvokeType<>nil) and
           (CacheDispInvokeType.VarType=TVarData(Instance).VType) and
           (CallDesc^.CallType in [GET_PROP, DO_PROP]) and
           (Result<>nil) and (CallDesc^.ArgCount=0) then begin
          CacheDispInvokeType.IntGet(Result^,Instance,@CallDesc^.ArgTypes[0]);
          exit;
        end;
      end;
      // handle any custom variant type
      if FindCustomVariantType(Instance.VType,TCustomVariantType(Handler)) then begin
        if Handler.InheritsFrom(TSynInvokeableVariantType) then
          case CallDesc^.CallType of
          GET_PROP, DO_PROP: // fast direct call of our IntGet() virtual method
            if (Result<>nil) and (CallDesc^.ArgCount=0) then begin
              Handler.IntGet(Result^,Instance,@CallDesc^.ArgTypes[0]);
              LastDispInvokeType := Handler; // speed up in loop
              exit;
            end;
          SET_PROP: // fast direct call of our IntSet() virtual method
            if (Result=nil) and (CallDesc^.ArgCount=1) then begin
              ParseParamPointer(@Params,CallDesc^.ArgTypes[0],Value);
              Handler.IntSet(Instance,Value,@CallDesc^.ArgTypes[1]);
              exit;
            end;
          end;
        // here we call the default code handling custom types
        Handler.DispInvoke({$ifdef DELPHI6OROLDER}Result^{$else}Result{$endif},
          Instance,CallDesc,@Params)
      end else
        raise EInvalidOp.CreateFmt('Invalid variant type %d invoke',[Instance.VType]);
    end;
    end;
  end;
end;

function VariantsDispInvokeAddress: pointer;
asm
  {$ifdef CPU64}
  mov rax,offset Variants.@DispInvoke
  {$else}
  mov eax,offset Variants.@DispInvoke
  {$endif}
end;

{$ifdef DOPATCHTRTL}
  {$define DOPATCHDISPINVOKE} // much faster late-binding process for our types
{$endif}
{$ifdef CPU64}
  {$define DOPATCHDISPINVOKE}
  // we NEED our patched DispInvoke to circumvent some Delphi bugs on Win64
{$endif}
{$ifdef DELPHI6OROLDER}
  {$define DOPATCHDISPINVOKE}
  // to circumvent LIdent := Uppercase() in TInvokeableVariantType.DispInvoke()
{$endif}

{$endif FPC}

function SynRegisterCustomVariantType(aClass: TSynInvokeableVariantTypeClass): TSynInvokeableVariantType;
var i: integer;
{$ifdef DOPATCHDISPINVOKE}
{$ifdef NOVARCOPYPROC}
    VarMgr: TVariantManager;
{$endif}
{$endif}
begin
  if SynVariantTypes=nil then begin
    {$ifndef FPC}
    {$ifdef DOPATCHDISPINVOKE}
    {$ifndef CPU64} // we NEED our patched RTL on Win64
    if DebugHook=0 then // patch VCL/RTL only outside debugging
    {$endif} begin
      {$ifdef NOVARCOPYPROC}
      GetVariantManager(VarMgr);
      VarMgr.DispInvoke := @SynVarDispProc;
      SetVariantManager(VarMgr);
      {$else}
      RedirectCode(VariantsDispInvokeAddress,@SynVarDispProc);
      {$endif NOVARCOPYPROC}
    end;
    {$endif DOPATCHDISPINVOKE}
    {$endif FPC}
    GarbageCollectorFreeAndNil(SynVariantTypes,TObjectList.Create);
  end else
    for i := 0 to SynVariantTypes.Count-1 do
    if PPointer(SynVariantTypes.List[i])^=pointer(aClass) then begin
      result := SynVariantTypes.List[i]; // returns already registered instance
      exit;
    end;
  result :=  aClass.Create; // register variant type
  SynVariantTypes.Add(result);
end;


function VariantDynArrayToJSON(const V: TVariantDynArray): RawUTF8;
var tmp: TDocVariantData;
begin
  tmp.InitArrayFromVariants(V);
  result := tmp.ToJSON;
end;

function JSONToVariantDynArray(const JSON: RawUTF8): TVariantDynArray;
var tmp: TDocVariantData;
begin
  tmp.InitJSON(JSON,JSON_OPTIONS_FAST);
  result := tmp.VValue;
end;

function ValuesToVariantDynArray(const items: array of const): TVariantDynArray;
var tmp: TDocVariantData;
begin
  tmp.InitArray(items,JSON_OPTIONS_FAST);
  result := tmp.VValue;
end;


{ TDocVariantData }

function DocVariantData(const DocVariant: variant): PDocVariantData;
begin
  with TVarData(DocVariant) do
    if VType=word(DocVariantVType) then
      result := @DocVariant else
    if VType=varByRef or varVariant then
      result := DocVariantData(PVariant(VPointer)^) else
    raise EDocVariant.CreateUTF8('DocVariantType.Data(%<>TDocVariant)',[VType]);
end;

function _Safe(const DocVariant: variant): PDocVariantData;
{$ifdef FPC_OR_PUREPASCAL}
var docv: word;
begin
  result := @DocVariant;
  docv := DocVariantVType;
  if result.VType<>docv then
    if (result.VType=varByRef or varVariant) and
       (PVarData(PVarData(result)^.VPointer).VType=docv) then
      result := pointer(PVarData(result)^.VPointer) else
      result := @DocVariantDataFake;
end;
{$else}
asm
      mov   ecx,DocVariantVType
      movzx edx,word ptr [eax].TVarData.VType
      cmp   edx,ecx
      jne   @by
      ret
@ptr: mov   eax,[eax].TVarData.VPointer
      movzx edx,word ptr [eax].TVarData.VType
      cmp   edx,ecx
      je    @ok
@by:  cmp   edx,varByRef or varVariant
      je    @ptr
      lea   eax,[DocVariantDataFake]
@ok:
end;
{$endif}

function _Safe(const DocVariant: variant; ExpectedKind: TDocVariantKind): PDocVariantData;
begin
  result := _Safe(DocVariant);
  if result^.Kind<>ExpectedKind then
    raise EDocVariant.CreateUTF8('_Safe(%)<>%',[ToText(result^.Kind)^,ToText(ExpectedKind)^]);
end;

function _CSV(const DocVariantOrString: variant): RawUTF8;
begin
  with _Safe(DocVariantOrString)^ do
    if dvoIsArray in VOptions then
      result := ToCSV else
    if (dvoIsObject in VOptions) or (TDocVariantData(DocVariantOrString).VType<=varNull) or
       not VariantToUTF8(DocVariantOrString,result) then
      result := ''; // VariantToUTF8() returns 'null' for empty/null
end;

function TDocVariantData.GetKind: TDocVariantKind;
begin
  if dvoIsArray in VOptions then
    result := dvArray else
  if dvoIsObject in VOptions then
    result := dvObject else
    result := dvUndefined;
end;

procedure TDocVariantData.SetOptions(const opt: TDocVariantOptions);
begin
  VOptions := (opt-[dvoIsArray,dvoIsObject])+(VOptions*[dvoIsArray,dvoIsObject]);
end;

procedure TDocVariantData.Init(aOptions: TDocVariantOptions; aKind: TDocVariantKind);
begin
  ZeroFill(@self);
  VType := DocVariantVType;
  VOptions := aOptions-[dvoIsArray,dvoIsObject];
  case aKind of
    dvArray:  include(VOptions,dvoIsArray);
    dvObject: include(VOptions,dvoIsObject);
  end;
end;

procedure TDocVariantData.InitFast;
begin
  ZeroFill(@self);
  VType := DocVariantVType;
  VOptions := JSON_OPTIONS_FAST;
end;

procedure TDocVariantData.InitFast(InitialCapacity: integer; aKind: TDocVariantKind);
begin
  InitFast;
  case aKind of
    dvArray:  include(VOptions,dvoIsArray);
    dvObject: include(VOptions,dvoIsObject);
  end;
  if aKind=dvObject then
    SetLength(VName,InitialCapacity);
  SetLength(VValue,InitialCapacity);
end;

procedure TDocVariantData.InitObject(const NameValuePairs: array of const;
  aOptions: TDocVariantOptions=[]);
begin
  Init(aOptions,dvObject);
  AddNameValuesToObject(NameValuePairs);
end;

procedure TDocVariantData.AddNameValuesToObject(const NameValuePairs: array of const);
var n,arg: integer;
    tmp: variant;
begin
  n := length(NameValuePairs) shr 1;
  if (n=0) or (dvoIsArray in VOptions) then
    exit; // nothing to add
  include(VOptions,dvoIsObject);
  if length(VValue)<VCount+n then begin
    SetLength(VValue,VCount+n);
    SetLength(VName,VCount+n);
  end;
  for arg := 0 to n-1 do begin
    VarRecToUTF8(NameValuePairs[arg*2],VName[arg+VCount]);
    if dvoInternNames in VOptions then
      DocVariantType.InternNames.UniqueText(VName[arg+VCount]);
    if dvoValueCopiedByReference in VOptions then
      VarRecToVariant(NameValuePairs[arg*2+1],VValue[arg+VCount]) else begin
      VarRecToVariant(NameValuePairs[arg*2+1],tmp);
      SetVariantByValue(tmp,VValue[arg+VCount]);
    end;
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[arg+VCount]);
  end;
  inc(VCount,n);
end;

procedure TDocVariantData.AddOrUpdateNameValuesToObject(const NameValuePairs: array of const);
var n,arg: integer;
    n2: RawUTF8;
    v: Variant;
begin
  n := length(NameValuePairs) shr 1;
  if (n=0) or (dvoIsArray in VOptions) then
    exit; // nothing to add
  for arg := 0 to n-1 do begin
    VarRecToUTF8(NameValuePairs[arg*2],n2);
    VarRecToVariant(NameValuePairs[arg*2+1],v);
    AddOrUpdateValue(n2,v)
  end;
end;

procedure TDocVariantData.AddOrUpdateObject(const NewValues: variant;
  OnlyAddMissing: boolean; RecursiveUpdate: boolean);
var n, idx: integer;
    new: PDocVariantData;
    wasAdded: boolean;
begin
  new := _Safe(NewValues);
  if not(dvoIsArray in VOptions) and not(dvoIsArray in new^.VOptions) then
    for n := 0 to new^.Count-1 do begin
      idx := AddOrUpdateValue(new^.names[n],new^.Values[n],@wasAdded,OnlyAddMissing);
      if RecursiveUpdate and not wasAdded then
        TDocVariantData(Values[idx]).AddOrUpdateObject(new^.Values[n],OnlyAddMissing,true);
    end;
end;

procedure TDocVariantData.InitArray(const Items: array of const;
  aOptions: TDocVariantOptions=[]);
var arg: integer;
    tmp: variant;
begin
  Init(aOptions,dvArray);
  if high(Items)>=0 then begin
    VCount := length(Items);
    SetLength(VValue,VCount);
    if dvoValueCopiedByReference in aOptions then
      for arg := 0 to high(Items) do
        VarRecToVariant(Items[arg],VValue[arg]) else
      for arg := 0 to high(Items) do begin
        VarRecToVariant(Items[arg],tmp);
        SetVariantByValue(tmp,VValue[arg]);
      end;
  end;
end;

procedure TDocVariantData.InitArrayFromVariants(const Items: TVariantDynArray;
  aOptions: TDocVariantOptions; ItemsCopiedByReference: boolean);
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    VValue := Items; // fast by-reference copy of VValue[]
    if not ItemsCopiedByReference then
      InitCopy(variant(self),aOptions);
  end;
end;

procedure TDocVariantData.InitArrayFromObjArray(const ObjArray;
  aOptions: TDocVariantOptions; aWriterOptions: TTextWriterWriteObjectOptions);
var ndx: integer;
    Items: TObjectDynArray absolute ObjArray;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      ObjectToVariant(Items[ndx],VValue[ndx],aWriterOptions);
  end;
end;

procedure TDocVariantData.InitArrayFrom(const Items: TRawUTF8DynArray; aOptions: TDocVariantOptions);
var ndx: integer;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      RawUTF8ToVariant(Items[ndx],VValue[ndx]);
  end;
end;

procedure TDocVariantData.InitArrayFrom(const Items: TIntegerDynArray; aOptions: TDocVariantOptions);
var ndx: integer;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      VValue[ndx] := Items[ndx];
  end;
end;

procedure TDocVariantData.InitArrayFrom(const Items: TInt64DynArray; aOptions: TDocVariantOptions);
var ndx: integer;
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do
      VValue[ndx] := Items[ndx];
  end;
end;

procedure TDocVariantData.InitFromTypeInfo(const aValue; aTypeInfo: pointer;
  aEnumSetsAsText: boolean; aOptions: TDocVariantOptions);
var tmp: RawUTF8;
begin
  tmp := SaveJSON(aValue,aTypeInfo,aEnumSetsAsText);
  InitJSONInPlace(pointer(tmp),aOptions);
end;

procedure TDocVariantData.InitObjectFromVariants(const aNames: TRawUTF8DynArray;
  const aValues: TVariantDynArray; aOptions: TDocVariantOptions=[]);
begin
  if (aNames=nil) or (aValues=nil) or (length(aNames)<>length(aValues)) then
    VType := varNull else begin
    Init(aOptions,dvObject);
    VCount := length(aNames);
    VName := aNames; // fast by-reference copy of VName[] and VValue[]
    VValue := aValues;
  end;
end;

procedure TDocVariantData.InitObjectFromPath(const aPath: RawUTF8; const aValue: variant;
  aOptions: TDocVariantOptions=[]);
var right: RawUTF8;
begin
  if aPath='' then
    VType := varNull else begin
    Init(aOptions,dvObject);
    VCount := 1;
    SetLength(VName,1);
    SetLength(VValue,1);
    split(aPath,'.',VName[0],right);
    if right='' then
      VValue[0] := aValue else
      PDocVariantData(@VValue[0])^.InitObjectFromPath(right,aValue,aOptions);
  end;
end;

function TDocVariantData.InitJSONInPlace(JSON: PUTF8Char;
  aOptions: TDocVariantOptions; aEndOfObject: PUTF8Char): PUTF8Char;
var EndOfObject: AnsiChar;
    Name: PUTF8Char;
    NameLen, n: integer;
    intnames, intvalues: TRawUTF8Interning;
begin
  Init(aOptions);
  result := nil;
  if JSON=nil then
    exit;
  if dvoInternValues in VOptions then
    intvalues := DocVariantType.InternValues else
    intvalues := nil;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  case JSON^ of
  '[': begin
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    n := JSONArrayCount(JSON); // may be slow if JSON is huge (not very common)
    if n<0 then
      exit; // invalid content
    include(VOptions,dvoIsArray);
    if n>0 then begin
      SetLength(VValue,n);
      repeat
        if VCount>=n then
          exit; // unexpected array size means invalid JSON
        GetJSONToAnyVariant(VValue[VCount],JSON,@EndOfObject,@VOptions,false);
        if JSON=nil then
          if EndOfObject=']' then // valid end input
            JSON := @NULCHAR else
            exit; // invalid input
        if intvalues<>nil then
          intvalues.UniqueVariant(VValue[VCount]);
        inc(VCount);
      until EndOfObject=']';
    end else
      if JSON^=']' then // n=0
        repeat inc(JSON) until not(JSON^ in [#1..' ']) else
        exit;
  end;
  '{': begin
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    n := JSONObjectPropCount(JSON); // may be slow if JSON is huge (not very common)
    if n<0 then
      exit; // invalid content
    include(VOptions,dvoIsObject);
    if dvoInternNames in VOptions then
      intnames := DocVariantType.InternNames else
      intnames := nil;
    if n>0 then begin
      SetLength(VValue,n);
      SetLength(VName,n);
      repeat
        if VCount>=n then
          exit; // unexpected object size means invalid JSON
        // see http://docs.mongodb.org/manual/reference/mongodb-extended-json
        Name := GetJSONPropName(JSON,@NameLen);
        if Name=nil then
          exit;
        FastSetString(VName[VCount],Name,NameLen);
        if intnames<>nil then
          intnames.UniqueText(VName[VCount]);
        GetJSONToAnyVariant(VValue[VCount],JSON,@EndOfObject,@VOptions,false);
        if JSON=nil then
          if EndOfObject=']' then // valid end input
            JSON := @NULCHAR else
            exit; // invalid input
        if intvalues<>nil then
          intvalues.UniqueVariant(VValue[VCount]);
        inc(VCount);
      until EndOfObject='}';
    end else
      if JSON^='}' then // n=0
        repeat inc(JSON) until not(JSON^ in [#1..' ']) else
        exit;
  end;
  'n','N': begin
    if IdemPChar(JSON+1,'ULL') then begin
      include(VOptions,dvoIsObject);
      result := GotoNextNotSpace(JSON+4);
    end;
    exit;
  end;
  else exit;
  end;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if aEndOfObject<>nil then
    aEndOfObject^ := JSON^;
  if JSON^<>#0 then
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
  result := JSON; // indicates successfully parsed
end;

function TDocVariantData.InitJSON(const JSON: RawUTF8;
  aOptions: TDocVariantOptions): boolean;
var tmp: TSynTempBuffer;
begin
  if JSON='' then
    result := false else begin
    tmp.Init(JSON);
    try
      result := InitJSONInPlace(tmp.buf,aOptions)<>nil;
    finally
      tmp.Done;
    end;
  end;
end;

function TDocVariantData.InitJSONFromFile(const JsonFile: TFileName;
  aOptions: TDocVariantOptions; RemoveComments: boolean): boolean;
var content: RawUTF8;
begin
  content := AnyTextFileToRawUTF8(JsonFile,true);
  if RemoveComments then
    RemoveCommentsFromJSON(pointer(content));
  result := InitJSONInPlace(pointer(content),aOptions)<>nil;
end;

procedure TDocVariantData.InitCSV(CSV: PUTF8Char; aOptions: TDocVariantOptions;
  NameValueSep, ItemSep: AnsiChar; DoTrim: boolean);
var n,v: RawUTF8;
    val: variant;
begin
  Init(aOptions,dvObject);
  while CSV<>nil do begin
    GetNextItem(CSV,NameValueSep,n);
    if ItemSep=#10 then
      GetNextItemTrimedCRLF(CSV,v) else
      GetNextItem(CSV,ItemSep,v);
    if DoTrim then
      v := trim(v);
    if n='' then
      break;
    RawUTF8ToVariant(v,val);
    AddValue(n,val);
  end;
end;

procedure TDocVariantData.InitCSV(const CSV: RawUTF8; aOptions: TDocVariantOptions;
  NameValueSep, ItemSep: AnsiChar; DoTrim: boolean);
begin
  InitCSV(pointer(CSV),aOptions,NameValueSep,ItemSep,DoTrim);
end;

procedure TDocVariantData.InitCopy(const SourceDocVariant: variant;
  aOptions: TDocVariantOptions);
var ndx: integer;
    Source: PDocVariantData;
    SourceVValue: TVariantDynArray;
    Handler: TCustomVariantType;
    t: word;
    v: PVarData;
begin
  with TVarData(SourceDocVariant) do
    if VType=varByRef or varVariant then
      Source := VPointer else
      Source := @SourceDocVariant;
  if Source^.VType<>DocVariantVType then
    raise ESynException.CreateUTF8('No TDocVariant for InitCopy(%)',[Source.VType]);
  SourceVValue := Source^.VValue; // local fast per-reference copy
  if Source<>@self then begin
    VType := Source^.VType;
    VCount := Source^.VCount;
    pointer(VName) := nil;  // avoid GPF
    pointer(VValue) := nil;
    VOptions := aOptions-[dvoIsArray,dvoIsObject]; // may not be same as Source
    if dvoIsArray in Source^.VOptions then
      include(VOptions,dvoIsArray) else
    if dvoIsObject in Source^.VOptions then begin
      include(VOptions,dvoIsObject);
      SetLength(VName,VCount);
      for ndx := 0 to VCount-1 do
        VName[ndx] := Source^.VName[ndx]; // manual copy is needed
      if dvoInternNames in VOptions then
        with DocVariantType.InternNames do
          for ndx := 0 to VCount-1 do
            UniqueText(VName[ndx]);
    end;
  end else begin
    SetOptions(aOptions);
    VariantDynArrayClear(VValue); // force re-create full copy of all values
  end;
  if VCount>0 then begin
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do begin
      v := @SourceVValue[ndx];
      while v^.VType=varByRef or varVariant do
        v := v^.VPointer;
      t := v^.VType;
      if t<=varNativeString then // simple string/number types copy
        VValue[ndx] := variant(v^) else
      if t=VType then // direct recursive copy for TDocVariant
        TDocVariantData(VValue[ndx]).InitCopy(variant(v^),aOptions) else
      if FindCustomVariantType(t,Handler) then
        if Handler.InheritsFrom(TSynInvokeableVariantType) then
          TSynInvokeableVariantType(Handler).CopyByValue(
            TVarData(VValue[ndx]),v^) else
          Handler.Copy(TVarData(VValue[ndx]),v^,false) else
        VValue[ndx] := variant(v^); // default copy
    end;
    if dvoInternValues in VOptions then
      with DocVariantType.InternValues do
        for ndx := 0 to VCount-1 do
          UniqueVariant(VValue[ndx]);
  end;
  VariantDynArrayClear(SourceVValue); // faster alternative
end;

procedure TDocVariantData.Clear;
begin
  if VType=DocVariantVType then begin
    PInteger(@VType)^ := 0;
    VName := nil;
    VariantDynArrayClear(VValue);
    VCount := 0;
  end else
    VarClear(variant(self));
end;

procedure TDocVariantData.Reset;
var backup: TDocVariantOptions;
begin
  if VCount=0 then
    exit;
  backup := VOptions-[dvoIsArray,dvoIsObject];
  DocVariantType.Clear(TVarData(self));
  VType := DocVariantVType;
  VOptions := backup;
end;

procedure TDocVariantData.FillZero;
var ndx: integer;
begin
  for ndx := 0 to VCount-1 do
    SynCommons.FillZero(VValue[ndx]);
  Reset;
end;

procedure TDocVariantData.SetCount(aCount: integer);
begin
  VCount := aCount;
end;

function TDocVariantData.InternalAdd(const aName: RawUTF8): integer;
var len: integer;
begin
  if aName<>'' then begin
    if dvoIsArray in VOptions then
      raise EDocVariant.CreateUTF8('Unexpected "%" property name in an array',[aName]);
    if not(dvoIsObject in VOptions) then begin
      VType := DocVariantVType; // may not be set yet
      include(VOptions,dvoIsObject);
    end;
  end else begin
    if dvoIsObject in VOptions then
      raise EDocVariant.Create('Unexpected array item added to an object');
    if not(dvoIsArray in VOptions) then begin
      VType := DocVariantVType; // may not be set yet
      include(VOptions,dvoIsArray);
    end;
  end;
  len := length(VValue);
  if VCount>=len then begin
    len := NextGrow(VCount);
    SetLength(VValue,len);
  end;
  if aName<>'' then begin
    if Length(VName)<>len then
      SetLength(VName,len);
    if dvoInternNames in VOptions then begin // inlined InternNames method
      if DocVariantType.fInternNames=nil then
        DocVariantType.fInternNames := TRawUTF8Interning.Create;
      DocVariantType.fInternNames.Unique(VName[VCount],aName);
    end else
      VName[VCount] := aName;
  end;
  result := VCount;
  inc(VCount);
end;

procedure TDocVariantData.SetCapacity(aValue: integer);
begin
  if dvoIsObject in VOptions then
    SetLength(VName,aValue);
  SetLength(VValue,aValue);
end;

function TDocVariantData.GetCapacity: integer;
begin
  result := length(VValue);
end;

function TDocVariantData.AddValue(const aName: RawUTF8; const aValue: variant): integer;
begin
  if dvoCheckForDuplicatedNames in VOptions then begin
    result := GetValueIndex(aName);
    if result>=0 then
      raise EDocVariant.CreateUTF8('Duplicated "%" name',[aName]);
  end;
  result := InternalAdd(aName); // FPC does not allow VValue[InternalAdd(aName)]
  SetVariantByValue(aValue,VValue[result]);
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result]);
end;

function TDocVariantData.AddValue(aName: PUTF8Char; aNameLen: integer; const aValue: variant): integer;
var tmp: RawUTF8;
begin
  FastSetString(tmp,aName,aNameLen);
  result := AddValue(tmp,aValue);
end;

function TDocVariantData.AddValueFromText(const aName,aValue: RawUTF8;
  Update, AllowVarDouble: boolean): integer;
begin
  if aName='' then begin
    result := -1;
    exit;
  end;
  result := GetValueIndex(aName);
  if not Update and (dvoCheckForDuplicatedNames in VOptions) and (result>=0) then
    raise EDocVariant.CreateUTF8('Duplicated "%" name',[aName]);
  if result<0 then
    result := InternalAdd(aName);
  VarClear(VValue[result]);
  if not GetNumericVariantFromJSON(pointer(aValue),TVarData(VValue[result]),AllowVarDouble) then
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[result],aValue) else
      RawUTF8ToVariant(aValue,VValue[result]);
end;

procedure TDocVariantData.AddByPath(const aSource: TDocVariantData;
  const aPaths: array of RawUTF8);
var p,added: integer;
    v: TVarData;
begin
  if (aSource.Count=0) or not(dvoIsObject in aSource.VOptions) or
     (dvoIsArray in VOptions) then
    exit;
  for p := 0 to High(aPaths) do begin
    DocVariantType.Lookup(v,TVarData(aSource),pointer(aPaths[p]));
    if v.VType<varNull then
      continue; // path not found
    added := InternalAdd(aPaths[p]);
    PVarData(@VValue[added])^ := v;
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[added]);
  end;
end;

procedure TDocVariantData.AddFrom(const aDocVariant: Variant);
var src: PDocVariantData;
    ndx: integer;
begin
  src := _Safe(aDocVariant);
  if src^.Count=0 then
    exit; // nothing to add
  if dvoIsArray in src^.VOptions then
    // add array items
    if dvoIsObject in VOptions then // types should match
      exit else
    for ndx := 0 to src^.Count-1 do
      AddItem(src^.VValue[ndx]) else
    // add object items
    if dvoIsArray in VOptions then // types should match
      exit else
    for ndx := 0 to src^.Count-1 do
      AddValue(src^.VName[ndx],src^.VValue[ndx]);
end;

procedure TDocVariantData.AddOrUpdateFrom(const aDocVariant: Variant; aOnlyAddMissing: boolean);
var src: PDocVariantData;
    ndx: integer;
begin
  src := _Safe(aDocVariant,dvObject);
  for ndx := 0 to src^.Count-1 do
    AddOrUpdateValue(src^.VName[ndx],src^.VValue[ndx],nil,aOnlyAddMissing);
end;

function TDocVariantData.AddItem(const aValue: variant): integer;
begin
  result := InternalAdd(''); // FPC does not allow VValue[InternalAdd(aName)]
  SetVariantByValue(aValue,VValue[result]);
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result]);
end;

function TDocVariantData.AddItemFromText(const aValue: RawUTF8;
  AllowVarDouble: boolean): integer;
begin
  result := InternalAdd(''); // FPC does not allow VValue[InternalAdd(aName)]
  if not GetNumericVariantFromJSON(pointer(aValue),TVarData(VValue[result]),AllowVarDouble) then
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[result],aValue) else
      RawUTF8ToVariant(aValue,VValue[result]);
end;

function TDocVariantData.AddItemText(const aValue: RawUTF8): integer;
begin
  result := InternalAdd(''); // FPC does not allow VValue[InternalAdd(aName)]
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result],aValue) else
    RawUTF8ToVariant(aValue,VValue[result]);
end;

procedure TDocVariantData.AddItems(const aValue: array of const);
var ndx,added: integer;
begin
  for ndx := 0 to high(aValue) do begin
    added := InternalAdd(''); // FPC does not allow VValue[InternalAdd(aName)]
    VarRecToVariant(aValue[ndx],VValue[added]);
    if dvoInternValues in VOptions then
      DocVariantType.InternValues.UniqueVariant(VValue[added]);
  end;
end;

function TDocVariantData.SearchItemByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): integer;
var ndx: integer;
begin
  if dvoIsObject in VOptions then begin
    result := GetValueIndex(aPropName);
    if (result>=0) and VariantEquals(VValue[result],aPropValue,aPropValueCaseSensitive) then
      exit;
  end else
  if dvoIsArray in VOptions then
    for result := 0 to VCount-1 do
      with _Safe(VValue[result])^ do
      if dvoIsObject in VOptions then begin
        ndx := GetValueIndex(aPropName);
        if (ndx>=0) and VariantEquals(VValue[ndx],aPropValue,aPropValueCaseSensitive) then
          exit;
      end;
  result := -1;
end;

function TDocVariantData.SearchItemByProp(const aPropNameFmt: RawUTF8;
  const aPropNameArgs: array of const; const aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): integer;
var name: RawUTF8;
begin
  FormatUTF8(aPropNameFmt,aPropNameArgs,name);
  result := SearchItemByProp(name,aPropValue,aPropValueCaseSensitive);
end;

function TDocVariantData.SearchItemByValue(const aValue: Variant;
  CaseInsensitive: boolean; StartIndex: integer): integer;
begin
  for result := StartIndex to VCount-1 do
    if SortDynArrayVariantComp(TVarData(VValue[result]),TVarData(aValue),CaseInsensitive)=0 then
      exit;
  result := -1;
end;

procedure QuickSortDocVariant(names: PPointerArray; values: PVariantArray;
  L, R: PtrInt; Compare: TUTF8Compare);
var I, J, P: PtrInt;
    pivot, tempname: pointer;
    tempvalue: TVarData;
    vi, vj: PVarData;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := names[P];
      while Compare(names[I],pivot)<0 do Inc(I);
      while Compare(names[J],pivot)>0 do Dec(J);
      if I <= J then begin
        if I <> J then begin
          tempname := names[J]; names[J] := names[I]; names[I] := tempname;
          vi := @values[I]; vj := @values[J];
          tempvalue := vj^; vj^ := vi^; vi^ := tempvalue;
        end;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortDocVariant(names, values, L, J, Compare);
      L := I;
    end else begin
      if I < R then
        QuickSortDocVariant(names, values, I, R, Compare);
      R := J;
    end;
  until L >= R;
end;

procedure TDocVariantData.SortByName(Compare: TUTF8Compare=nil);
begin
  if not(dvoIsObject in VOptions) or (VCount=0) then
    exit;
  if not Assigned(Compare) then
    Compare := @StrIComp;
  QuickSortDocVariant(pointer(VName),pointer(VValue),0,VCount-1,Compare);
end;

procedure ExchgValues(v1,v2: PVarData);
var v: TVarData;
begin
  v := v2^;
  v2^ := v1^;
  v1^ := v;
end;

procedure ExchgNames(n1,n2: PPointer); {$ifdef HASINLINE}inline;{$endif}
var n: pointer;
begin
  n := n2^;
  n2^ := n1^;
  n1^ := n;
end;

procedure QuickSortDocVariantValues(var Doc: TDocVariantData;
  L, R: PtrInt; Compare: TVariantCompare);
var I, J, P: PtrInt;
    pivot: PVariant;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := @Doc.VValue[P];
      while Compare(Doc.VValue[I],pivot^)<0 do Inc(I);
      while Compare(Doc.VValue[J],pivot^)>0 do Dec(J);
      if I <= J then begin
        if I <> J then begin
          if Doc.VName<>nil then
            ExchgNames(@Doc.VName[I],@Doc.VName[J]);
          ExchgValues(@Doc.VValue[I],@Doc.VValue[J]);
        end;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortDocVariantValues(Doc, L, J, Compare);
      L := I;
    end else begin
      if I < R then
        QuickSortDocVariantValues(Doc, I, R, Compare);
      R := J;
    end;
  until L >= R;
end;

procedure TDocVariantData.SortByValue(Compare: TVariantCompare);
begin
  if VCount<=0 then
    exit;
  if not Assigned(Compare) then
    Compare := VariantCompare;
  QuickSortDocVariantValues(self,0,VCount-1,Compare);
end;

type
  {$ifdef FPC_OR_UNICODE}TQuickSortDocVariantValuesByField = record
  {$else}TQuickSortDocVariantValuesByField = object{$endif}
    Lookup: array of PVariant;
    Compare: TVariantCompare;
    Doc: PDocVariantData;
    Reverse: boolean;
    procedure Sort(L, R: PtrInt);
  end;

procedure TQuickSortDocVariantValuesByField.Sort(L, R: PtrInt);
var I, J, P: PtrInt;
    pivot: PVariant;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Lookup[P];
      if Reverse then begin
        while Compare(Lookup[I]^,pivot^)<0 do Inc(I);
        while Compare(Lookup[J]^,pivot^)>0 do Dec(J);
      end
      else begin
        while Compare(Lookup[I]^,pivot^)>0 do Inc(I);
        while Compare(Lookup[J]^,pivot^)<0 do Dec(J);
      end;
      if I <= J then begin
        if I <> J then begin
          if Doc.VName<>nil then
            ExchgNames(@Doc.VName[I],@Doc.VName[J]);
          ExchgValues(@Doc.VValue[I],@Doc.VValue[J]);
          pivot := Lookup[I];
          Lookup[I] := Lookup[J];
          Lookup[J] := pivot;
        end;
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        Sort(L,J);
      L := I;
    end else begin
      if I < R then
        Sort(I,R);
      R := J;
    end;
  until L >= R;
end;

procedure TDocVariantData.SortArrayByField(const aItemPropName: RawUTF8;
  aValueCompare: TVariantCompare; aValueCompareReverse: boolean; aNameSortedCompare: TUTF8Compare);
var
  QS: TQuickSortDocVariantValuesByField;
  p: pointer;
  row: PtrInt;
begin
  if (VCount<=0) or (aItemPropName='') or not (dvoIsArray in VOptions) then
    exit;
  if not Assigned(aValueCompare) then
    QS.Compare := VariantCompare else
    QS.Compare := aValueCompare;
  QS.Reverse := aValueCompareReverse;
  SetLength(QS.Lookup,VCount);
  for row := 0 to VCount-1 do begin // resolve GetPVariantByName(aIdemPropName) once
    p := _Safe(VValue[row])^.GetVarData(aItemPropName,aNameSortedCompare);
    if p = nil then
      p := @NullVarData;
    QS.Lookup[row] := p;
  end;
  QS.Doc := @self;
  QS.Sort(0,VCount-1);
end;

procedure TDocVariantData.Reverse;
var arr: TDynArray;
begin
  if VCount=0 then
    exit;
  if VName<>nil then begin
    SetLength(VName,VCount);
    arr.Init(TypeInfo(TRawUTF8DynArray),VName);
    arr.Reverse;
  end;
  if VValue<>nil then begin
    SetLength(VValue,VCount);
    arr.Init(TypeInfo(TVariantDynArray),VValue);
    arr.Reverse;
  end;
end;

function TDocVariantData.Reduce(const aPropNames: array of RawUTF8;
  aCaseSensitive,aDoNotAddVoidProp: boolean): variant;
begin
  VarClear(result);
  Reduce(aPropNames,aCaseSensitive,PDocVariantData(@result)^,aDoNotAddVoidProp);
end;

procedure TDocVariantData.Reduce(const aPropNames: array of RawUTF8;
  aCaseSensitive: boolean; out result: TDocVariantData; aDoNotAddVoidProp: boolean);
var ndx,j: integer;
    reduced: TDocVariantData;
begin
  result.InitFast;
  if (VCount=0) or (high(aPropNames)<0) then
    exit;
  if dvoIsObject in VOptions then begin
    if aCaseSensitive then begin
      for j := 0 to high(aPropNames) do
        for ndx := 0 to VCount-1 do
          if VName[ndx]=aPropNames[j] then begin
            if not aDoNotAddVoidProp or not VarIsVoid(VValue[ndx]) then
              result.AddValue(VName[ndx],VValue[ndx]);
            break;
          end;
    end else
      for j := 0 to high(aPropNames) do
        for ndx := 0 to VCount-1 do
          if IdemPropNameU(VName[ndx],aPropNames[j]) then begin
            if not aDoNotAddVoidProp or not VarIsVoid(VValue[ndx]) then
              result.AddValue(VName[ndx],VValue[ndx]);
            break;
          end;
  end else
  if dvoIsArray in VOptions then
    for ndx := 0 to VCount-1 do begin
      _Safe(VValue[ndx])^.Reduce(aPropNames,aCaseSensitive,reduced,aDoNotAddVoidProp);
      if dvoIsObject in reduced.VOptions then
        result.AddItem(variant(reduced));
    end;
end;

function TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  OnReduce: TOnReducePerItem): variant;
begin
  VarClear(result);
  ReduceAsArray(aPropName,PDocVariantData(@result)^,OnReduce);
end;

procedure TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  out result: TDocVariantData; OnReduce: TOnReducePerItem);
var ndx,j: integer;
    item: PDocVariantData;
begin
  result.InitFast;
  if (VCount=0) or (aPropName='') or not(dvoIsArray in VOptions) then
    exit;
  for ndx := 0 to VCount-1 do begin
    item := _Safe(VValue[ndx]);
    j := item^.GetValueIndex(aPropName);
    if j>=0 then
      if not Assigned(OnReduce) or OnReduce(item) then
        result.AddItem(item^.VValue[j]);
  end;
end;

function TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  OnReduce: TOnReducePerValue): variant;
begin
  VarClear(result);
  ReduceAsArray(aPropName,PDocVariantData(@result)^,OnReduce);
end;

procedure TDocVariantData.ReduceAsArray(const aPropName: RawUTF8;
  out result: TDocVariantData; OnReduce: TOnReducePerValue);
var ndx,j: integer;
    item: PDocVariantData;
    v: PVariant;
begin
  result.InitFast;
  if (VCount=0) or (aPropName='') or not(dvoIsArray in VOptions) then
    exit;
  for ndx := 0 to VCount-1 do begin
    item := _Safe(VValue[ndx]);
    j := item^.GetValueIndex(aPropName);
    if j>=0 then begin
      v := @item^.VValue[j];
      if not Assigned(OnReduce) or OnReduce(v^) then
        result.AddItem(v^);
    end;
  end;
end;

function TDocVariantData.Rename(const aFromPropName, aToPropName: TRawUTF8DynArray): integer;
var n, p, ndx: integer;
begin
  result := 0;
  n := length(aFromPropName);
  if length(aToPropName)=n then
    for p := 0 to n-1 do begin
      ndx := GetValueIndex(aFromPropName[p]);
      if ndx>=0 then begin
        VName[ndx] := aToPropName[p];
        inc(result);
      end;
    end;
end;

function TDocVariantData.FlattenAsNestedObject(const aObjectPropName: RawUTF8): boolean;
var ndx,len: integer;
    Up: array[byte] of AnsiChar;
    nested: TDocVariantData;
begin // {"p.a1":5,"p.a2":"dfasdfa"} -> {"p":{"a1":5,"a2":"dfasdfa"}}
  result := false;
  if (VCount=0) or (aObjectPropName='') or not(dvoIsObject in VOptions) then
    exit;
  PWord(UpperCopy255(Up,aObjectPropName))^ := ord('.'); // e.g. 'P.'
  for ndx := 0 to Count-1 do
    if not IdemPChar(pointer(VName[ndx]),Up) then
      exit; // all fields should match "p.####"
  len := length(aObjectPropName)+1;
  for ndx := 0 to Count-1 do
    system.delete(VName[ndx],1,len);
  nested := self;
  Clear;
  InitObject([aObjectPropName,variant(nested)]);
  result := true;
end;

function TDocVariantData.Delete(Index: integer): boolean;
begin
  if cardinal(Index)>=cardinal(VCount) then
    result := false else begin
    dec(VCount);
    if VName<>nil then
      VName[Index] := '';
    VarClear(VValue[Index]);
    if Index<VCount then begin
      if VName<>nil then begin
        {$ifdef FPC}Move{$else}MoveFast{$endif}(
          VName[Index+1],VName[Index],(VCount-Index)*SizeOf(pointer));
        PtrUInt(VName[VCount]) := 0; // avoid GPF
      end;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(
        VValue[Index+1],VValue[Index],(VCount-Index)*SizeOf(variant));
      TVarData(VValue[VCount]).VType := varEmpty; // avoid GPF
    end;
    result := true;
  end;
end;

function TDocVariantData.Delete(const aName: RawUTF8): boolean;
begin
  result := Delete(GetValueIndex(aName));
end;

function TDocVariantData.DeleteByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): boolean;
var ndx: integer;
begin
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    result := false else
    result := Delete(ndx);
end;

function TDocVariantData.DeleteByValue(const aValue: Variant;
  CaseInsensitive: boolean): integer;
var ndx: integer;
begin
  result := 0;
  if VarIsEmptyOrNull(aValue) then begin
    for ndx := VCount-1 downto 0 do
      if VarDataIsEmptyOrNull(@VValue[ndx]) then begin
        Delete(ndx);
        inc(result);
      end;
  end else
    for ndx := VCount-1 downto 0 do
      if SortDynArrayVariantComp(TVarData(VValue[ndx]),TVarData(aValue),CaseInsensitive)=0 then begin
        Delete(ndx);
        inc(result);
      end;
end;

function TDocVariantData.DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
var ndx: integer;
    upname: array[byte] of AnsiChar;
begin
  result := 0;
  if aStartNameLen=0 then
    aStartNameLen := StrLen(aStartName);
  if (VCount=0) or not(dvoIsObject in VOptions) or (aStartNameLen=0) then
    exit;
  UpperCopy255Buf(upname,aStartName,aStartNameLen)^ := #0;
  for ndx := Count-1 downto 0 do
    if IdemPChar(pointer(names[ndx]),upname) then begin
      Delete(ndx);
      inc(result);
    end;
end;

function TDocVariantData.GetValueIndex(aName: PUTF8Char; aNameLen: PtrInt;
  aCaseSensitive: boolean): integer;
var err: integer;
    n: PRawUTF8;
begin
  if (VType=DocVariantVType) and (VCount>0) then begin
    if dvoIsArray in VOptions then begin
      result := GetInteger(aName,err);
      if err<>0 then
        raise EDocVariant.CreateUTF8('Impossible to find "%" property in an array',[aName]);
      if cardinal(result)>=cardinal(VCount) then
        raise EDocVariant.CreateUTF8('Out of range [%] property in an array',[aName]);
      exit;
    end;
    // O(n) lookup for object names -> huge count may take some time
    n := pointer(VName);
    if aCaseSensitive then begin
      for result := 0 to VCount-1 do
        if (length(n^)=aNameLen) and CompareMem(pointer(n^),aName,aNameLen) then
          exit else
          inc(n);
    end else
      for result := 0 to VCount-1 do
        if (length(n^)=aNameLen) and IdemPropNameUSameLen(pointer(n^),aName,aNameLen) then
          exit else
          inc(n);
  end;
  result := -1;
end;

function TDocVariantData.GetValueIndex(const aName: RawUTF8): integer;
begin
  {$ifndef HASINLINE}
  if not(dvoNameCaseSensitive in VOptions) and (dvoIsObject in VOptions) and
     (VType=DocVariantVType) then begin
    for result := 0 to VCount-1 do
      if IdemPropNameU(VName[result],aName) then
        exit;
    result := -1;
  end else
  {$endif}
  result := GetValueIndex(Pointer(aName),Length(aName),dvoNameCaseSensitive in VOptions);
end;

function TDocVariantData.GetValueOrRaiseException(const aName: RawUTF8): variant;
begin
  RetrieveValueOrRaiseException(pointer(aName),length(aName),
    dvoNameCaseSensitive in VOptions,result,false);
end;

function TDocVariantData.GetValueOrDefault(const aName: RawUTF8;
  const aDefault: variant): variant;
var ndx: integer;
begin
  if (VType<>DocVariantVType) or not(dvoIsObject in VOptions) then
    result := aDefault else begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx] else
      result := aDefault;
  end;
end;

function TDocVariantData.GetValueOrNull(const aName: RawUTF8): variant;
var ndx: integer;
begin
  if (VType<>DocVariantVType) or not(dvoIsObject in VOptions) then
    SetVariantNull(result) else begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx] else
      SetVariantNull(result);
  end;
end;

function TDocVariantData.GetValueOrEmpty(const aName: RawUTF8): variant;
var ndx: integer;
begin
  VarClear(result);
  if (VType=DocVariantVType) and (dvoIsObject in VOptions) then begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx];
  end;
end;

function TDocVariantData.GetAsBoolean(const aName: RawUTF8; out aValue: boolean;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToBoolean(PVariant(found)^,aValue)
end;

function TDocVariantData.GetAsInteger(const aName: RawUTF8; out aValue: integer;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToInteger(PVariant(found)^,aValue);
end;

function TDocVariantData.GetAsInt64(const aName: RawUTF8; out aValue: Int64;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToInt64(PVariant(found)^,aValue)
end;

function TDocVariantData.GetAsDouble(const aName: RawUTF8; out aValue: double;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else
    result := VariantToDouble(PVariant(found)^,aValue);
end;

function TDocVariantData.GetAsRawUTF8(const aName: RawUTF8; out aValue: RawUTF8;
  aSortedCompare: TUTF8Compare): Boolean;
var found: PVarData;
    wasString: boolean;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else begin
    if found^.VType>varNull then // default VariantToUTF8(null)='null'
      VariantToUTF8(PVariant(found)^,aValue,wasString);
    result := true;
  end;
end;

function TDocVariantData.GetValueEnumerate(const aName: RawUTF8;
  aTypeInfo: pointer; out aValue; aDeleteFoundEntry: boolean): boolean;
var text: RawUTF8;
    ndx, ord: integer;
begin
  result := false;
  ndx := GetValueIndex(aName);
  if ndx<0 then
    exit;
  VariantToUTF8(Values[ndx],text);
  ord := GetEnumNameValue(aTypeInfo,text,true);
  if ord<0 then
    exit;
  byte(aValue) := ord;
  if aDeleteFoundEntry then
    Delete(ndx);
  result := true;
end;

function TDocVariantData.GetAsDocVariant(const aName: RawUTF8; out aValue: PDocVariantData;
  aSortedCompare: TUTF8Compare=nil): boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else begin
    aValue := _Safe(PVariant(found)^);
    result := aValue<>@DocVariantDataFake;
  end;
end;

function TDocVariantData.GetAsDocVariantSafe(const aName: RawUTF8;
  aSortedCompare: TUTF8Compare): PDocVariantData;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := @DocVariantDataFake else
    result := _Safe(PVariant(found)^);
end;

function TDocVariantData.GetAsPVariant(const aName: RawUTF8; out aValue: PVariant;
  aSortedCompare: TUTF8Compare=nil): boolean;
begin
  aValue := pointer(GetVarData(aName,aSortedCompare));
  result := aValue<>nil;
end;

function TDocVariantData.GetVarData(const aName: RawUTF8;
  var aValue: TVarData; aSortedCompare: TUTF8Compare): boolean;
var found: PVarData;
begin
  found := GetVarData(aName,aSortedCompare);
  if found=nil then
    result := false else begin
    aValue := found^;
    result := true;
  end;
end;

function TDocVariantData.GetVarData(const aName: RawUTF8;
  aSortedCompare: TUTF8Compare): PVarData;
var ndx: Integer;
begin
  if (VType<>DocVariantVType) or not(dvoIsObject in VOptions) or (VCount=0) then
    result := nil else begin
    if Assigned(aSortedCompare) then
      ndx := FastFindPUTF8CharSorted(pointer(VName),VCount-1,pointer(aName),aSortedCompare) else
      ndx := FindRawUTF8(VName,VCount,aName,not(dvoNameCaseSensitive in VOptions));
    if ndx>=0 then
      result := @VValue[ndx] else
      result := nil;
  end;
end;

function TDocVariantData.GetValueByPath(const aPath: RawUTF8): variant;
var Dest: TVarData;
begin
  VarClear(result);
  if (VType<>DocVariantVType) or not(dvoIsObject in VOptions) then
    exit;
  DocVariantType.Lookup(Dest,TVarData(self),pointer(aPath));
  if Dest.VType>=varNull then
    result := variant(Dest); // copy
end;

function TDocVariantData.GetValueByPath(const aPath: RawUTF8; out aValue: variant): boolean;
var Dest: TVarData;
begin
  result := false;
  if (VType<>DocVariantVType) or not(dvoIsObject in VOptions) then
    exit;
  DocVariantType.Lookup(Dest,TVarData(self),pointer(aPath));
  if Dest.VType=varEmpty then
    exit;
  aValue := variant(Dest); // copy
  result := true;
end;

function TDocVariantData.GetPVariantByPath(const aPath: RawUTF8): PVariant;
var p: PUTF8Char;
    item: RawUTF8;
    par: PVariant;
begin
  result := nil;
  if (VType<>DocVariantVType) or (aPath='') or
     not(dvoIsObject in VOptions) or (Count=0) then
    exit;
  par := @self;
  P := pointer(aPath);
  repeat
    GetNextItem(P,'.',item);
    if _Safe(par^).GetAsPVariant(item,result) then
      par := result else begin
      result := nil;
      exit;
    end;
  until P=nil;
  // if we reached here, we have par=result=found item
end;

function TDocVariantData.GetDocVariantByPath(const aPath: RawUTF8;
  out aValue: PDocVariantData): boolean;
var v: PVariant;
begin
  v := GetPVariantByPath(aPath);
  if v<>nil then begin
    aValue := _Safe(v^);
    result := aValue^.VType>varNull;
  end else
    result := false;
end;

function TDocVariantData.GetValueByPath(const aDocVariantPath: array of RawUTF8): variant;
var found,res: PVarData;
    P: integer;
begin
  VarClear(result);
  if (VType<>DocVariantVType) or not(dvoIsObject in VOptions) or
     (high(aDocVariantPath)<0) then
    exit;
  found := @self;
  P := 0;
  repeat
    found := PDocVariantData(found).GetVarData(aDocVariantPath[P]);
    if found=nil then
      exit;
    if P=high(aDocVariantPath) then
      break; // we found the item!
    inc(P);
    // if we reached here, we should try for the next scope within Dest
    while found^.VType=varByRef or varVariant do
      found := found^.VPointer;
    if found^.VType=VType then
      continue;
    exit;
  until false;
  res := found;
  while res^.VType=varByRef or varVariant do
    res := res^.VPointer;
  if (res^.VType=VType) and (PDocVariantData(res)^.VCount=0) then
    // return void TDocVariant as null
    TVarData(result).VType := varNull else
    // copy found value
    result := PVariant(found)^;
end;

function TDocVariantData.GetItemByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean; var Dest: variant; DestByRef: boolean): boolean;
var ndx: integer;
begin
  result := false;
  if not(dvoIsArray in VOptions) then
    exit;
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    exit;
  RetrieveValueOrRaiseException(ndx,Dest,DestByRef);
  result := true;
end;

function TDocVariantData.GetDocVariantByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean; out Dest: PDocVariantData): boolean;
var ndx: integer;
begin
  result := false;
  if not(dvoIsArray in VOptions) then
    exit;
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    exit;
  Dest := _Safe(VValue[ndx]);
  result := Dest^.VType>varNull;
end;

function TDocVariantData.GetJsonByStartName(const aStartName: RawUTF8): RawUTF8;
var Up: array[byte] of AnsiChar;
    temp: TTextWriterStackBuffer;
    ndx: integer;
    W: TTextWriter;
begin
  if not(dvoIsObject in VOptions) or (VCount=0) then begin
    result := NULL_STR_VAR;
    exit;
  end;
  UpperCopy255(Up,aStartName)^ := #0;
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    W.Add('{');
    for ndx := 0 to VCount-1 do
    if IdemPChar(Pointer(VName[ndx]),Up) then begin
      if (dvoSerializeAsExtendedJson in VOptions) and
         JsonPropNameValid(pointer(VName[ndx])) then begin
        W.AddNoJSONEscape(pointer(VName[ndx]),Length(VName[ndx]));
      end else begin
        W.Add('"');
        W.AddJSONEscape(pointer(VName[ndx]),Length(VName[ndx]));
        W.Add('"');
      end;
      W.Add(':');
      W.AddVariant(VValue[ndx],twJSONEscape);
      W.Add(',');
    end;
    W.CancelLastComma;
    W.Add('}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TDocVariantData.GetValuesByStartName(const aStartName: RawUTF8;
  TrimLeftStartName: boolean): variant;
var Up: array[byte] of AnsiChar;
    ndx: integer;
    name: RawUTF8;
begin
  if aStartName='' then begin
    result := Variant(self);
    exit;
  end;
  if not(dvoIsObject in VOptions) or (VCount=0) then begin
    SetVariantNull(result);
    exit;
  end;
  TDocVariant.NewFast(result);
  UpperCopy255(Up,aStartName)^ := #0;
  for ndx := 0 to VCount-1 do
    if IdemPChar(Pointer(VName[ndx]),Up) then begin
      name := VName[ndx];
      if TrimLeftStartName then
        system.delete(name, 1, length(aStartName));
      TDocVariantData(result).AddValue(name,VValue[ndx]);
    end;
end;

procedure TDocVariantData.SetValueOrRaiseException(Index: integer; const NewValue: variant);
begin
  if cardinal(Index)>=cardinal(VCount) then
    raise EDocVariant.CreateUTF8('Out of range Values[%] (count=%)',[Index,VCount]) else
    VValue[Index] := NewValue;
end;

procedure TDocVariantData.RetrieveNameOrRaiseException(Index: integer;
  var Dest: RawUTF8);
begin
  if (cardinal(Index)>=cardinal(VCount)) or (VName=nil) then
    if dvoReturnNullForUnknownProperty in VOptions then
      Dest := '' else
      raise EDocVariant.CreateUTF8('Out of range Names[%] (count=%)',[Index,VCount]) else
      Dest := VName[Index];
end;

procedure TDocVariantData.RetrieveValueOrRaiseException(Index: integer;
  var Dest: variant; DestByRef: boolean);
var Source: PVariant;
begin
  if cardinal(Index)>=cardinal(VCount) then
    if dvoReturnNullForUnknownProperty in VOptions then
      SetVariantNull(Dest) else
      raise EDocVariant.CreateUTF8('Out of range Values[%] (count=%)',[Index,VCount]) else
    if DestByRef then
      SetVariantByRef(VValue[Index],Dest) else begin
      Source := @VValue[Index];
      while PVarData(Source)^.VType=varVariant or varByRef do
        Source := PVarData(Source)^.VPointer;
      Dest := Source^;
    end;
end;

procedure TDocVariantData.RetrieveValueOrRaiseException(
  aName: PUTF8Char; aNameLen: integer; aCaseSensitive: boolean;
  var Dest: variant; DestByRef: boolean);
var ndx: Integer;
begin
  ndx := GetValueIndex(aName,aNameLen,aCaseSensitive);
  if ndx<0 then
    if dvoReturnNullForUnknownProperty in VOptions then
      SetVariantNull(Dest) else
      raise EDocVariant.CreateUTF8('Unexpected "%" property',[aName]) else
    RetrieveValueOrRaiseException(ndx,Dest,DestByRef);
end;

function TDocVariantData.GetValueOrItem(const aNameOrIndex: variant): variant;
var wasString: boolean;
    Name: RawUTF8;
begin
  if dvoIsArray in VOptions then // fast index lookup e.g. for Value[1]
    RetrieveValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),result,true) else begin
    VariantToUTF8(aNameOrIndex,Name,wasString); // by name lookup e.g. for Value['abc']
    if wasString then
      RetrieveValueOrRaiseException(pointer(Name),length(Name),
        dvoNameCaseSensitive in VOptions,result,true) else
      RetrieveValueOrRaiseException(GetIntegerDef(pointer(Name),-1),result,true);
  end;
end;

procedure TDocVariantData.SetValueOrItem(const aNameOrIndex, aValue: variant);
var wasString: boolean;
    ndx: integer;
    Name: RawUTF8;
begin
  if dvoIsArray in VOptions then // fast index lookup e.g. for Value[1]
    SetValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),aValue) else begin
    VariantToUTF8(aNameOrIndex,Name,wasString); // by name lookup e.g. for Value['abc']
    if wasString then begin
      ndx := GetValueIndex(Name);
      if ndx<0 then
        ndx := InternalAdd(Name);
      SetVariantByValue(aValue,VValue[ndx]);
      if dvoInternValues in VOptions then
        DocVariantType.InternValues.UniqueVariant(VValue[ndx]);
    end else
      SetValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),aValue);
  end;
end;

function TDocVariantData.AddOrUpdateValue(const aName: RawUTF8;
  const aValue: variant; wasAdded: PBoolean; OnlyAddMissing: boolean): integer;
begin
  if dvoIsArray in VOptions then
    raise EDocVariant.CreateUTF8('AddOrUpdateValue("%") on an array',[aName]);
  result := GetValueIndex(aName);
  if result<0 then begin
    result := InternalAdd(aName);
    if wasAdded<>nil then
      wasAdded^ := true;
  end else begin
    if wasAdded<>nil then
      wasAdded^ := false;
    if OnlyAddMissing then
      exit;
  end;
  SetVariantByValue(aValue,VValue[result]);
  if dvoInternValues in VOptions then
    DocVariantType.InternValues.UniqueVariant(VValue[result]);
end;

function TDocVariantData.ToJSON(const Prefix, Suffix: RawUTF8;
  Format: TTextWriterJSONFormat): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  if (VType<>DocVariantVType) and (VType>varNull) then begin
    result := ''; // null -> 'null'
    exit;
  end;
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    W.AddString(Prefix);
    DocVariantType.ToJSON(W,variant(self),twJSONEscape);
    W.AddString(Suffix);
    W.SetText(result, Format);
  finally
    W.Free;
  end;
end;

function TDocVariantData.ToNonExpandedJSON: RawUTF8;
var fields: TRawUTF8DynArray;
    fieldsCount: integer;
    W: TTextWriter;
    r,f: integer;
    row: PDocVariantData;
    temp: TTextWriterStackBuffer;
begin
  fields := nil; // to please Kylix
  fieldsCount := 0;
  if not(dvoIsArray in VOptions) then begin
    result := '';
    exit;
  end;
  if VCount=0 then begin
    result := '[]';
    exit;
  end;
  with _Safe(VValue[0])^ do
    if dvoIsObject in VOptions then begin
      fields := VName;
      fieldsCount := VCount;
    end;
  if fieldsCount=0 then
    raise EDocVariant.Create('ToNonExpandedJSON: Value[0] is not an object');
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    W.Add('{"fieldCount":%,"rowCount":%,"values":[',[fieldsCount,VCount]);
    for f := 0 to fieldsCount-1 do begin
      W.Add('"');
      W.AddJSONEscape(pointer(fields[f]));
      W.Add('"',',');
    end;
    for r := 0 to VCount-1 do begin
      row := _Safe(VValue[r]);
      if (r>0) and (not(dvoIsObject in row^.VOptions) or (row^.VCount<>fieldsCount)) then
        raise EDocVariant.CreateUTF8('ToNonExpandedJSON: Value[%] not expected object',[r]);
      for f := 0 to fieldsCount-1 do
        if (r>0) and not IdemPropNameU(row^.VName[f],fields[f]) then
          raise EDocVariant.CreateUTF8('ToNonExpandedJSON: Value[%] field=% expected=%',
            [r,row^.VName[f],fields[f]]) else begin
          W.AddVariant(row^.VValue[f],twJSONEscape);
          W.Add(',');
        end;
    end;
    W.CancelLastComma;
    W.Add(']','}');
    W.SetText(result);
  finally
    W.Free;
  end;
end;

procedure TDocVariantData.ToRawUTF8DynArray(out Result: TRawUTF8DynArray);
var ndx: integer;
    wasString: boolean;
begin
  if dvoIsObject in VOptions then
    raise EDocVariant.Create('ToRawUTF8DynArray expects a dvArray');
  if dvoIsArray in VOptions then begin
    SetLength(Result,VCount);
    for ndx := 0 to VCount-1 do
      VariantToUTF8(VValue[ndx],Result[ndx],wasString);
  end;
end;

function TDocVariantData.ToRawUTF8DynArray: TRawUTF8DynArray;
begin
  ToRawUTF8DynArray(result);
end;

function TDocVariantData.ToCSV(const Separator: RawUTF8): RawUTF8;
var tmp: TRawUTF8DynArray; // fast enough in practice
begin
  ToRawUTF8DynArray(tmp);
  result := RawUTF8ArrayToCSV(tmp,Separator);
end;

procedure TDocVariantData.ToTextPairsVar(out result: RawUTF8;
  const NameValueSep, ItemSep: RawUTF8; escape: TTextWriterKind);
var ndx: integer;
    temp: TTextWriterStackBuffer;
begin
  if dvoIsArray in VOptions then
    raise EDocVariant.Create('ToTextPairs expects a dvObject');
  if (VCount>0) and (dvoIsObject in VOptions) then
    with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
    try
      ndx := 0;
      repeat
        AddString(VName[ndx]);
        AddString(NameValueSep);
        AddVariant(VValue[ndx],escape);
        inc(ndx);
        if ndx=VCount then
          break;
        AddString(ItemSep);
      until false;
      SetText(result);
    finally
      Free;
    end;
end;

function TDocVariantData.ToTextPairs(const NameValueSep: RawUTF8;
  const ItemSep: RawUTF8; Escape: TTextWriterKind): RawUTF8;
begin
  ToTextPairsVar(result,NameValueSep,ItemSep,escape);
end;

procedure TDocVariantData.ToArrayOfConst(out Result: TTVarRecDynArray);
var ndx: integer;
begin
  if dvoIsObject in VOptions then
    raise EDocVariant.Create('ToArrayOfConst expects a dvArray');
  if dvoIsArray in VOptions then begin
    SetLength(Result,VCount);
    for ndx := 0 to VCount-1 do begin
      Result[ndx].VType := vtVariant;
      Result[ndx].VVariant := @VValue[ndx];
    end;
  end;
end;

function TDocVariantData.ToArrayOfConst: TTVarRecDynArray;
begin
  ToArrayOfConst(result);
end;

function TDocVariantData.ToUrlEncode(const UriRoot: RawUTF8): RawUTF8;
var json: RawUTF8;
begin
  VariantSaveJSON(variant(self),twJSONEscape,json);
  result := UrlEncodeJsonObject(UriRoot,Pointer(json),[]);
end;

function TDocVariantData.GetOrAddIndexByName(const aName: RawUTF8): integer;
begin
  result := GetValueIndex(aName);
  if result<0 then
    result := InternalAdd(aName);
end;

function TDocVariantData.GetOrAddPVariantByName(const aName: RawUTF8): PVariant;
var ndx: integer;
begin
  ndx := GetValueIndex(aName);
  if ndx<0 then
    ndx := InternalAdd(aName);
  result := @VValue[ndx];
end;

function TDocVariantData.GetPVariantByName(const aName: RawUTF8): PVariant;
var ndx: Integer;
begin
  ndx := GetValueIndex(aName);
  if ndx<0 then
    if dvoReturnNullForUnknownProperty in VOptions then
      result := @DocVariantDataFake else
      raise EDocVariant.CreateUTF8('Unexpected "%" property',[aName]) else
    result := @VValue[ndx];
end;

function TDocVariantData.GetInt64ByName(const aName: RawUTF8): Int64;
begin
  if not VariantToInt64(GetPVariantByName(aName)^,result) then
    result := 0;
end;

function TDocVariantData.GetRawUTF8ByName(const aName: RawUTF8): RawUTF8;
var wasString: boolean;
    v: PVariant;
begin
  v := GetPVariantByName(aName);
  if PVarData(v)^.VType<=varNull then // default VariantToUTF8(null)='null'
    result := '' else
    VariantToUTF8(v^,result,wasString);
end;

function TDocVariantData.GetStringByName(const aName: RawUTF8): string;
begin
  result := VariantToString(GetPVariantByName(aName)^);
end;

procedure TDocVariantData.SetInt64ByName(const aName: RawUTF8;
  const aValue: Int64);
begin
  GetOrAddPVariantByName(aName)^ := aValue;
end;

procedure TDocVariantData.SetRawUTF8ByName(const aName, aValue: RawUTF8);
begin
  RawUTF8ToVariant(aValue,GetOrAddPVariantByName(aName)^);
end;

procedure TDocVariantData.SetStringByName(const aName: RawUTF8; const aValue: string);
begin
  RawUTF8ToVariant(StringToUTF8(aValue),GetOrAddPVariantByName(aName)^);
end;

function TDocVariantData.GetBooleanByName(const aName: RawUTF8): Boolean;
begin
  if not VariantToBoolean(GetPVariantByName(aName)^,result) then
    result := false;
end;

procedure TDocVariantData.SetBooleanByName(const aName: RawUTF8; aValue: Boolean);
begin
  GetOrAddPVariantByName(aName)^ := aValue;
end;

function TDocVariantData.GetDoubleByName(const aName: RawUTF8): Double;
begin
  if not VariantToDouble(GetPVariantByName(aName)^,result) then
    result := 0;
end;

procedure TDocVariantData.SetDoubleByName(const aName: RawUTF8;
  const aValue: Double);
begin
  GetOrAddPVariantByName(aName)^ := aValue;
end;

function TDocVariantData.GetDocVariantExistingByName(const aName: RawUTF8;
  aNotMatchingKind: TDocVariantKind): PDocVariantData;
begin
  result := GetAsDocVariantSafe(aName);
  if result^.Kind=aNotMatchingKind then
    result := @DocVariantDataFake;
end;

function TDocVariantData.GetDocVariantOrAddByName(const aName: RawUTF8;
  aKind: TDocVariantKind): PDocVariantData;
var ndx: integer;
begin
  ndx := GetOrAddIndexByName(aName);
  result := _Safe(VValue[ndx]);
  if result^.Kind<>aKind then begin
    result := @VValue[ndx];
    VarClear(PVariant(result)^);
    result^.Init(JSON_OPTIONS_FAST,aKind);
  end;
end;

function TDocVariantData.GetObjectExistingByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantExistingByName(aName,dvArray);
end;

function TDocVariantData.GetObjectOrAddByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantOrAddByName(aName,dvObject);
end;

function TDocVariantData.GetArrayExistingByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantExistingByName(aName,dvObject);
end;

function TDocVariantData.GetArrayOrAddByName(const aName: RawUTF8): PDocVariantData;
begin
  result := GetDocVariantOrAddByName(aName,dvArray);
end;

function TDocVariantData.GetAsDocVariantByIndex(aIndex: integer): PDocVariantData;
begin
  if cardinal(aIndex)<cardinal(VCount) then
    result := _Safe(VValue[aIndex]) else
    if dvoReturnNullForUnknownProperty in VOptions then
      result := @DocVariantDataFake else
      raise EDocVariant.CreateUTF8('Out of range _[%] (count=%)',[aIndex,VCount]);
end;


{ TDocVariant }

function TDocVariant.InternNames: TRawUTF8Interning;
begin
  if fInternNames=nil then
    fInternNames := TRawUTF8Interning.Create;
  result := fInternNames;
end;

function TDocVariant.InternValues: TRawUTF8Interning;
begin
  if fInternValues=nil then
    fInternValues := TRawUTF8Interning.Create;
  result := fInternValues;
end;

destructor TDocVariant.Destroy;
begin
  inherited Destroy;
  fInternNames.Free;
  fInternValues.Free;
end;

procedure TDocVariant.IntGet(var Dest: TVarData;
  const V: TVarData; Name: PAnsiChar);
  procedure Execute(ndx: integer;
    const source: TDocVariantData; var Dest: variant);
  begin
    case ndx of
    0: Dest := source.Count;
    1: Dest := ord(source.Kind);
    2: RawUTF8ToVariant(source.ToJSON,Dest);
    end;
  end;
var NameLen, ndx: integer;
begin
  //Assert(V.VType=DocVariantVType);
  NameLen := StrLen(PUTF8Char(Name));
  // 1. search for any  _*  pseudo properties
  if (NameLen>4) and (Name[0]='_') then begin
    ndx := IdemPCharArray(@Name[1],['COUNT','KIND','JSON']);
    if ndx>=0 then begin
      Execute(ndx,TDocVariantData(V),variant(Dest));
      exit;
    end;
  end;
  // 2. case-insensitive search for aVariant.Name
  TDocVariantData(V).RetrieveValueOrRaiseException(
    PUTF8Char(Name),NameLen,false,variant(Dest),true);
end;

procedure TDocVariant.IntSet(const V, Value: TVarData; Name: PAnsiChar);
var ndx: Integer;
    aName: RawUTF8;
    Data: TDocVariantData absolute V;
begin
  if (dvoIsArray in Data.VOptions) and (PWord(Name)^=ord('_')) then begin
    ndx := Data.InternalAdd(''); // FPC does not allow VValue[InternalAdd(aName)]
    SetVariantByValue(variant(Value),Data.VValue[ndx]);
    if dvoInternValues in Data.VOptions then
      DocVariantType.InternValues.UniqueVariant(Data.VValue[ndx]);
    exit;
  end;
  FastSetString(aName,Name,StrLen(PUTF8Char(Name)));
  ndx := Data.GetValueIndex(aName);
  if ndx<0 then
    ndx := Data.InternalAdd(aName);
  SetVariantByValue(variant(Value),Data.VValue[ndx]);
  if dvoInternValues in Data.VOptions then
    DocVariantType.InternValues.UniqueVariant(Data.VValue[ndx]);
end;

function TDocVariant.IterateCount(const V: TVarData): integer;
var Data: TDocVariantData absolute V;
begin
  if dvoIsArray in Data.VOptions then
    result := Data.VCount else
    result := -1;
end;

procedure TDocVariant.Iterate(var Dest: TVarData; const V: TVarData; Index: integer);
var Data: TDocVariantData absolute V;
begin
  if (dvoIsArray in Data.VOptions) and (cardinal(Index)<cardinal(Data.VCount)) then
    Dest := TVarData(Data.VValue[Index]) else
    Dest.VType := varEmpty;
end;

function TDocVariant.DoFunction(var Dest: TVarData; const V: TVarData;
  const Name: string; const Arguments: TVarDataArray): boolean;
var ndx: integer;
    Data: PDocVariantData;
    temp: RawUTF8;
  procedure SetTempFromFirstArgument;
  var wasString: boolean;
  begin
    VariantToUTF8(variant(Arguments[0]),temp,wasString);
  end;
begin
  result := true;
  Data := @V; // Data=V is const so should not be modified - but we need it
  case length(Arguments) of
  0:if SameText(Name,'Clear') then begin
      Data^.VCount := 0;
      Data^.VOptions := Data^.VOptions-[dvoIsObject,dvoIsArray];
      exit;
    end;
  1:if SameText(Name,'Add') then begin
      ndx := Data^.InternalAdd(''); // FPC does not allow VValue[InternalAdd(aName)]
      SetVariantByValue(variant(Arguments[0]),Data^.VValue[ndx]);
      if dvoInternValues in Data^.VOptions then
        DocVariantType.InternValues.UniqueVariant(Data^.VValue[ndx]);
      exit;
    end else
    if SameText(Name,'Delete') then begin
      SetTempFromFirstArgument;
      Data^.Delete(Data^.GetValueIndex(temp));
      exit;
    end else
    if SameText(Name,'Exists') then begin
      SetTempFromFirstArgument;
      variant(Dest) := Data^.GetValueIndex(temp)>=0;
      exit;
    end else
    if SameText(Name,'NameIndex') then begin
      SetTempFromFirstArgument;
      variant(Dest) := Data^.GetValueIndex(temp);
      exit;
    end else
    if VariantToInteger(variant(Arguments[0]),ndx) then begin
      if (Name='_') or SameText(Name,'Value') then begin
        Data^.RetrieveValueOrRaiseException(ndx,variant(Dest),true);
        exit;
      end else
      if SameText(Name,'Name') then begin
        Data^.RetrieveNameOrRaiseException(ndx,temp);
        RawUTF8ToVariant(temp,variant(Dest));
        exit;
      end;
    end else
    if (Name='_') or SameText(Name,'Value') then begin
      SetTempFromFirstArgument;
      Data^.RetrieveValueOrRaiseException(pointer(temp),length(temp),
        dvoNameCaseSensitive in Data^.VOptions,variant(Dest),true);
      exit;
    end;
  2:if SameText(Name,'Add') then begin
      SetTempFromFirstArgument;
      ndx := Data^.InternalAdd(temp); // FPC does not allow VValue[InternalAdd(aName)]
      SetVariantByValue(variant(Arguments[1]),Data^.VValue[ndx]);
      if dvoInternValues in Data^.VOptions then
        DocVariantType.InternValues.UniqueVariant(Data^.VValue[ndx]);
      exit;
    end;
  end;
  result := false;
end;

procedure TDocVariant.ToJSON(W: TTextWriter; const Value: variant;
  escape: TTextWriterKind);
var ndx: integer;
    backup: TTextWriterOptions;
    checkExtendedPropName: boolean;
begin
  with TDocVariantData(Value) do
  if integer(VType)>varNull then
  if integer(VType)=DocVariantVType then
  if [dvoIsArray,dvoIsObject]*VOptions=[] then
    W.AddShort('null') else begin
    backup := W.fCustomOptions;
    if [twoForceJSONExtended,twoForceJSONStandard]*backup=[] then
      if dvoSerializeAsExtendedJson in VOptions then
        include(W.fCustomOptions,twoForceJSONExtended) else
        include(W.fCustomOptions,twoForceJSONStandard);
    if dvoIsObject in VOptions then begin
      checkExtendedPropName := twoForceJSONExtended in W.CustomOptions;
      W.Add('{');
      for ndx := 0 to VCount-1 do begin
        if checkExtendedPropName and JsonPropNameValid(pointer(VName[ndx])) then begin
          W.AddNoJSONEscape(pointer(VName[ndx]),Length(VName[ndx]));
        end else begin
          W.Add('"');
          W.AddJSONEscape(pointer(VName[ndx]),Length(VName[ndx]));
          W.Add('"');
        end;
        W.Add(':');
        W.AddVariant(VValue[ndx],twJSONEscape);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add('}');
    end else begin
      W.Add('[');
      for ndx := 0 to VCount-1 do begin
        W.AddVariant(VValue[ndx],twJSONEscape);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add(']');
    end;
    W.fCustomOptions := backup;
  end else
    raise ESynException.CreateUTF8('Unexpected variant type %',[VType]) else
    W.AddShort('null');
end;

procedure TDocVariant.Clear(var V: TVarData);
begin
  //Assert(V.VType=DocVariantVType);
  VariantDynArrayClear(TDocVariantData(V).VValue);
  TDocVariantData(V).VName := nil;
  ZeroFill(@V); // will set V.VType := varEmpty and VCount=0
end;

procedure TDocVariant.Copy(var Dest: TVarData; const Source: TVarData;
  const Indirect: Boolean);
begin
  //Assert(Source.VType=DocVariantVType);
  if Indirect then
    SimplisticCopy(Dest,Source,true) else
    if dvoValueCopiedByReference in TDocVariantData(Source).Options then begin
      {$ifndef FPC}if Dest.VType and VTYPE_STATIC<>0 then{$endif}
        VarClear(variant(Dest)); // Dest may be a complex type
      pointer(TDocVariantData(Dest).VName) := nil;      // avoid GPF
      pointer(TDocVariantData(Dest).VValue) := nil;
      TDocVariantData(Dest) := TDocVariantData(Source); // copy whole record
    end else
      CopyByValue(Dest,Source);
end;

procedure TDocVariant.CopyByValue(var Dest: TVarData; const Source: TVarData);
var S: TDocVariantData absolute Source;
    D: TDocVariantData absolute Dest;
    i: integer;
begin
  //Assert(Source.VType=DocVariantVType);
  {$ifndef FPC}if Dest.VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(variant(Dest)); // Dest may be a complex type
  D.VType := S.VType;
  D.VOptions := S.VOptions; // copies also Kind
  D.VCount := S.VCount;
  pointer(D.VName) := nil; // avoid GPF
  pointer(D.VValue) := nil;
  if S.VCount=0 then
    exit; // no data to copy
  D.VName := S.VName; // names can always be safely copied
  // slower but safe by-value copy
  SetLength(D.VValue,S.VCount);
  for i := 0 to S.VCount-1 do
    D.VValue[i] := S.VValue[i];
end;

procedure TDocVariant.Cast(var Dest: TVarData; const Source: TVarData);
begin
  CastTo(Dest,Source,VarType);
end;

procedure TDocVariant.CastTo(var Dest: TVarData;
  const Source: TVarData; const AVarType: TVarType);
var Tmp: RawUTF8;
    wasString: boolean;
begin
  if AVarType=VarType then begin
    VariantToUTF8(Variant(Source),Tmp,wasString);
    if wasString then begin
      {$ifndef FPC}if Dest.VType and VTYPE_STATIC<>0 then{$endif}
        VarClear(variant(Dest));
      variant(Dest) := _JSONFast(Tmp); // convert from JSON text
      exit;
    end;
    RaiseCastError;
  end else begin
    if Source.VType<>VarType then
      RaiseCastError;
    VariantSaveJSON(variant(Source),twJSONEscape,tmp);
    RawUTF8ToVariant(Tmp,Dest,AVarType); // convert to JSON text
  end;
end;

procedure TDocVariant.Compare(const Left, Right: TVarData;
  var Relationship: TVarCompareResult);
var res: integer;
    LeftU,RightU: RawUTF8;
begin
  VariantSaveJSON(variant(Left),twJSONEscape,LeftU);
  VariantSaveJSON(variant(Right),twJSONEscape,RightU);
  if LeftU=RightU then
    Relationship := crEqual else begin
    res := StrComp(pointer(LeftU),pointer(RightU));
    if res<0 then
      Relationship := crLessThan else
    if res>0 then
      Relationship := crGreaterThan else
      Relationship := crEqual;
  end;
end;

class procedure TDocVariant.New(out aValue: variant;
  aOptions: TDocVariantOptions);
begin
  TDocVariantData(aValue).Init(aOptions);
end;

class procedure TDocVariant.NewFast(out aValue: variant);
begin
  TDocVariantData(aValue).InitFast;
end;

class procedure TDocVariant.IsOfTypeOrNewFast(var aValue: variant);
begin
  if DocVariantType.IsOfType(aValue) then
    exit;
  VarClear(aValue);
  TDocVariantData(aValue).InitFast;
end;

class procedure TDocVariant.NewFast(const aValues: array of PDocVariantData);
var i: integer;
begin
  for i := 0 to high(aValues) do
    aValues[i]^.InitFast;
end;

class function TDocVariant.New(Options: TDocVariantOptions): Variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).Init(Options);
end;

class function TDocVariant.NewObject(const NameValuePairs: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,Options);
end;

class function TDocVariant.NewArray(const Items: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitArray(Items,Options);
end;

class function TDocVariant.NewArray(const Items: TVariantDynArray;
  Options: TDocVariantOptions=[]): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitArrayFromVariants(Items,Options);
end;

class function TDocVariant.NewJSON(const JSON: RawUTF8;
  Options: TDocVariantOptions): variant;
begin
  _Json(JSON,result,Options);
end;

class function TDocVariant.NewUnique(const SourceDocVariant: variant;
  Options: TDocVariantOptions=[dvoReturnNullForUnknownProperty]): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitCopy(SourceDocVariant,Options);
end;

class procedure TDocVariant.GetSingleOrDefault(const docVariantArray, default: variant;
  var result: variant);
begin
  if TVarData(DocVariantArray).VType=varByRef or varVariant then
    GetSingleOrDefault(PVariant(TVarData(DocVariantArray).VPointer)^,default,result) else
  if (TVarData(DocVariantArray).VType<>DocVariantVType) or
     (TDocVariantData(DocVariantArray).Count<>1) or
     not(dvoIsArray in TDocVariantData(DocVariantArray).VOptions) then
    result := default else
    result := TDocVariantData(DocVariantArray).Values[0];
end;

function ToText(kind: TDocVariantKind): PShortString;
begin
  result := GetEnumName(TypeInfo(TDocVariantKind),ord(kind));
end;

function _Obj(const NameValuePairs: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,Options);
end;

function _Arr(const Items: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitArray(Items,Options);
end;

procedure _ObjAddProps(const NameValuePairs: array of const; var Obj: variant);
var o: PDocVariantData;
begin
  o := _Safe(Obj);
  if not(dvoIsObject in o^.VOptions) then begin // create new object
    {$ifndef FPC}if TVarData(Obj).VType and VTYPE_STATIC<>0 then{$endif}
      VarClear(Obj);
    TDocVariantData(Obj).InitObject(NameValuePairs,JSON_OPTIONS_FAST);
  end else begin // append new names/values to existing object
    TVarData(Obj) := PVarData(o)^; // ensure not stored by reference
    o^.AddNameValuesToObject(NameValuePairs);
  end;
end;

procedure _ObjAddProps(const Document: variant; var Obj: variant);
var ndx: integer;
    d,o: PDocVariantData;
begin
  d := _Safe(Document);
  o := _Safe(Obj);
  if dvoIsObject in d.VOptions then
    if not(dvoIsObject in o.VOptions) then
      Obj := Document else
      for ndx := 0 to d^.VCount-1 do
        o^.AddOrUpdateValue(d^.VName[ndx],d^.VValue[ndx]);
end;

function _ObjFast(const NameValuePairs: array of const): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,JSON_OPTIONS_FAST);
end;

function _ObjFast(aObject: TObject; aOptions: TTextWriterWriteObjectOptions): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  if TDocVariantData(result).InitJSONInPlace(
      pointer(ObjectToJson(aObject,aOptions)),JSON_OPTIONS_FAST)=nil then
    VarClear(result);
end;

function _ArrFast(const Items: array of const): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result).InitArray(Items,JSON_OPTIONS_FAST);
end;

function _Json(const JSON: RawUTF8; Options: TDocVariantOptions): variant;
begin
  _Json(JSON,result,Options);
end;

function _JsonFast(const JSON: RawUTF8): variant;
begin
  _Json(JSON,result,JSON_OPTIONS_FAST);
end;

function _JsonFastExt(const JSON: RawUTF8): variant;
begin
  _Json(JSON,result,JSON_OPTIONS_FAST_EXTENDED);
end;

function _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions): variant;
begin
  _JsonFmt(Format,Args,Params,Options,result);
end;

procedure _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions; out result: variant);
var temp: RawUTF8;
begin
  temp := FormatUTF8(Format,Args,Params,true);
  if TDocVariantData(result).InitJSONInPlace(pointer(temp),Options)=nil then
    TDocVariantData(result).Clear;
end;

function _JsonFastFmt(const Format: RawUTF8; const Args,Params: array of const): variant;
begin
  _JsonFmt(Format,Args,Params,JSON_OPTIONS_FAST,result);
end;

function _Json(const JSON: RawUTF8; var Value: variant;
  Options: TDocVariantOptions): boolean;
begin
  {$ifndef FPC}if TVarData(Value).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(Value);
  if not TDocVariantData(Value).InitJSON(JSON,Options) then begin
    VarClear(Value);
    result := false;
  end else
    result := true;
end;

procedure _Unique(var DocVariant: variant);
begin // TDocVariantData(DocVariant): InitCopy() will check the DocVariant type
  TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[false]);
end;

procedure _UniqueFast(var DocVariant: variant);
begin // TDocVariantData(DocVariant): InitCopy() will check the DocVariant type
  TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS_FAST);
end;

function _Copy(const DocVariant: variant): variant;
begin
  result := TDocVariant.NewUnique(DocVariant,JSON_OPTIONS[false]);
end;

function _CopyFast(const DocVariant: variant): variant;
begin
  result := TDocVariant.NewUnique(DocVariant,JSON_OPTIONS_FAST);
end;

function _ByRef(const DocVariant: variant; Options: TDocVariantOptions): variant;
begin
  {$ifndef FPC}if TVarData(result).VType and VTYPE_STATIC<>0 then{$endif}
    VarClear(result);
  TDocVariantData(result) := _Safe(DocVariant)^; // fast byref copy
  TDocVariantData(result).SetOptions(Options);
end;

procedure _ByRef(const DocVariant: variant; out Dest: variant;
  Options: TDocVariantOptions);
begin
  TDocVariantData(Dest) := _Safe(DocVariant)^; // fast byref copy
  TDocVariantData(Dest).SetOptions(Options);
end;

function ObjectToVariant(Value: TObject; EnumSetsAsText: boolean): variant;
const OPTIONS: array[boolean] of TTextWriterWriteObjectOptions = (
     [woDontStoreDefault],[woDontStoreDefault,woEnumSetsAsText]);
begin
  VarClear(result);
  ObjectToVariant(Value,result,OPTIONS[EnumSetsAsText]);
end;

procedure ObjectToVariant(Value: TObject; out Dest: variant);
begin
  ObjectToVariant(Value,Dest,[woDontStoreDefault]);
end;

procedure ObjectToVariant(Value: TObject; var result: variant;
  Options: TTextWriterWriteObjectOptions);
var json: RawUTF8;
begin
  json := ObjectToJSON(Value,Options);
  PDocVariantData(@result)^.InitJSONInPlace(pointer(json),JSON_OPTIONS_FAST);
end;

{$endif NOVARIANTS}


{ ****************** TDynArray wrapper }

{$ifndef DELPHI5OROLDER} // do not know why Delphi 5 compiler does not like CopyFrom()
procedure DynArrayCopy(var Dest; const Source; SourceMaxElem: integer;
  TypeInfo: pointer);
var DestDynArray: TDynArray;
begin
  DestDynArray.Init(TypeInfo,Dest);
  DestDynArray.CopyFrom(Source,SourceMaxElem);
end;
{$endif DELPHI5OROLDER}

function DynArrayLoad(var Value; Source: PAnsiChar; TypeInfo: pointer): PAnsiChar;
var DynArray: TDynArray;
begin
  DynArray.Init(TypeInfo,Value);
  result := DynArray.LoadFrom(Source);
end;

function DynArraySave(var Value; TypeInfo: pointer): RawByteString;
var DynArray: TDynArray;
begin
  DynArray.Init(TypeInfo,Value);
  result := DynArray.SaveTo;
end;

function DynArrayLoadJSON(var Value; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char;
var DynArray: TDynArray;
begin
  DynArray.Init(TypeInfo,Value);
  result := DynArray.LoadFromJSON(JSON,EndOfObject);
end;

function DynArraySaveJSON(const Value; TypeInfo: pointer;
  EnumSetsAsText: boolean): RawUTF8;
begin
  result := SaveJSON(Value,TypeInfo,EnumSetsAsText);
end;

{$ifndef DELPHI5OROLDER}
function DynArrayEquals(TypeInfo: pointer; var Array1, Array2;
  Array1Count, Array2Count: PInteger): boolean;
var DA1, DA2: TDynArray;
begin
  DA1.Init(TypeInfo,Array1,Array1Count);
  DA2.Init(TypeInfo,Array2,Array2Count);
  result := DA1.Equals(DA2);
end;
{$endif DELPHI5OROLDER}

function DynArrayBlobSaveJSON(TypeInfo, BlobValue: pointer): RawUTF8;
var DynArray: TDynArray;
    Value: pointer; // store the temporary dynamic array
    temp: TTextWriterStackBuffer;
begin
  Value := nil;
  DynArray.Init(TypeInfo,Value);
  try
    if DynArray.LoadFrom(BlobValue)=nil then
      result := '' else begin
      with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
      try
        AddDynArrayJSON(TypeInfo,Value);
        SetText(result);
      finally
        Free;
      end;
     end;
  finally
    DynArray.Clear;
  end;
end;

function DynArrayElementTypeName(TypeInfo: pointer; ElemTypeInfo: PPointer;
  ExactType: boolean): RawUTF8;
var DynArray: TDynArray;
    VoidArray: pointer;
const KNOWNTYPE_ITEMNAME: array[TDynArrayKind] of RawUTF8 = ('',
  'boolean','byte','word','integer','cardinal','single','Int64','QWord',
  'double','currency','TTimeLog','TDateTime','TDateTimeMS',
  'RawUTF8','WinAnsiString','string','RawByteString','WideString','SynUnicode',
  'THash128','THash256','THash512','IInterface',{$ifndef NOVARIANTS}'variant',{$endif}'');
begin
  VoidArray := nil;
  DynArray.Init(TypeInfo,VoidArray);
  result := '';
  if ElemTypeInfo<>nil then
    ElemTypeInfo^ := DynArray.ElemType;
  if DynArray.ElemType<>nil then
    TypeInfoToName(ElemTypeInfo,result) else
    result := KNOWNTYPE_ITEMNAME[DynArray.ToKnownType(ExactType)];
end;

function SortDynArrayBoolean(const A,B): integer;
begin
  if boolean(A)=boolean(B) then
    result := 0 else
  if boolean(A) then
    result := 1 else
    result := -1;
end;

function SortDynArrayByte(const A,B): integer;
begin
  result := byte(A)-byte(B);
end;

function SortDynArraySmallint(const A,B): integer;
begin
  result := smallint(A)-smallint(B);
end;

function SortDynArrayShortint(const A,B): integer;
begin
  result := shortint(A)-shortint(B);
end;

function SortDynArrayWord(const A,B): integer;
begin
  result := word(A)-word(B);
end;

function SortDynArrayCardinal(const A,B): integer;
begin
  if cardinal(A)<cardinal(B) then
    result := -1 else
  if cardinal(A)>cardinal(B) then
    result := 1 else
    result := 0;
end;

function SortDynArrayPointer(const A,B): integer;
begin
  {$ifdef CPU64}
  if PtrInt(A)<PtrInt(B) then
    result := -1 else
  if PtrInt(A)>PtrInt(B) then
    result := 1 else
    result := 0;
  {$else}
  result := PtrInt(A)-PtrInt(B);
  {$endif}
end;

function SortDynArraySingle(const A,B): integer;
begin
  if Single(A)<Single(B) then
    result := -1 else
  if Single(A)>Single(B) then
    result := 1 else
    result := 0;
end;

function SortDynArrayDouble(const A,B): integer;
begin
  if Double(A)<Double(B) then
    result := -1 else
  if Double(A)>Double(B) then
    result := 1 else
    result := 0;
end;

function SortDynArrayPUTF8CharI(const A,B): integer;
begin
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
end;

function SortDynArrayString(const A,B): integer;
begin
  {$ifdef UNICODE}
  result := StrCompW(PWideChar(A),PWideChar(B));
  {$else}
  result := StrComp(PUTF8Char(A),PUTF8Char(B));
  {$endif}
end;

function SortDynArrayStringI(const A,B): integer;
begin
  {$ifdef UNICODE}
  result := AnsiICompW(PWideChar(A),PWideChar(B));
  {$else}
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
  {$endif}
end;

function SortDynArrayFileName(const A,B): integer;
var Aname, Aext, Bname, Bext: TFileName;
begin // code below is not very fast, but is correct ;)
  AName := GetFileNameWithoutExt(string(A),@Aext);
  BName := GetFileNameWithoutExt(string(B),@Bext);
  result := AnsiCompareFileName(Aext,Bext);
  if result=0 then // if both extensions matches, compare by filename
    result := AnsiCompareFileName(Aname,Bname);
end;

function SortDynArrayUnicodeString(const A,B): integer;
begin
  result := StrCompW(PWideChar(A),PWideChar(B));
end;

function SortDynArrayUnicodeStringI(const A,B): integer;
begin
  result := AnsiICompW(PWideChar(A),PWideChar(B));
end;

function SortDynArray128(const A,B): integer;
begin
  if THash128Rec(A).Lo<THash128Rec(B).Lo then
    result := -1 else
  if THash128Rec(A).Lo>THash128Rec(B).Lo then
    result := 1 else
    if THash128Rec(A).Hi<THash128Rec(B).Hi then
      result := -1 else
    if THash128Rec(A).Hi>THash128Rec(B).Hi then
      result := 1 else
      result := 0;
end;

function SortDynArray256(const A,B): integer;
begin
  result := SortDynArray128(THash256Rec(A).Lo,THash256Rec(B).Lo);
  if result = 0 then
    result := SortDynArray128(THash256Rec(A).Hi,THash256Rec(B).Hi);
end;

function SortDynArray512(const A,B): integer;
begin
  result := SortDynArray128(THash512Rec(A).c0,THash512Rec(B).c0);
  if result = 0 then begin
    result := SortDynArray128(THash512Rec(A).c1,THash512Rec(B).c1);
    if result = 0 then begin
      result := SortDynArray128(THash512Rec(A).c2,THash512Rec(B).c2);
      if result = 0 then
        result := SortDynArray128(THash512Rec(A).c3,THash512Rec(B).c3);
    end;
  end;
end;

{$ifndef NOVARIANTS}

function VariantCompare(const V1,V2: variant): PtrInt;
begin
  result := SortDynArrayVariantComp(TVarData(V1), TVarData(V2), false);
end;

function VariantCompareI(const V1,V2: variant): PtrInt;
begin
  result := SortDynArrayVariantComp(TVarData(V1), TVarData(V2), true);
end;

function SortDynArrayVariantCompareAsString(const A,B: variant): integer;
var UA,UB: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(A,UA,wasString);
  VariantToUTF8(B,UB,wasString);
  result := StrComp(pointer(UA),pointer(UB));
end;

function SortDynArrayVariantCompareAsStringI(const A,B: variant): integer;
var UA,UB: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(A,UA,wasString);
  VariantToUTF8(B,UB,wasString);
  result := StrIComp(pointer(UA),pointer(UB));
end;

function SortDynArrayZero(const A,B): integer;
begin
  result := 0;
end;

function SortDynArrayVariantComp(const A,B: TVarData; caseInsensitive: boolean): integer;
type
  TSortDynArrayVariantComp = function(const A,B: variant): integer;
const
  CMP: array[boolean] of TSortDynArrayVariantComp = (
    SortDynArrayVariantCompareAsString,SortDynArrayVariantCompareAsStringI);
  ICMP: array[TVariantRelationship] of integer = (0,-1,1,1);
  SORT1: array[varEmpty..varDate] of TDynArraySortCompare = (
    SortDynArrayZero, SortDynArrayZero, SortDynArraySmallInt, SortDynArrayInteger,
    SortDynArraySingle, SortDynArrayDouble, SortDynArrayInt64, SortDynArrayDouble);
  SORT2: array[varShortInt..varWord64] of TDynArraySortCompare = (
    SortDynArrayShortInt, SortDynArrayByte, SortDynArrayWord, SortDynArrayCardinal,
    SortDynArrayInt64, SortDynArrayQWord);
begin
  if A.VType=varVariant or varByRef then
    result := SortDynArrayVariantComp(PVarData(A.VPointer)^,B,caseInsensitive) else
  if B.VType=varVariant or varByRef then
    result := SortDynArrayVariantComp(A,PVarData(B.VPointer)^,caseInsensitive) else
  if A.VType=B.VType then
    case A.VType of // optimized value comparison if A and B share the same type
    low(SORT1)..high(SORT1):
      result := SORT1[A.VType](A.VAny,B.VAny);
    low(SORT2)..high(SORT2):
      result := SORT2[A.VType](A.VAny,B.VAny);
    varString: // RawUTF8 most of the time (e.g. from TDocVariant)
      if caseInsensitive then
        result := StrIComp(A.VAny,B.VAny) else
        result := StrComp(A.VAny,B.VAny);
    varBoolean:
      if A.VBoolean then // normalize
        if B.VBoolean then
          result := 0 else
          result := 1 else
        if B.VBoolean then
          result := -1 else
          result := 0;
    varOleStr{$ifdef HASVARUSTRING},varUString{$endif}:
      if caseInsensitive then
        result := AnsiICompW(A.VAny,B.VAny) else
        result := StrCompW(A.VAny,B.VAny);
    else
      if A.VType and VTYPE_STATIC=0 then
        result := ICMP[VarCompareValue(variant(A),variant(B))] else
        result := CMP[caseInsensitive](variant(A),variant(B));
    end else
  if (A.VType<=varNull) or (B.VType<=varNull) then
    result := ord(A.VType>varNull)-ord(B.VType>varNull) else
  if (A.VType and VTYPE_STATIC=0) and
     (B.VType and VTYPE_STATIC=0) then
    result := ICMP[VarCompareValue(variant(A),variant(B))] else
    result := CMP[caseInsensitive](variant(A),variant(B));
end;

function SortDynArrayVariant(const A,B): integer;
begin
  result := SortDynArrayVariantComp(TVarData(A),TVarData(B),false);
end;

function SortDynArrayVariantI(const A,B): integer;
begin
  result := SortDynArrayVariantComp(TVarData(A),TVarData(B),true);
end;

{$endif NOVARIANTS}


{ TDynArray }

function TDynArray.GetCount: integer;
var v: PtrUInt;
begin
  v := PtrUInt(fCountP);
  if v<>0 then begin
    result := PInteger(v)^;
    exit;
  end else begin
    v := PtrUInt(fValue);
    if v<>0 then begin
      v := PPtrUInt(v)^;
      if v<>0 then begin
        {$ifdef FPC}
        result := PDynArrayRec(v-SizeOf(TDynArrayRec))^.high+1;
        {$else}
        result := PInteger(v-SizeOf(PtrInt))^;
        {$endif}
        exit;
      end;
    end;
    result := 0; // avoid GPF if void
    exit;
  end;
end;

procedure TDynArray.ElemCopy(const A; var B);
begin
  if ElemType=nil then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(A,B,ElemSize) else begin
    {$ifdef FPC}
    {$ifdef FPC_OLDRTTI}
    FPCFinalize(@B,ElemType); // inlined CopyArray()
    Move(A,B,ElemSize);
    FPCRecordAddRef(B,ElemType);
    {$else}
    FPCRecordCopy(A,B,ElemType); // works for any kind of ElemTyp
    {$endif FPC_OLDRTTI}
    {$else}
    CopyArray(@B,@A,ElemType,1);
    {$endif FPC}
  end;
end;

function TDynArray.Add(const Elem): PtrInt;
var p: PtrUInt;
begin
  result := GetCount;
  if fValue=nil then
    exit; // avoid GPF if void
  SetCount(result+1);
  p := PtrUInt(fValue^)+PtrUInt(result)*ElemSize;
  if ElemType=nil then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Elem,pointer(p)^,ElemSize) else
    {$ifdef FPC}
    FPCRecordCopy(Elem,pointer(p)^,ElemType);
    {$else}
    CopyArray(pointer(p),@Elem,ElemType,1);
    {$endif}
end;

function TDynArray.New: integer;
begin
  result := GetCount;
  if fValue=nil then
    exit; // avoid GPF if void
  SetCount(result+1);
end;

function TDynArray.Peek(var Dest): boolean;
var index: PtrInt;
begin
  index := GetCount-1;
  result := index>=0;
  if result then
    ElemCopy(pointer(PtrUInt(fValue^)+PtrUInt(index)*ElemSize)^,Dest);
end;

function TDynArray.Pop(var Dest): boolean;
var index: integer;
begin
  index := GetCount-1;
  result := index>=0;
  if result then begin
    ElemMoveTo(index,Dest);
    SetCount(index);
  end;
end;

procedure TDynArray.Insert(Index: PtrInt; const Elem);
var n: PtrInt;
    P: PByteArray;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := GetCount;
  SetCount(n+1);
  if PtrUInt(Index)<PtrUInt(n) then begin
    P := pointer(PtrUInt(fValue^)+PtrUInt(Index)*ElemSize);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(P[0],P[ElemSize],PtrUInt(n-Index)*ElemSize);
    if ElemType<>nil then // avoid GPF in ElemCopy() below
      {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(P^,ElemSize,0);
  end else
    // Index>=Count -> add at the end
    P := pointer(PtrUInt(fValue^)+PtrUInt(n)*ElemSize);
  ElemCopy(Elem,P^);
end;

procedure TDynArray.Clear;
begin
  SetCount(0);
end;

function TDynArray.ClearSafe: boolean;
begin
  try
    SetCount(0);
    result := true;
  except // weak code, but may be a good idea in a destructor
    result := false;
  end;
end;

function TDynArray.GetIsObjArray: boolean;
var o: TDynArrayObjArray; // oaUnknown, oaFalse, oaTrue
begin
  o := fIsObjArray; // oaUnknown, oaFalse, oaTrue
  if o=oaUnknown then
    result := ComputeIsObjArray else
    result := o<>oaFalse;
end;

procedure TDynArray.Delete(aIndex: PtrInt);
var n, len: PtrInt;
    P: PAnsiChar;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := GetCount;
  if PtrUInt(aIndex)>=PtrUInt(n) then
    exit; // out of range
  dec(n);
  P := pointer(PtrUInt(fValue^)+PtrUInt(aIndex)*ElemSize);
  if ElemType<>nil then
    {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(P,ElemType) else
    if (fIsObjArray=oaTrue) or ((fIsObjArray=oaUnknown) and ComputeIsObjArray) then
      FreeAndNil(PObject(P)^);
  if n>aIndex then begin
    len := PtrUInt(n-aIndex)*ElemSize;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(P[ElemSize],P[0],len);
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(P[len],ElemSize,0);
  end else
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(P^,ElemSize,0);
  SetCount(n);
end;

function TDynArray.ElemPtr(index: PtrInt): pointer;
label ok;
var c: PtrUInt;
begin // very efficient code on FPC and modern Delphi
  result := pointer(fValue);
  if result=nil then
    exit;
  result := PPointer(result)^;
  if result=nil then
    exit;
  c := PtrUInt(fCountP);
  if c<>0 then begin
    if PtrUInt(index)<PCardinal(c)^ then
ok:   inc(PByte(result),PtrUInt(index)*ElemSize) else
      result := nil
  end else
    {$ifdef FPC}
    if PtrUInt(index)<=PtrUInt(PDynArrayRec(PtrUInt(result)-SizeOf(TDynArrayRec))^.high) then
    {$else}
    if cardinal(index)<PCardinal(PtrUInt(result)-SizeOf(PtrInt))^ then
    {$endif}
      goto ok else
      result := nil;
end;

procedure TDynArray.ElemCopyAt(index: PtrInt; var Dest);
var p: pointer;
begin
  p := ElemPtr(index);
  if p<>nil then
    if ElemType=nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(p^,Dest,ElemSize) else
      {$ifdef FPC}
      FPCRecordCopy(p^,Dest,ElemType); // works for any kind of ElemTyp
      {$else}
      CopyArray(@Dest,p,ElemType,1);
      {$endif}
end;

procedure TDynArray.ElemMoveTo(index: PtrInt; var Dest);
var p: pointer;
begin
  p := ElemPtr(index);
  if (p=nil) or (@Dest=nil) then
    exit;
  ElemClear(Dest);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(p^,Dest,ElemSize);
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(p^,ElemSize,0); // ElemType=nil for ObjArray
end;

procedure TDynArray.ElemCopyFrom(const Source; index: PtrInt; ClearBeforeCopy: boolean);
var p: pointer;
begin
  p := ElemPtr(index);
  if p<>nil then
    if ElemType=nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Source,p^,ElemSize) else begin
      if ClearBeforeCopy then // safer if Source is a copy of p^
        {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(p,ElemType);
      {$ifdef FPC}
      FPCRecordCopy(Source,p^,ElemType);
      {$else}
      CopyArray(p,@Source,ElemType,1);
      {$endif}
    end;
end;

procedure TDynArray.Reverse;
var siz, n, tmp: integer;
    P1, P2: PAnsiChar;
    c: AnsiChar;
    i64: Int64;
begin
  n := GetCount-1;
  if n>0 then begin
    siz := ElemSize;
    P1 := fValue^;
    case siz of
    1: begin
      // optimized version for TByteDynArray and such
      P2 := P1+n;
      while P1<P2 do begin
        c := P1^;
        P1^ := P2^;
        P2^ := c;
        inc(P1);
        dec(P2);
      end;
    end;
    4: begin
      // optimized version for TIntegerDynArray and such
      P2 := P1+n*SizeOf(Integer);
      while P1<P2 do begin
        tmp := PInteger(P1)^;
        PInteger(P1)^ := PInteger(P2)^;
        PInteger(P2)^ := tmp;
        inc(P1,4);
        dec(P2,4);
      end;
    end;
    8: begin
      // optimized version for TInt64DynArray + TDoubleDynArray and such
      P2 := P1+n*SizeOf(Int64);
      while P1<P2 do begin
        i64 := PInt64(P1)^;
        PInt64(P1)^ := PInt64(P2)^;
        PInt64(P2)^ := i64;
        inc(P1,8);
        dec(P2,8);
      end;
    end;
    16: begin
      // optimized version for TVariantDynArray and such
      P2 := P1+n*16;
      while P1<P2 do begin
        Exchg16(Pointer(P1),Pointer(P2));
        inc(P1,16);
        dec(P2,16);
      end;
    end;
    else begin
      // generic version
      P2 := P1+n*siz;
      while P1<P2 do begin
        Exchg(P1,P2,siz);
        inc(P1,siz);
        dec(P2,siz);
      end;
    end;
    end;
  end;
end;

procedure TDynArray.SaveToStream(Stream: TStream);
var Posi, PosiEnd: Integer;
    MemStream: TCustomMemoryStream absolute Stream;
    tmp: RawByteString;
begin
  if (fValue=nil) or (Stream=nil) then
    exit; // avoid GPF if void
  if Stream.InheritsFrom(TCustomMemoryStream) then begin
    Posi := MemStream.Seek(0,soFromCurrent);
    PosiEnd := Posi+SaveToLength;
    if PosiEnd>MemStream.Size then
      MemStream.Size := PosiEnd;
    if SaveTo(PAnsiChar(MemStream.Memory)+Posi)-MemStream.Memory<>PosiEnd then
      raise EStreamError.Create('TDynArray.SaveToStream: SaveTo');
    MemStream.Seek(PosiEnd,soBeginning);
  end else begin
    tmp := SaveTo;
    if Stream.Write(pointer(tmp)^,length(tmp))<>length(tmp) then
      raise EStreamError.Create('TDynArray.SaveToStream: Write error');
  end;
end;

procedure TDynArray.LoadFromStream(Stream: TCustomMemoryStream);
var P: PAnsiChar;
begin
  P := PAnsiChar(Stream.Memory)+Stream.Seek(0,soFromCurrent);
  Stream.Seek(LoadFrom(P)-P,soCurrent);
end;

function TDynArray.SaveToTypeInfoHash(crc: cardinal): cardinal;
begin
  if ElemType=nil then // hash fElemSize only if no pointer within
    result := crc32c(crc,@fElemSize,4) else begin
    result := crc;
    ManagedTypeSaveRTTIHash(ElemType,result);
  end;
end;

function TDynArray.SaveTo(Dest: PAnsiChar): PAnsiChar;
var i, n, LenBytes: integer;
    P: PAnsiChar;
begin
  if fValue=nil then begin
    result := Dest;
    exit; // avoid GPF if void
  end;
  // first store the element size+type to check for the format (name='' mostly)
  Dest := PAnsiChar(ToVarUInt32(ElemSize,pointer(Dest)));
  if ElemType=nil then
    Dest^ := #0 else
    {$ifdef FPC}
    Dest^ := AnsiChar(FPCTODELPHI[PTypeKind(ElemType)^]);
    {$else}
    Dest^ := PAnsiChar(ElemType)^;
    {$endif}
  inc(Dest);
  // then store dynamic array count
  n := GetCount;
  Dest := PAnsiChar(ToVarUInt32(n,pointer(Dest)));
  if n=0 then begin
    result := Dest;
    exit;
  end;
  inc(Dest,SizeOf(Cardinal)); // leave space for Hash32 checksum
  result := Dest;
  // store dynamic array elements content
  P := fValue^;
  if ElemType=nil then // FPC: nil also if not Kind in tkManagedTypes
    if GetIsObjArray then
      raise ESynException.CreateUTF8('TDynArray.SaveTo(%) is a T*ObjArray',
        [ArrayTypeShort^]) else begin
      // binary types: store as once
      n := n*integer(ElemSize);
      {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,Dest^,n);
      inc(Dest,n);
    end else
    case PTypeKind(ElemType)^ of
    tkRecord{$ifdef FPC},tkObject{$endif}:
      for i := 1 to n do begin
        Dest := RecordSave(P^,Dest,ElemType,LenBytes);
        inc(P,LenBytes);
      end;
    else
      for i := 1 to n do begin
        Dest := ManagedTypeSave(P,Dest,ElemType,LenBytes);
        if Dest=nil then
          break;
        inc(P,LenBytes);
      end;
    end;
  // store Hash32 checksum
  if Dest<>nil then  // may be nil if RecordSave/ManagedTypeSave failed
    PCardinal(result-SizeOf(Cardinal))^ := Hash32(pointer(result),Dest-result);
  result := Dest;
end;

function TDynArray.SaveToLength: integer;
var i,n,L,size: integer;
    P: PAnsiChar;
begin
  if fValue=nil then begin
    result := 0;
    exit; // avoid GPF if void
  end;
  n := GetCount;
  result := ToVarUInt32Length(ElemSize)+ToVarUInt32Length(n)+1;
  if n=0 then
    exit;
  if ElemType=nil then // FPC: nil also if not Kind in tkManagedTypes
    if GetIsObjArray then
      raise ESynException.CreateUTF8('TDynArray.SaveToLength(%) is a T*ObjArray',
        [ArrayTypeShort^]) else
      inc(result,integer(ElemSize)*n) else begin
    P := fValue^;
    case PTypeKind(ElemType)^ of // inlined the most used kind of items
    tkLString,tkWString{$ifdef FPC},tkLStringOld{$endif}:
      for i := 1 to n do begin
        if PPtrUInt(P)^=0 then
          inc(result) else
          inc(result,ToVarUInt32LengthWithData(PStrRec(PPtrUInt(P)^-STRRECSIZE)^.length));
        inc(P,SizeOf(pointer));
      end;
    tkRecord{$ifdef FPC},tkObject{$endif}:
      for i := 1 to n do begin
        inc(result,RecordSaveLength(P^,ElemType));
        inc(P,ElemSize);
      end;
    else
      for i := 1 to n do begin
        L := ManagedTypeSaveLength(P,ElemType,size);
        if L=0 then
          break; // invalid record type (wrong field type)
        inc(result,L);
        inc(P,size);
      end;
    end;
  end;
  inc(result,SizeOf(Cardinal)); // Hash32 checksum
end;

function TDynArray.SaveTo: RawByteString;
var Len: integer;
begin
  Len := SaveToLength;
  SetString(result,nil,Len);
  if Len<>0 then
    if SaveTo(pointer(result))-pointer(result)<>Len then
      raise ESynException.Create('TDynArray.SaveTo len concern');
end;

function TDynArray.SaveToJSON(EnumSetsAsText: boolean; reformat: TTextWriterJSONFormat): RawUTF8;
begin
  SaveToJSON(result,EnumSetsAsText,reformat);
end;

procedure TDynArray.SaveToJSON(out Result: RawUTF8; EnumSetsAsText: boolean;
  reformat: TTextWriterJSONFormat);
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
  try
    if EnumSetsAsText then
      CustomOptions := CustomOptions+[twoEnumSetsAsTextInRecord];
    AddDynArrayJSON(self);
    SetText(result,reformat);
  finally
    Free;
  end;
end;

const
  PTRSIZ = SizeOf(Pointer);
  KNOWNTYPE_SIZE: array[TDynArrayKind] of byte = (
    0, 1,1, 2, 4,4,4, 8,8,8,8,8,8,8, PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,
    16,32,64, PTRSIZ,
    {$ifndef NOVARIANTS}SizeOf(Variant),{$endif} 0);
  DYNARRAY_PARSERUNKNOWN = -2;

var
  KINDTYPE_INFO: array[TDynArrayKind] of pointer;

function TDynArray.GetArrayTypeName: RawUTF8;
begin
  TypeInfoToName(fTypeInfo,result);
end;

function TDynArray.GetArrayTypeShort: PShortString;
begin
  if fTypeInfo=nil then
    result := @NULCHAR else
    result := PShortString(@PTypeInfo(fTypeInfo).NameLen);
end;

function TDynArray.ToKnownType(exactType: boolean): TDynArrayKind;
var nested: PTypeInfo;
    field: PFieldInfo;
label Bin, Rec;
begin
  result := fKnownType;
  if result<>djNone then
    exit;
  case ElemSize of
  1: if fTypeInfo=TypeInfo(TBooleanDynArray) then
       result := djBoolean;
  4: if fTypeInfo=TypeInfo(TCardinalDynArray) then
       result := djCardinal else
     if fTypeInfo=TypeInfo(TSingleDynArray) then
       result := djSingle
  {$ifdef CPU64} ; 8: {$else} else {$endif}
    if fTypeInfo=TypeInfo(TRawUTF8DynArray) then
      result := djRawUTF8 else
    if fTypeInfo=TypeInfo(TStringDynArray) then
      result := djString else
    if fTypeInfo=TypeInfo(TWinAnsiDynArray) then
      result := djWinAnsi else
    if fTypeInfo=TypeInfo(TRawByteStringDynArray) then
      result := djRawByteString else
    if fTypeInfo=TypeInfo(TSynUnicodeDynArray) then
      result := djSynUnicode else
    if (fTypeInfo=TypeInfo(TClassDynArray)) or
       (fTypeInfo=TypeInfo(TPointerDynArray)) then
      result := djPointer else
    {$ifndef DELPHI5OROLDER}
    if fTypeInfo=TypeInfo(TInterfaceDynArray) then
      result := djInterface
    {$endif DELPHI5OROLDER}
  {$ifdef CPU64} else {$else} ; 8: {$endif}
     if fTypeInfo=TypeInfo(TDoubleDynArray) then
       result := djDouble else
     if fTypeInfo=TypeInfo(TCurrencyDynArray) then
       result := djCurrency else
     if fTypeInfo=TypeInfo(TTimeLogDynArray) then
       result := djTimeLog else
     if fTypeInfo=TypeInfo(TDateTimeDynArray) then
       result := djDateTime else
     if fTypeInfo=TypeInfo(TDateTimeMSDynArray) then
       result := djDateTimeMS;
  end;
  if result=djNone then begin
    fKnownSize := 0;
    if ElemType=nil then
Bin:  case ElemSize of
      1: result := djByte;
      2: result := djWord;
      4: result := djInteger;
      8: result := djInt64;
      16: result := djHash128;
      32: result := djHash256;
      64: result := djHash512;
      else fKnownSize := ElemSize;
      end else
      case PTypeKind(ElemType)^ of
        tkLString{$ifdef FPC},tkLStringOld{$endif}: result := djRawUTF8;
        tkWString: result := djWideString;
        {$ifdef UNICODE}
        tkUString: result := djString;
        {$else}
        {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
        tkUString: result := djSynUnicode;
        {$endif FPC_HAS_FEATURE_UNICODESTRINGS}
        {$endif}
        {$ifndef NOVARIANTS}
        tkVariant: result := djVariant;
        {$endif}
        tkInterface: result := djInterface;
        tkRecord{$ifdef FPC},tkObject{$endif}: if not exacttype then begin
          nested := ElemType; // inlined GetTypeInfo()
          {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  rec:    nested := GetFPCAlignPtr(nested);
          {$else}
  rec:    inc(PByte(nested),nested^.NameLen);
          {$endif}
          {$ifdef FPC_OLDRTTI}
          field := OldRTTIFirstManagedField(nested);
          if field=nil then
          {$else FPC_OLDRTTI}
          if GetManagedFields(nested,field)=0 then // only binary content
          {$endif FPC_OLDRTTI}
            goto Bin;
          case field^.Offset of
          0: case DeRef(field^.TypeInfo)^.Kind of
             tkLString{$ifdef FPC},tkLStringOld{$endif}: result := djRawUTF8;
             tkWString: result := djWideString;
             {$ifdef UNICODE}
             tkUString: result := djString;
             {$else}
             {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
             tkUString: result := djSynUnicode;
             {$endif FPC_HAS_FEATURE_UNICODESTRINGS}
             {$endif}
             tkRecord{$ifdef FPC},tkObject{$endif}: begin
               nested := DeRef(field^.TypeInfo);
               goto Rec;
             end;
             {$ifndef NOVARIANTS}
             tkVariant: result := djVariant;
             {$endif}
             else goto bin;
             end;
          1: result := djByte;
          2: result := djWord;
          4: result := djInteger;
          8: result := djInt64;
          16: result := djHash128;
          32: result := djHash256;
          64: result := djHash512;
          else fKnownSize := field^.Offset;
          end;
        end;
      end;
  end;
  if KNOWNTYPE_SIZE[result]<>0 then
    fKnownSize := KNOWNTYPE_SIZE[result];
  fKnownType := result;
end;

function TDynArray.ElemCopyFirstField(Source,Dest: Pointer): boolean;
begin
  if fKnownType=djNone then
    ToKnownType(false);
  case fKnownType of
  djBoolean..djDateTimeMS,djHash128..djHash512: // no managed field
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Dest^,fKnownSize);
  djRawUTF8, djWinAnsi, djRawByteString:
    PRawByteString(Dest)^ := PRawByteString(Source)^;
  djSynUnicode:
    PSynUnicode(Dest)^ := PSynUnicode(Source)^;
  djString:
    PString(Dest)^ := PString(Source)^;
  djWideString:
    PWideString(Dest)^ := PWideString(Source)^;
  {$ifndef NOVARIANTS}djVariant: PVariant(Dest)^ := PVariant(Source)^;{$endif}
  else begin // djNone, djInterface, djCustom
    result := false;
    exit;
  end;
  end;
  result := true;
end;

function TDynArray.LoadKnownType(Data,Source: PAnsiChar): boolean;
var info: PTypeInfo;
begin
  if fKnownType=djNone then
    ToKnownType({exacttype=}false); // set fKnownType and fKnownSize
  if fKnownType in [djBoolean..djDateTimeMS] then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Data^,fKnownSize);
    result := true;
  end else begin
    info := KINDTYPE_INFO[fKnownType];
    if info=nil then
      result := false else
      result := (ManagedTypeLoad(Data,Source,info)<>0) and (Source<>nil);
  end;
end;

function TDynArray.LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil): PUTF8Char;
var n, i, ValLen: integer;
    T: TDynArrayKind;
    wasString, expectedString, isValid: boolean;
    EndOfObject: AnsiChar;
    Val: PUTF8Char;
    V: pointer;
    CustomReader: TDynArrayJSONCustomReader;
    NestedDynArray: TDynArray;
begin // code below must match TTextWriter.AddDynArrayJSON()
  result := nil;
  if (P=nil) or (fValue=nil) then
    exit;
  if not NextNotSpaceCharIs(P,'[') then
    exit;
  n := JSONArrayCount(P);
  if n<0 then
    exit; // invalid array content
  if n=0 then begin
    if NextNotSpaceCharIs(P,']') then begin
      Clear;
      result := P;
    end;
    exit; // handle '[]' array
  end;
  if HasCustomJSONParser then
    CustomReader := GlobalJSONCustomParsers.fParser[fParser].Reader else
    CustomReader := nil;
  if Assigned(CustomReader) then
    T := djCustom else
    T := ToKnownType({exacttype=}true);
  if (T=djNone) and (P^='[') and (PTypeKind(ElemType)^=tkDynArray) then begin
    Count := n; // fast allocation of the whole dynamic array memory at once
    for i := 0 to n-1 do begin
      NestedDynArray.Init(ElemType,PPointerArray(fValue^)^[i]);
      P := NestedDynArray.LoadFromJSON(P,@EndOfObject);
      if P=nil then
        exit;
      EndOfObject := P^; // ',' or ']' for the last item of the array
      inc(P);
    end;
  end else
  if (T=djNone) or
     (PCardinal(P)^=JSON_BASE64_MAGIC_QUOTE) then begin
    if n<>1 then
      exit; // expect one Base64 encoded string value preceded by \uFFF0
    Val := GetJSONField(P,P,@wasString,@EndOfObject);
    if (Val=nil) or not wasString or
       (PInteger(Val)^ and $00ffffff<>JSON_BASE64_MAGIC) or
       (LoadFrom(pointer(Base64ToBin(Val+3)))=nil) then
      exit; // invalid content
  end else begin
    if GetIsObjArray then
      for i := 0 to Count-1 do // force release any previous instance
        FreeAndNil(PObjectArray(fValue^)^[i]);
    SetCount(n); // fast allocation of the whole dynamic array memory at once
    case T of
    {$ifndef NOVARIANTS}
    djVariant:
      for i := 0 to n-1 do
        P := VariantLoadJSON(PVariantArray(fValue^)^[i],P,@EndOfObject,@JSON_OPTIONS[true]);
    {$endif}
    djCustom: begin
      Val := fValue^;
      for i := 1 to n do begin
        P := CustomReader(P,Val^,isValid);
        if not isValid then
          exit;
        EndOfObject := P^; // ',' or ']' for the last item of the array
        inc(P);
        inc(Val,ElemSize);
      end;
    end;
    else begin
      V := fValue^;
      expectedString := (T in [djTimeLog..djHash512]);
      for i := 0 to n-1 do begin
        Val := GetJSONField(P,P,@wasString,@EndOfObject,@ValLen);
        if (Val=nil) or (wasString<>expectedString) then
          exit;
        case T of
        djBoolean:  PBooleanArray(V)^[i] := GetBoolean(Val);
        djByte:     PByteArray(V)^[i] := GetCardinal(Val);
        djWord:     PWordArray(V)^[i] := GetCardinal(Val);
        djInteger:  PIntegerArray(V)^[i] := GetInteger(Val);
        djCardinal: PCardinalArray(V)^[i] := GetCardinal(Val);
        djSingle:   PSingleArray(V)^[i] := GetExtended(Val);
        djInt64:    SetInt64(Val,PInt64Array(V)^[i]);
        djQWord:    SetQWord(Val,PQWordArray(V)^[i]);
        djTimeLog:  PInt64Array(V)^[i] := Iso8601ToTimeLogPUTF8Char(Val,ValLen);
        djDateTime, djDateTimeMS:
          Iso8601ToDateTimePUTF8CharVar(Val,ValLen,PDateTimeArray(V)^[i]);
        djDouble:   PDoubleArray(V)^[i] := GetExtended(Val);
        djCurrency: PInt64Array(V)^[i] := StrToCurr64(Val);
        djRawUTF8:  FastSetString(PRawUTF8Array(V)^[i],Val,ValLen);
        djRawByteString:
          if not Base64MagicCheckAndDecode(Val,ValLen,PRawByteStringArray(V)^[i]) then
            FastSetString(PRawUTF8Array(V)^[i],Val,ValLen);
        djWinAnsi:  WinAnsiConvert.UTF8BufferToAnsi(Val,ValLen,PRawByteStringArray(V)^[i]);
        djString:   UTF8DecodeToString(Val,ValLen,string(PPointerArray(V)^[i]));
        djWideString: UTF8ToWideString(Val,ValLen,WideString(PPointerArray(V)^[i]));
        djSynUnicode: UTF8ToSynUnicode(Val,ValLen,SynUnicode(PPointerArray(V)^[i]));
        djHash128:  if ValLen<>SizeOf(THash128)*2 then FillZero(PHash128Array(V)^[i]) else
                      HexDisplayToBin(pointer(Val),@PHash128Array(V)^[i],SizeOf(THash128));
        djHash256:  if ValLen<>SizeOf(THash256)*2 then FillZero(PHash256Array(V)^[i]) else
                      HexDisplayToBin(pointer(Val),@PHash256Array(V)^[i],SizeOf(THash256));
        djHash512:  if ValLen<>SizeOf(THash512)*2 then FillZero(PHash512Array(V)^[i]) else
                      HexDisplayToBin(pointer(Val),@PHash512Array(V)^[i],SizeOf(THash512));
        else raise ESynException.CreateUTF8('% not readable',[ToText(T)^]);
        end;
      end;
    end;
    end;
  end;
  if aEndOfObject<>nil then
    aEndOfObject^ := EndOfObject;
  if EndOfObject=']' then
    if P=nil then
      result := @NULCHAR else
      result := P;
end;

{$ifndef NOVARIANTS}
function TDynArray.LoadFromVariant(const DocVariant: variant): boolean;
begin
  with _Safe(DocVariant)^ do
    if dvoIsArray in Options then
      result := LoadFromJSON(pointer(_Safe(DocVariant)^.ToJSON))<>nil else
      result := false;
end;
{$endif NOVARIANTS}

function SimpleDynArrayLoadFrom(Source: PAnsiChar; aTypeInfo: pointer;
  var Count, ElemSize: integer; NoHash32Check: boolean): pointer;
var Hash: PCardinalArray absolute Source;
    info: PTypeInfo;
begin
  result := nil;
  info := GetTypeInfo(aTypeInfo,tkDynArray);
  if info=nil then
    exit; // invalid type information
  if (info^.ElType<>nil) or (Source=nil) or
     (Source[0]<>AnsiChar(info^.elSize)) or (Source[1]<>#0) then
    exit; // invalid type information or Source content
  ElemSize := info^.elSize {$ifdef FPC}and $7FFFFFFF{$endif};
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  if (Count<>0) and (NoHash32Check or (Hash32(@Hash[1],Count*ElemSize)=Hash[0])) then
    result := @Hash[1]; // returns valid Source content
end;

function IntegerDynArrayLoadFrom(Source: PAnsiChar; var Count: integer;
  NoHash32Check: boolean): PIntegerArray;
var Hash: PCardinalArray absolute Source;
begin
  result := nil;
  if (Source=nil) or (Source[0]<>#4) or (Source[1]<>#0) then
    exit; // invalid Source content
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  if (Count<>0) and (NoHash32Check or (Hash32(@Hash[1],Count*4)=Hash[0])) then
    result := @Hash[1]; // returns valid Source content
end;

function RawUTF8DynArrayLoadFromContains(Source: PAnsiChar;
  Value: PUTF8Char; ValueLen: integer; CaseSensitive: boolean): integer;
var Count, Len: integer;
begin
  if (Value=nil) or (ValueLen=0) or
     (Source=nil) or (Source[0]<>AnsiChar(SizeOf(PtrInt)))
     {$ifndef FPC}or (Source[1]<>AnsiChar(tkLString)){$endif} then begin
    result := -1;
    exit; // invalid Source or Value content
  end;
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  inc(Source,SizeOf(cardinal)); // ignore Hash32 security checksum
  for result := 0 to Count-1 do begin
    Len := FromVarUInt32(PByte(Source));
    if CaseSensitive then begin
      if (Len=ValueLen) and CompareMemFixed(Value,Source,Len) then
        exit;
    end else
      if UTF8ILComp(Value,pointer(Source),ValueLen,Len)=0 then
        exit;
    inc(Source,Len);
  end;
  result := -1;
end;

function TDynArrayLoadFrom.Init(ArrayTypeInfo: pointer; Source: PAnsiChar): boolean;
var fake: pointer;
begin
  result := false;
  Position := nil; // force Step() to return false if called aterwards
  if Source=nil then
    exit;
  DynArray.Init(ArrayTypeInfo,fake); // just to retrieve RTTI
  FromVarUInt32(PByte(Source)); // ignore StoredElemSize to be Win32/64 compatible
  if DynArray.ElemType=nil then begin
    if (Source^<>#0) or DynArray.GetIsObjArray then
      exit; // invalid Source, or unexpected T*ObjArray
  end else
  if Source^<>{$ifdef FPC} // cross-FPC/Delphi compatible
      AnsiChar(FPCTODELPHI[PTypeKind(DynArray.ElemType)^]){$else}
      PAnsiChar(DynArray.ElemType)^{$endif} then
    exit; // invalid Source content
  inc(Source);
  Count := FromVarUInt32(PByte(Source));
  Hash := pointer(Source);
  Position := Source+SizeOf(cardinal);
  Current := 0;
  result := true;
end;

function TDynArrayLoadFrom.Step(out Elem): boolean;
begin
  result := false;
  if (Position<>nil) and (Current<Count) then begin
    if DynArray.ElemType=nil then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Position^,Elem,DynArray.ElemSize);
      inc(Position,DynArray.ElemSize);
    end else begin
      ManagedTypeLoad(@Elem,Position,DynArray.ElemType);
      if Position=nil then
         exit;
    end;
    inc(Current);
    result := true;
  end;
end;

function TDynArrayLoadFrom.FirstField(out Field): boolean;
begin
  if (Position<>nil) and (Current<Count) then
    result := DynArray.LoadKnownType(@Field,Position) else
    result := false;
end;

function TDynArrayLoadFrom.CheckHash: boolean;
begin
  result := (Position<>nil) and
     (Hash32(@Hash[1],Position-PAnsiChar(@Hash[1]))=Hash[0]);
end;

function TDynArray.LoadFrom(Source: PAnsiChar; AfterEach: TDynArrayAfterLoadFrom;
  NoCheckHash: boolean): PAnsiChar;
var i, n: integer;
    P: PAnsiChar;
    Hash: PCardinalArray;
begin
  // check context
  result := nil;
  if Source=nil then begin
    Clear;
    exit;
  end;
  if fValue=nil then
    exit;
  // check stored element size+type
  FromVarUInt32(PByte(Source)); // ignore StoredElemSize to be Win32/64 compatible
  if ElemType=nil then begin
    if Source^<>#0 then
      exit;
  end else
    if Source^<>{$ifdef FPC} // cross-FPC/Delphi compatible
        AnsiChar(FPCTODELPHI[PTypeKind(ElemType)^]){$else}
        PAnsiChar(ElemType)^{$endif} then
      exit;
  inc(Source);
  // retrieve dynamic array count
  n := FromVarUInt32(PByte(Source));
  SetCount(n);
  if n=0 then begin
    result := Source;
    exit;
  end;
  // retrieve security checksum
  Hash := pointer(Source);
  inc(Source,SizeOf(cardinal));
  // retrieve dynamic array elements content
  P := fValue^;
  if ElemType=nil then // FPC: nil also if not Kind in tkManagedTypes
    if GetIsObjArray then
      raise ESynException.CreateUTF8('TDynArray.LoadFrom(%) is a T*ObjArray',
        [ArrayTypeShort^]) else begin
      // binary type was stored directly
      n := n*integer(ElemSize);
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,P^,n);
      inc(Source,n);
    end else
    case PTypeKind(ElemType)^ of
    tkRecord{$ifdef FPC},tkObject{$endif}:
      for i := 1 to n do begin
        Source := RecordLoad(P^,Source,ElemType);
        if Assigned(AfterEach) then
          AfterEach(P^);
        inc(P,ElemSize);
      end;
    else
      for i := 1 to n do begin
        ManagedTypeLoad(P,Source,ElemType);
        if Source=nil then
           break;
        if Assigned(AfterEach) then
          AfterEach(P^);
        inc(P,ElemSize);
      end;
    end;
  // check security checksum
  if NoCheckHash or (Source=nil) or
     (Hash32(@Hash[1],Source-PAnsiChar(@Hash[1]))=Hash[0]) then
    result := Source;
end;

function TDynArray.Find(const Elem; const aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare): PtrInt;
var n, L: PtrInt;
    cmp: integer;
    P: PAnsiChar;
begin
  n := GetCount;
  if (@aCompare<>nil) and (n>0) then begin
    dec(n);
    P := fValue^;
    if (n>10) and (length(aIndex)>=n) then begin
      // array should be sorted via aIndex[] -> use fast O(log(n)) binary search
      L := 0;
      repeat
        result := (L+n) shr 1;
        cmp := aCompare(P[cardinal(aIndex[result])*ElemSize],Elem);
        if cmp=0 then begin
          result := aIndex[result]; // returns index in TDynArray
          exit;
        end;
        if cmp<0 then
          L := result+1 else
          n := result-1;
      until L>n;
    end else
      // array is not sorted, or aIndex=nil -> use O(n) iterating search
      for result := 0 to n do
        if aCompare(P^,Elem)=0 then
          exit else
          inc(P,ElemSize);
  end;
  result := -1;
end;

function TDynArray.FindIndex(const Elem; aIndex: PIntegerDynArray;
  aCompare: TDynArraySortCompare): PtrInt;
begin
  if aIndex<>nil then
    result := Find(Elem,aIndex^,aCompare) else
  if Assigned(aCompare) then
    result := Find(Elem,nil,aCompare) else
    result := Find(Elem);
end;

function TDynArray.FindAndFill(var Elem; aIndex: PIntegerDynArray=nil;
  aCompare: TDynArraySortCompare=nil): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result>=0 then // if found, fill Elem with the matching item
    ElemCopy(PAnsiChar(fValue^)[cardinal(result)*ElemSize],Elem);
end;

function TDynArray.FindAndDelete(const Elem; aIndex: PIntegerDynArray=nil;
  aCompare: TDynArraySortCompare=nil): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result>=0 then
    Delete(result);
end;

function TDynArray.FindAndUpdate(const Elem; aIndex: PIntegerDynArray=nil;
  aCompare: TDynArraySortCompare=nil): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result>=0 then // if found, fill Elem with the matching item
    ElemCopy(Elem,PAnsiChar(fValue^)[cardinal(result)*ElemSize]);
end;

function TDynArray.FindAndAddIfNotExisting(const Elem; aIndex: PIntegerDynArray=nil;
  aCompare: TDynArraySortCompare=nil): integer;
begin
  result := FindIndex(Elem,aIndex,aCompare);
  if result<0 then
    Add(Elem); // -1 will mark success
end;

function TDynArray.Find(const Elem): PtrInt;
var n, L: PtrInt;
    cmp: integer;
    P: PAnsiChar;
begin
  n := GetCount;
  if (@fCompare<>nil) and (n>0) then begin
    dec(n);
    P := fValue^;
    if fSorted and (n>10) then begin
      // array is sorted -> use fast O(log(n)) binary search
      L := 0;
      repeat
        result := (L+n) shr 1;
        cmp := fCompare(P[cardinal(result)*ElemSize],Elem);
        if cmp=0 then
          exit;
        if cmp<0 then
          L := result+1 else
          n := result-1;
      until L>n;
    end else begin
      // array is very small, or not sorted -> use O(n) iterating search
      if (ElemType=nil) and (@fCompare=@DYNARRAY_SORTFIRSTFIELD[false,fKnownType]) then
      case fElemSize of // optimized for simple key types (e.g. TSynDictionary)
      4: begin
        result := IntegerScanIndex(pointer(P),n+1,Integer(Elem));
        exit;
      end;
      8: begin
        result := Int64ScanIndex(pointer(P),n+1,Int64(Elem));
        exit;
      end;
      end;
      for result := 0 to n do
        if fCompare(P^,Elem)=0 then
          exit else
          inc(P,ElemSize);
    end;
  end;
  result := -1;
end;

function TDynArray.FindAllSorted(const Elem; out FirstIndex,LastIndex: Integer): boolean;
var found,last: integer;
    P: PAnsiChar;
begin
  result := FastLocateSorted(Elem,found);
  if not result then
    exit;
  FirstIndex := found;
  P := fValue^;
  while (FirstIndex>0) and (fCompare(P[cardinal(FirstIndex-1)*ElemSize],Elem)=0) do
    dec(FirstIndex);
  last := GetCount-1;
  LastIndex := found;
  while (LastIndex<last) and (fCompare(P[cardinal(LastIndex+1)*ElemSize],Elem)=0) do
    inc(LastIndex);
end;

function TDynArray.FastLocateSorted(const Elem; out Index: Integer): boolean;
var n, i, cmp: integer;
    P: PAnsiChar;
begin
  result := False;
  n := GetCount;
  if @fCompare<>nil then
    if n=0 then // a void array is always sorted
      Index := 0 else
    if fSorted then begin
      P := fValue^;
      dec(n);
      cmp := fCompare(Elem,P[cardinal(n)*ElemSize]);
      if cmp>=0 then begin // greater than last sorted item
        Index := n;
        if cmp=0 then
          result := true else // returns true + index of existing Elem
          inc(Index); // returns false + insert after last position
        exit;
      end;
      Index := 0;
      while Index<=n do begin // O(log(n)) binary search of the sorted position
        i := (Index+n) shr 1;
        cmp := fCompare(P[cardinal(i)*ElemSize],Elem);
        if cmp=0 then begin
          Index := i; // returns true + index of existing Elem
          result := True;
          exit;
        end else
          if cmp<0 then
            Index := i+1 else
            n := i-1;
      end;
      // Elem not found: returns false + the index where to insert
    end else
      Index := -1 else // not Sorted
    Index := -1; // no fCompare()
end;

procedure TDynArray.FastAddSorted(Index: Integer; const Elem);
begin
  Insert(Index,Elem);
  fSorted := true; // Insert -> SetCount -> fSorted := false
end;

procedure TDynArray.FastDeleteSorted(Index: Integer);
begin
  Delete(Index);
  fSorted := true; // Delete -> SetCount -> fSorted := false
end;

function TDynArray.FastLocateOrAddSorted(const Elem; wasAdded: PBoolean): integer;
var toInsert: boolean;
begin
  toInsert := not FastLocateSorted(Elem,result) and (result>=0);
  if toInsert then begin
    Insert(result,Elem);
    fSorted := true; // Insert -> SetCount -> fSorted := false
  end;
  if wasAdded<>nil then
    wasAdded^ := toInsert;
end;

type
  // internal structure used to make QuickSort faster & with less stack usage
  {$ifdef FPC_OR_UNICODE}TDynArrayQuickSort = record{$else}TDynArrayQuickSort = object{$endif}
  public
    Compare: TDynArraySortCompare;
    CompareEvent: TEventDynArraySortCompare;
    Pivot: pointer;
    Index: PCardinalArray;
    ElemSize: cardinal;
    P: PtrInt;
    Value: PAnsiChar;
    IP, JP: PAnsiChar;
    procedure QuickSort(L, R: PtrInt);
    procedure QuickSortIndexed(L, R: PtrInt);
    procedure QuickSortEvent(L, R: PtrInt);
    procedure QuickSortEventReverse(L, R: PtrInt);
  end;

procedure QuickSortIndexedPUTF8Char(Values: PPUtf8CharArray; Count: Integer;
  var SortedIndexes: TCardinalDynArray; CaseSensitive: boolean);
var QS: TDynArrayQuickSort;
begin
  if CaseSensitive then
    QS.Compare := SortDynArrayPUTF8Char else
    QS.Compare := SortDynArrayPUTF8CharI;
  QS.Value := pointer(Values);
  QS.ElemSize := SizeOf(PUTF8Char);
  SetLength(SortedIndexes,Count);
  FillIncreasing(pointer(SortedIndexes),0,Count);
  QS.Index := pointer(SortedIndexes);
  QS.QuickSortIndexed(0,Count-1);
end;

procedure DynArraySortIndexed(Values: pointer; ElemSize, Count: Integer;
  out Indexes: TSynTempBuffer; Compare: TDynArraySortCompare);
var QS: TDynArrayQuickSort;
begin
  QS.Compare := Compare;
  QS.Value := Values;
  QS.ElemSize := ElemSize;
  QS.Index := pointer(Indexes.InitIncreasing(Count));
  QS.QuickSortIndexed(0,Count-1);
end;

procedure TDynArrayQuickSort.QuickSort(L, R: PtrInt);
var I, J: PtrInt;
    {$ifndef PUREPASCAL}tmp: pointer;{$endif}
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+PtrUInt(P)*ElemSize;
      IP := Value+PtrUInt(I)*ElemSize;
      JP := Value+PtrUInt(J)*ElemSize;
      while Compare(IP^,Pivot^)<0 do begin
        inc(I);
        inc(IP,ElemSize);
      end;
      while Compare(JP^,Pivot^)>0 do begin
        dec(J);
        dec(JP,ElemSize);
      end;
      if I <= J then begin
        if I<>J then
          {$ifndef PUREPASCAL} // inlined Exchg() is just fine
          if ElemSize=SizeOf(pointer) then begin
            // optimized version e.g. for TRawUTF8DynArray/TObjectDynArray
            tmp := PPointer(IP)^;
            PPointer(IP)^ := PPointer(JP)^;
            PPointer(JP)^ := tmp;
          end else
          {$endif}
            // generic exchange of row element data
            Exchg(IP,JP,ElemSize);
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSort(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSort(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArrayQuickSort.QuickSortEvent(L, R: PtrInt);
var I, J: PtrInt;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+PtrUInt(P)*ElemSize;
      IP := Value+PtrUInt(I)*ElemSize;
      JP := Value+PtrUInt(J)*ElemSize;
      while CompareEvent(IP^,Pivot^)<0 do begin
        inc(I);
        inc(IP,ElemSize);
      end;
      while CompareEvent(JP^,Pivot^)>0 do begin
        dec(J);
        dec(JP,ElemSize);
      end;
      if I <= J then begin
        if I<>J then
          Exchg(IP,JP,ElemSize);
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortEvent(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortEvent(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArrayQuickSort.QuickSortEventReverse(L, R: PtrInt);
var I, J: PtrInt;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+PtrUInt(P)*ElemSize;
      IP := Value+PtrUInt(I)*ElemSize;
      JP := Value+PtrUInt(J)*ElemSize;
      while CompareEvent(IP^,Pivot^)>0 do begin
        inc(I);
        inc(IP,ElemSize);
      end;
      while CompareEvent(JP^,Pivot^)<0 do begin
        dec(J);
        dec(JP,ElemSize);
      end;
      if I <= J then begin
        if I<>J then
          Exchg(IP,JP,ElemSize);
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortEventReverse(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortEventReverse(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArrayQuickSort.QuickSortIndexed(L, R: PtrInt);
var I, J: PtrInt;
    tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      Pivot := Value+Index[P]*ElemSize;
      while Compare(Value[Index[I]*ElemSize],Pivot^)<0 do inc(I);
      while Compare(Value[Index[J]*ElemSize],Pivot^)>0 do dec(J);
      if I <= J then begin
        if I<>J then begin
          tmp := Index[I];
          Index[I] := Index[J];
          Index[J] := tmp;
        end;
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortIndexed(L, J);
      L := I;
    end else begin
      if I < R then
        QuickSortIndexed(I, R);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArray.Sort(aCompare: TDynArraySortCompare);
begin
  SortRange(0,Count-1,aCompare);
  fSorted := true;
end;

procedure QuickSortPtr(L, R: PtrInt; Compare: TDynArraySortCompare; V: PPointerArray);
var I, J, P: PtrInt;
    tmp: pointer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      while Compare(V[I], V[P])<0 do
        inc(I);
      while Compare(V[J], V[P])>0 do
        dec(J);
      if I <= J then begin
        tmp := V[I];
        V[I] := V[J];
        V[J] := tmp;
        if P = I then P := J else
        if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if J - L < R - I then begin // use recursion only for smaller range
      if L < J then
        QuickSortPtr(L, J, Compare, V);
      L := I;
    end else begin
      if I < R then
        QuickSortPtr(I, R, Compare, V);
      R := J;
    end;
  until L >= R;
end;

procedure TDynArray.SortRange(aStart, aStop: integer; aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
begin
  if aStop<=aStart then
    exit; // nothing to sort
  if @aCompare=nil then
    Quicksort.Compare := @fCompare else
    Quicksort.Compare := aCompare;
  if (@Quicksort.Compare<>nil) and (fValue<>nil) and (fValue^<>nil) then
    if ElemSize=SizeOf(pointer) then
      QuickSortPtr(aStart,aStop,QuickSort.Compare,fValue^) else begin
      Quicksort.Value := fValue^;
      Quicksort.ElemSize := ElemSize;
      Quicksort.QuickSort(aStart,aStop);
    end;
end;

procedure TDynArray.Sort(const aCompare: TEventDynArraySortCompare; aReverse: boolean);
var QuickSort: TDynArrayQuickSort;
    R: PtrInt;
begin
  if not Assigned(aCompare) or (fValue = nil) or (fValue^=nil) then
    exit; // nothing to sort
  Quicksort.CompareEvent := aCompare;
  Quicksort.Value := fValue^;
  Quicksort.ElemSize := ElemSize;
  R := Count-1;
  if aReverse then
    Quicksort.QuickSortEventReverse(0,R) else
    Quicksort.QuickSortEvent(0,R);
end;

procedure TDynArray.CreateOrderedIndex(var aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
    n: integer;
begin
  if @aCompare=nil then
    Quicksort.Compare := @fCompare else
    Quicksort.Compare := aCompare;
  if (@QuickSort.Compare<>nil) and (fValue<>nil) and (fValue^<>nil) then begin
    n := GetCount;
    if length(aIndex)<n then begin
      SetLength(aIndex,n);
      FillIncreasing(pointer(aIndex),0,n);
    end;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := ElemSize;
    Quicksort.Index := pointer(aIndex);
    Quicksort.QuickSortIndexed(0,n-1);
  end;
end;

procedure TDynArray.CreateOrderedIndex(out aIndex: TSynTempBuffer;
  aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
    n: integer;
begin
  if @aCompare=nil then
    Quicksort.Compare := @fCompare else
    Quicksort.Compare := aCompare;
  if (@QuickSort.Compare<>nil) and (fValue<>nil) and (fValue^<>nil) then begin
    n := GetCount;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := ElemSize;
    Quicksort.Index := PCardinalArray(aIndex.InitIncreasing(n));
    Quicksort.QuickSortIndexed(0,n-1);
  end else
    aIndex.buf := nil; // avoid GPF in aIndex.Done
end;

procedure TDynArray.CreateOrderedIndexAfterAdd(var aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare);
var ndx: integer;
begin
  ndx := GetCount-1;
  if ndx<0 then
    exit;
  if aIndex<>nil then begin // whole FillIncreasing(aIndex[]) for first time
    if ndx>=length(aIndex) then
      SetLength(aIndex,NextGrow(ndx)); // grow aIndex[] if needed
    aIndex[ndx] := ndx;
  end;
  CreateOrderedIndex(aIndex,aCompare);
end;

function TDynArray.ElemEquals(const A,B): boolean;
begin
  if @fCompare<>nil then
    result := fCompare(A,B)=0 else
    if ElemType=nil then
      case ElemSize of // optimized versions for arrays of common types
        1: result := byte(A)=byte(B);
        2: result := word(A)=word(B);
        4: result := cardinal(A)=cardinal(B);
        8: result := Int64(A)=Int64(B);
      else result := CompareMemFixed(@A,@B,ElemSize); // binary comparison
      end else
      if PTypeKind(ElemType)^ in tkRecordTypes then // most likely
        result := RecordEquals(A,B,ElemType) else
        result := ManagedTypeCompare(@A,@B,ElemType)>0; // other complex types
end;

{$ifndef DELPHI5OROLDER} // disabled for Delphi 5 buggy compiler
procedure TDynArray.InitFrom(const aAnother: TDynArray; var aValue);
begin
  self := aAnother;
  fValue := @aValue;
  fCountP := nil;
end;

procedure TDynArray.AddDynArray(const aSource: TDynArray; aStartIndex: integer;
  aCount: integer);
var SourceCount: integer;
begin
  if (aSource.fValue<>nil) and (ArrayType=aSource.ArrayType) then begin
    SourceCount := aSource.Count;
    if (aCount<0) or (aCount>SourceCount) then
      aCount := SourceCount; // force use of external Source.Count, if any
    AddArray(aSource.fValue^,aStartIndex,aCount);
  end;
end;

function TDynArray.Equals(const B: TDynArray; ignorecompare: boolean): boolean;
var i, n: integer;
    P1,P2: PAnsiChar;
    A1: PPointerArray absolute P1;
    A2: PPointerArray absolute P2;
  function HandleObjArray: boolean;
  var tmp1,tmp2: RawUTF8;
  begin
    SaveToJSON(tmp1);
    B.SaveToJSON(tmp2);
    result := tmp1=tmp2;
  end;
begin
  result := false;
  if ArrayType<>B.ArrayType then
    exit; // array types should match exactly
  n := GetCount;
  if n<>B.Count then
    exit;
  if GetIsObjArray then begin
    result := HandleObjArray;
    exit;
  end;
  P1 := fValue^;
  P2 := B.fValue^;
  if (@fCompare<>nil) and not ignorecompare then // use customized comparison
    for i := 1 to n do
      if fCompare(P1^,P2^)<>0 then
        exit else begin
        inc(P1,ElemSize);
        inc(P2,ElemSize);
      end else
  if ElemType=nil then begin // binary type is compared as a whole
    result := CompareMem(P1,P2,ElemSize*cardinal(n));
    exit;
  end else
  case PTypeKind(ElemType)^ of // some optimized versions for most used types
  tkLString{$ifdef FPC},tkLStringOld{$endif}:
    for i := 0 to n-1 do
      if AnsiString(A1^[i])<>AnsiString(A2^[i]) then
        exit;
  tkWString:
    for i := 0 to n-1 do
      if WideString(A1^[i])<>WideString(A2^[i]) then
        exit;
  {$ifdef HASVARUSTRING}
  tkUString:
    for i := 0 to n-1 do
      if UnicodeString(A1^[i])<>UnicodeString(A2^[i]) then
        exit;
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    for i := 1 to n do
      if not RecordEquals(P1^,P2^,ElemType) then
        exit else begin
        inc(P1,ElemSize);
        inc(P2,ElemSize);
      end;
  else // generic TypeInfoCompare() use
    for i := 1 to n do
      if ManagedTypeCompare(P1,P2,ElemType)<=0 then
        exit else begin // A^<>B^ or unexpected type
        inc(P1,ElemSize);
        inc(P2,ElemSize);
      end;
  end;
  result := true;
end;

procedure TDynArray.Copy(const Source: TDynArray; ObjArrayByRef: boolean);
var n: Cardinal;
begin
  if (fValue=nil) or (ArrayType<>Source.ArrayType) then
    exit;
  if (fCountP<>nil) and (Source.fCountP<>nil) then
    SetCapacity(Source.Capacity);
  n := Source.Count;
  SetCount(n);
  if n<>0 then
    if ElemType=nil then
      if not ObjArrayByRef and GetIsObjArray then
        LoadFromJSON(pointer(Source.SaveToJSON)) else
        {$ifdef FPC}Move{$else}MoveFast{$endif}(Source.fValue^^,fValue^^,n*ElemSize) else
      CopyArray(fValue^,Source.fValue^,ElemType,n);
end;

procedure TDynArray.CopyFrom(const Source; MaxElem: integer; ObjArrayByRef: boolean);
var SourceDynArray: TDynArray;
begin
  SourceDynArray.Init(fTypeInfo,pointer(@Source)^);
  SourceDynArray.fCountP := @MaxElem; // would set Count=0 at Init()
  Copy(SourceDynArray,ObjArrayByRef);
end;

procedure TDynArray.CopyTo(out Dest; ObjArrayByRef: boolean);
var DestDynArray: TDynArray;
begin
  DestDynArray.Init(fTypeInfo,Dest);
  DestDynArray.Copy(self,ObjArrayByRef);
end;
{$endif DELPHI5OROLDER}

function TDynArray.IndexOf(const Elem): PtrInt;
var P: pointer;
    PP: PPointerArray absolute P;
    max: PtrInt;
begin
  if fValue=nil then begin
    result := -1;
    exit; // avoid GPF if void
  end;
  max := GetCount-1;
  P := fValue^;
  if @Elem<>nil then
  if ElemType=nil then
    case ElemSize of
      // optimized versions for arrays of byte,word,integer,Int64,Currency,Double
      1: for result := 0 to max do
           if PByteArray(P)^[result]=byte(Elem) then exit;
      2: for result := 0 to max do
           if PWordArray(P)^[result]=word(Elem) then exit;
      4: for result := 0 to max do // integer,single,32bitPointer
           if PIntegerArray(P)^[result]=integer(Elem) then exit;
      8: for result := 0 to max do // Int64,Currency,Double,64bitPointer
           if PInt64Array(P)^[result]=Int64(Elem) then exit;
    else // generic binary comparison (fast with our overloaded CompareMemFixed)
      for result := 0 to max do
        if CompareMemFixed(P,@Elem,ElemSize) then
          exit else
          inc(PByte(P),ElemSize);
    end else
  case PTypeKind(ElemType)^ of
  tkLString{$ifdef FPC},tkLStringOld{$endif}:
    for result := 0 to max do
      if AnsiString(PP^[result])=AnsiString(Elem) then exit;
  tkWString:
    for result := 0 to max do
      if WideString(PP^[result])=WideString(Elem) then exit;
  {$ifdef HASVARUSTRING}
  tkUString:
    for result := 0 to max do
      if UnicodeString(PP^[result])=UnicodeString(Elem) then exit;
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant:
    for result := 0 to max do
      if SortDynArrayVariantComp(PVarDataStaticArray(P)^[result],
        TVarData(Elem),false)=0 then exit;
  {$endif}
  tkRecord{$ifdef FPC},tkObject{$endif}:
    // RecordEquals() works with packed records containing binary and string types
    for result := 0 to max do
      if RecordEquals(P^,Elem,ElemType) then
        exit else
        inc(PByte(P),ElemSize);
  tkInterface:
    for result := 0 to max do
      if PP^[result]=pointer(Elem) then exit;
  else
    for result := 0 to max do
      if ManagedTypeCompare(P,@Elem,ElemType)>0 then
        exit else
        inc(PByte(P),ElemSize);
  end;
  result := -1;
end;

procedure TDynArray.Init(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil);
begin
  fValue := @aValue;
  fTypeInfo := aTypeInfo;
  if PTypeKind(aTypeInfo)^<>tkDynArray then // inlined GetTypeInfo()
    raise ESynException.CreateUTF8('TDynArray.Init: % is %, expected tkDynArray',
      [PShortString(@PTypeInfo(aTypeInfo)^.NameLen)^,ToText(PTypeKind(aTypeInfo)^)^]);
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  aTypeInfo := GetFPCAlignPtr(aTypeInfo);
  {$else}
  inc(PByte(aTypeInfo),PTypeInfo(aTypeInfo)^.NameLen);
  {$endif}
  fElemSize := PTypeInfo(aTypeInfo)^.elSize {$ifdef FPC}and $7FFFFFFF{$endif};
  fElemType := PTypeInfo(aTypeInfo)^.elType;
  if fElemType<>nil then begin
    {$ifndef HASDIRECTTYPEINFO}
    // FPC compatibility: if you have a GPF here at startup, your 3.1 trunk
    // revision seems older than June 2016
    // -> enable HASDIRECTTYPEINFO conditional below $ifdef VER3_1 in Synopse.inc
    // or in your project's options
    fElemType := PPointer(fElemType)^; // inlined DeRef()
    {$endif}
    {$ifdef FPC}
    if not (PTypeKind(fElemType)^ in tkManagedTypes) then
      fElemType := nil; // as with Delphi
    {$endif}
  end;
  fCountP := aCountPointer;
  if fCountP<>nil then
    fCountP^ := 0;
  fCompare := nil;
  fParser := DYNARRAY_PARSERUNKNOWN;
  fKnownSize := 0;
  fSorted := false;
  fKnownType := djNone;
  fIsObjArray := oaUnknown;
end;

procedure TDynArray.InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
  aCountPointer: PInteger; aCaseInsensitive: boolean);
var Comp: TDynArraySortCompare;
begin
  Init(aTypeInfo,aValue,aCountPointer);
  Comp := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,aKind];
  if @Comp=nil then
    raise ESynException.CreateUTF8('TDynArray.InitSpecific(%) wrong aKind=%',
      [PShortString(@PTypeInfo(aTypeInfo)^.NameLen)^,ToText(aKind)^]);
  fCompare := Comp;
  fKnownType := aKind;
  fKnownSize := KNOWNTYPE_SIZE[aKind];
end;

procedure TDynArray.UseExternalCount(var aCountPointer: Integer);
begin
  fCountP := @aCountPointer;
end;

function TDynArray.HasCustomJSONParser: boolean;
begin
  if fParser=DYNARRAY_PARSERUNKNOWN then
    fParser := GlobalJSONCustomParsers.DynArraySearch(ArrayType,ElemType);
  result := cardinal(fParser)<cardinal(GlobalJSONCustomParsers.fParsersCount);
end;

procedure TDynArray.Void;
begin
  fValue := nil;
end;

function TDynArray.IsVoid: boolean;
begin
  result := fValue=nil;
end;

function TDynArray.ComputeIsObjArray: boolean;
begin
  result := (fElemSize=SizeOf(pointer)) and (fElemType=nil) and
     Assigned(DynArrayIsObjArray) and (DynArrayIsObjArray(fTypeInfo)<>nil);
  if result then
    fIsObjArray := oaTrue else
    fIsObjArray := oaFalse;
end;

procedure TDynArray.SetIsObjArray(aValue: boolean);
begin
  if aValue then
    fIsObjArray := oaTrue else
    fIsObjArray := oaFalse;
end;

procedure TDynArray.InternalSetLength(NewLength: PtrUInt);
var p: PDynArrayRec;
    OldLength, NeededSize, minLength: PtrUInt;
    pp: pointer;
    i: integer;
begin // this method is faster than default System.DynArraySetLength() function
  // check that new array length is not just a finalize in disguise
  if NewLength=0 then begin
    {$ifndef NOVARIANTS} // faster clear of custom variant uniformous array
    if ArrayType=TypeInfo(TVariantDynArray) then begin
      VariantDynArrayClear(TVariantDynArray(fValue^));
      exit;
    end;
    {$endif}
    if GetIsObjArray then
      ObjArrayClear(fValue^);
    {$ifdef FPC}FPCDynArrayClear{$else}_DynArrayClear{$endif}(fValue^,ArrayType);
    exit;
  end;
  // calculate the needed size of the resulting memory structure on heap
  NeededSize := NewLength*ElemSize+SizeOf(TDynArrayRec);
  {$ifndef CPU64}
  if NeededSize>1024*1024*1024 then // max workable memory block is 1 GB
    raise ERangeError.CreateFmt('TDynArray SetLength(%s,%d) size concern',
      [ArrayTypeShort^,NewLength]);
  {$endif}
  // if not shared (refCnt=1), resize; if shared, create copy (not thread safe)
  p := fValue^;
  if p=nil then begin
    p := AllocMem(NeededSize);
    OldLength := NewLength; // no FillcharFast() below
  end else begin
    dec(PtrUInt(p),SizeOf(TDynArrayRec)); // p^ = start of heap object
    OldLength := p^.length;
    if OldLength=NewLength then
      exit; // nothing to resize
    if p^.refCnt=1 then begin
      if NewLength<OldLength then // reduce array in-place
        if ElemType<>nil then // release managed types in trailing items
          {$ifdef FPC}FPCFinalizeArray{$else}_FinalizeArray{$endif}(
            PAnsiChar(p)+NeededSize,ElemType,OldLength-NewLength) else
          if GetIsObjArray then begin // FreeAndNil() of resized objects list
            for i := NewLength to OldLength-1 do
              PObjectArray(fValue^)^[i].Free;
            {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(
              PAnsiChar(p)[NeededSize],(OldLength-NewLength) shl POINTERSHR,0);
          end;
      ReallocMem(p,NeededSize);
    end else begin // make copy
      InterlockedDecrement(PInteger(@p^.refCnt)^); // FPC has refCnt: PtrInt
      GetMem(p,NeededSize);
      minLength := oldLength;
      if minLength>newLength then
        minLength := newLength;
      pp := PAnsiChar(p)+SizeOf(TDynArrayRec);
      if ElemType<>nil then begin
        {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(pp^,minLength*elemSize,0);
        CopyArray(pp,fValue^,ElemType,minLength);
      end else
        {$ifdef FPC}Move{$else}MoveFast{$endif}(fValue^^,pp^,minLength*elemSize);
    end;
  end;
  // set refCnt=1 and new length to the heap memory structure
  with p^ do begin
    refCnt := 1;
    {$ifdef FPC}
    high := newLength-1;
    {$else}
    length := newLength;
    {$endif}
  end;
  inc(PByte(p),SizeOf(p^)); // p^ = start of dynamic aray items
  fValue^ := p;
  // reset new allocated elements content to zero
  if NewLength>OldLength then begin
    OldLength := OldLength*elemSize;
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(
      PAnsiChar(p)[OldLength],NewLength*ElemSize-OldLength,0);
  end;
end;

procedure TDynArray.SetCount(aCount: integer);
const MINIMUM_SIZE = 64;
var c, v, capa, delta: PtrInt;
begin
  v := PtrInt(fValue);
  c := PtrInt(fCountP);
  fSorted := false;
  if v=0 then
    exit; // avoid GPF if void
  if c<>0 then begin // handle external capacity with separated Count
    delta := aCount-PInteger(c)^;
    if delta=0 then
      exit;
    PInteger(c)^ := aCount; // store new length
    v := PPtrInt(v)^;
    if v=0 then begin
      // no capa yet
      if (delta>0) and (aCount<MINIMUM_SIZE) then
        aCount := MINIMUM_SIZE; // reserve some minimal (64) items for Add()
    end else begin
      {$ifdef FPC}
      capa := PDynArrayRec(v-SizeOf(TDynArrayRec))^.high+1;
      {$else}
      capa := PInteger(v-SizeOf(PtrInt))^;
      {$endif}
      if delta>0 then begin
        // size-up -> grow by chunks
        c := PInteger(c)^;
        if capa>=c then
          exit; // no need to grow
        capa := NextGrow(capa);
        if capa<c then
          aCount := c else
          aCount := capa;
      end else  // SetCount(0) from TDynArray.Clear
      if (aCount>0) and ((fIsObjArray=oaFalse) or
         ((fIsObjArray=oaUnknown) and not ComputeIsObjArray)) then
        // size-down -> only if worth it (for faster Delete)
        if (capa<=MINIMUM_SIZE) or (capa-aCount<capa shr 3) then
          exit;
    end;
  end;
  // no external Count, array size-down or array up-grow -> realloc
  InternalSetLength(aCount);
end;

function TDynArray.GetCapacity: integer;
begin // capacity = length(DynArray)
  if (fValue<>nil) and (PtrUInt(fValue^)<>0) then
    result := PDynArrayRec(PtrUInt(fValue^)-SizeOf(TDynArrayRec))^.length else
    result := 0;
end;

procedure TDynArray.SetCapacity(aCapacity: integer);
begin
  if fValue=nil then
    exit; // avoid GPF if void
  if fCountP<>nil then
    if fCountP^>aCapacity then
      fCountP^ := aCapacity;
  InternalSetLength(aCapacity);
end;

procedure TDynArray.SetCompare(const aCompare: TDynArraySortCompare);
begin
  if @aCompare<>@fCompare then begin
    @fCompare := @aCompare;
    fSorted := false;
  end;
end;

procedure TDynArray.Slice(var Dest; aCount, aFirstIndex: cardinal);
var n: Cardinal;
    D: PPointer;
    P: PAnsiChar;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := GetCount;
  if aFirstIndex>=n then
    aCount := 0 else
  if aCount>=n-aFirstIndex then
    aCount := n-aFirstIndex;
  DynArray(ArrayType,Dest).InternalSetLength(aCount);
  D := @Dest;
  if aCount>0 then begin
    P := PAnsiChar(fValue^)+aFirstIndex*ElemSize;
    if ElemType=nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,D^^,aCount*ElemSize) else
      CopyArray(D^,P,ElemType,aCount);
  end;
end;

function TDynArray.AddArray(const DynArrayVar; aStartIndex, aCount: integer): integer;
var c, n: integer;
    PS,PD: pointer;
begin
  result := 0;
  if fValue=nil then
    exit; // avoid GPF if void
  c := DynArrayLength(pointer(DynArrayVar));
  if aStartIndex>=c then
    exit; // nothing to copy
  if (aCount<0) or (cardinal(aStartIndex+aCount)>cardinal(c)) then
    aCount := c-aStartIndex;
  if aCount<=0 then
    exit;
  result := aCount;
  n := GetCount;
  SetCount(n+aCount);
  PS := pointer(PtrUInt(DynArrayVar)+cardinal(aStartIndex)*ElemSize);
  PD := pointer(PtrUInt(fValue^)+cardinal(n)*ElemSize);
  if ElemType=nil then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(PS^,PD^,cardinal(aCount)*ElemSize) else
    CopyArray(PD,PS,ElemType,aCount);
end;

procedure TDynArray.ElemClear(var Elem);
begin
  if @Elem=nil then
    exit; // avoid GPF
  if ElemType<>nil then
    {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(@Elem,ElemType) else
    if (fIsObjArray=oaTrue) or ((fIsObjArray=oaUnknown) and ComputeIsObjArray) then
      TObject(Elem).Free;
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(Elem,ElemSize,0); // always
end;

function TDynArray.ElemLoad(Source: PAnsiChar): RawByteString;
begin
  if (Source<>nil) and (ElemType=nil) then
    SetString(result,Source,ElemSize) else begin
    SetString(result,nil,ElemSize);
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(pointer(result)^,ElemSize,0);
    ElemLoad(Source,pointer(result)^);
  end;
end;

procedure TDynArray.ElemLoadClear(var ElemTemp: RawByteString);
begin
  ElemClear(pointer(ElemTemp));
  ElemTemp := '';
end;

procedure TDynArray.ElemLoad(Source: PAnsiChar; var Elem);
begin
  if Source<>nil then // avoid GPF
    if ElemType=nil then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Source^,Elem,ElemSize) else
      ManagedTypeLoad(@Elem,Source,ElemType);
end;

function TDynArray.ElemSave(const Elem): RawByteString;
var itemsize: integer;
begin
  if ElemType=nil then
    SetString(result,PAnsiChar(@Elem),ElemSize) else begin
    SetString(result,nil,ManagedTypeSaveLength(@Elem,ElemType,itemsize));
    if result<>'' then
      ManagedTypeSave(@Elem,pointer(result),ElemType,itemsize);
  end;
end;

function TDynArray.ElemLoadFind(Source: PAnsiChar): integer;
var tmp: array[0..2047] of byte;
    data: pointer;
begin
  result := -1;
  if (Source=nil) or (ElemSize>SizeOf(tmp)) then
    exit;
  if ElemType=nil then
    data := Source else begin
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(tmp,ElemSize,0);
    ManagedTypeLoad(@tmp,Source,ElemType);
    if Source=nil then
      exit;
    data := @tmp;
  end;
  try
    if @fCompare=nil then
      result := IndexOf(data^) else
      result := Find(data^);
  finally
    if ElemType<>nil then
      {$ifdef FPC}FPCFinalize{$else}_Finalize{$endif}(data,ElemType);
  end;
end;

function DynArray(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil): TDynArray;
begin
  result.Init(aTypeInfo,aValue,aCountPointer);
end;


{ TDynArrayHashed }

const
  // marks a void entry in the hash table
  // -> code below will replace all hash value from 0 (HASH_VOID)
  // to 1 (HASH_ONVOIDCOLISION)
  HASH_VOID = 0;
  // marks a hash colision with a void entry in the hash table
  HASH_ONVOIDCOLISION = 1;
  // fHashsCount<=HASH_PO2 is expected to be a power of two (fast binary division)
  // -> 262,144 TSynHash slots = 2MB, for a TDynArray.Capacity of 131,072 items
  HASH_PO2 = 1 shl 18;

{$ifdef UNDIRECTDYNARRAY}

function TDynArrayHashed.GetCount: Integer;
begin
  result := InternalDynArray.GetCount;
end;
procedure TDynArrayHashed.SetCount(aCount: integer);
begin
  InternalDynArray.SetCount(aCount);
end;
function TDynArrayHashed.GetCapacity: Integer;
begin
  result := InternalDynArray.Capacity;
end;
procedure TDynArrayHashed.SetCapacity(aCapacity: Integer);
begin
  InternalDynArray.SetCapacity(aCapacity);
end;
function TDynArrayHashed.Value: PPointer;
begin
  result := InternalDynArray.Value;
end;
function TDynArrayHashed.ElemSize: PtrUInt;
begin
  result := InternalDynArray.ElemSize;
end;
function TDynArrayHashed.ElemType: Pointer;
begin
  result := InternalDynArray.ElemType;
end;
procedure TDynArrayHashed.ElemCopy(const A; var B);
begin
  InternalDynArray.ElemCopy(A,B);
end;
function TDynArrayHashed.ElemPtr(index: PtrInt): pointer;
begin
  result := InternalDynArray.ElemPtr(index);
end;
procedure TDynArrayHashed.ElemCopyAt(index: PtrInt; var Dest);
begin
  InternalDynArray.ElemCopyAt(index,Dest);
end;
function TDynArrayHashed.KnownType: TDynArrayKind;
begin
  result := InternalDynArray.KnownType;
end;
procedure TDynArrayHashed.Clear;
begin
  InternalDynArray.Clear;
end;
function TDynArrayHashed.Add(const Elem): integer;
begin
  result := InternalDynArray.Add(Elem);
end;
procedure TDynArrayHashed.Delete(aIndex: PtrInt);
begin
  InternalDynArray.Delete(aIndex);
end;
function TDynArrayHashed.SaveTo: RawByteString;
begin
  result := InternalDynArray.SaveTo;
end;
function TDynArrayHashed.LoadFrom(Source: PAnsiChar): PAnsiChar;
begin
  result := InternalDynArray.LoadFrom(Source);
end;
function TDynArrayHashed.SaveTo(Dest: PAnsiChar): PAnsiChar;
begin
  result := InternalDynArray.SaveTo(Dest);
end;
function TDynArrayHashed.SaveToJSON(EnumSetsAsText: boolean;
  reformat: TTextWriterJSONFormat): RawUTF8;
begin
  result := InternalDynArray.SaveToJSON(EnumSetsAsText,reformat);
end;
procedure TDynArrayHashed.Sort(aCompare: TDynArraySortCompare);
begin
  InternalDynArray.Sort(aCompare);
end;
function TDynArrayHashed.LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil): PUTF8Char;
begin
  result := InternalDynArray.LoadFromJSON(P,aEndOfObject);
end;
function TDynArrayHashed.SaveToLength: integer;
begin
  result := InternalDynArray.SaveToLength;
end;

{$endif UNDIRECTDYNARRAY}

function TDynArrayHashed.Scan(const Elem): integer;
var P: PAnsiChar;
    n: integer;
begin
  if Assigned(fEventCompare) then begin
    P := Value^; // Count<fHashCountTrigger -> O(n) is faster than O(1)
    n := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}GetCount;
    for result := 0 to n-1 do
      if fEventCompare(P^,Elem)=0 then
        exit else
        inc(P,ElemSize);
    result := -1;
  end else
    result := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}Find(Elem);
end;

function TDynArrayHashed.FindHashed(const Elem; aHashCode: cardinal): integer;
begin
  if (fHashs<>nil) and Assigned(fHashElement) then begin
    if aHashCode=0 then
      aHashCode := fHashElement(Elem,fHasher);
    result := HashFindAndCompare(aHashCode,Elem);
    if result<0 then
      result := -1; // for coherency with most methods
  end else begin // Count<fHashCountTrigger
    if Assigned(fEventCompare) then
      result := Scan(Elem) else
      result := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}Find(Elem);
    if (result>=0) and (fHashCountTrigger>0) and
       ({$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCountP<>nil) and
       ({$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCountP^>4) then begin
      inc(fHashFindCount);
      if fHashFindCount>=fHashCountTrigger*2 then begin
        fHashCountTrigger := 0; // FindHashed() should use O(1) hash
        ReHash;
      end;
    end;
  end;
end;

procedure TDynArrayHashed.HashAdd(const Elem; aHashCode: Cardinal; var result: integer);
var n,cap: integer;
begin
  n := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}GetCount;
  SetCount(n+1); // reserve space for a void element in array
  cap := Capacity;
  if cap*2-cap shr 3>=fHashsCount then
  {$ifdef UNDIRECTDYNARRAY}with InternalDynArray do{$endif} begin
    // fHashs[] is too small -> recreate
    if fCountP<>nil then
      dec(fCountP^); // ignore latest entry (which is not filled yet)
    ReHash;
    if fCountP<>nil then
      inc(fCountP^);
    result := HashFind(aHashCode,true); // fHashs[] has changed -> recompute
    assert(result<0);
  end;
  with fHashs[-result-1] do begin // HashFind returned negative index in fHashs[]
    Hash := aHashCode;
    Index := n;
  end;
  result := n;
end;

function TDynArrayHashed.FindHashedForAdding(const Elem; out wasAdded: boolean;
  aHashCode: cardinal): integer;
var n: integer;
begin
  n := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}GetCount;
  if n<fHashCountTrigger then begin
    if Assigned(fEventCompare) then
      result := Scan(Elem) else
      result := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}Find(Elem);
    if result<0 then begin
      SetCount(n+1); // reserve space for added item, as in HashAdd()
      result := n;
      wasadded := true;
    end else
      wasadded := false;
    exit;
  end;
  if fHashs=nil then
    ReHash(true); // compute hash of all previously added fHashCountTrigger items
  if (aHashCode=0) and Assigned(fHashElement) then
    aHashCode := fHashElement(Elem,fHasher);
  if aHashCode=HASH_VOID then
    aHashCode := HASH_ONVOIDCOLISION; // as in HashFind() -> for HashAdd() below
  result := HashFindAndCompare(aHashCode,Elem);
  if result>=0 then
    // found matching existing item
    wasAdded := false else begin
    // create a void element
    HashAdd(Elem,aHashCode,result);
    wasAdded := true;
  end;
end;

function TDynArrayHashed.AddAndMakeUniqueName(aName: RawUTF8): pointer;
var ndx,j: integer;
    added: boolean;
    aName_: RawUTF8;
begin
  if aName='' then
    aName := '_';
  ndx := FindHashedForAdding(aName,added);
  if not added then begin // force unique column name
    aName_ := aName+'_';
    j := 1;
    repeat
      aName := aName_+UInt32ToUTF8(j);
      ndx := FindHashedForAdding(aName,added);
      inc(j);
    until added;
  end;
  result := PAnsiChar(Value^)+cardinal(ndx)*ElemSize;
  PRawUTF8(result)^ := aName; // store unique name at 1st elem position
end;

function TDynArrayHashed.AddUniqueName(const aName: RawUTF8;
  const ExceptionMsg: RawUTF8; const ExceptionArgs: array of const): pointer;
var ndx: integer;
    added: boolean;
begin
  ndx := FindHashedForAdding(aName,added);
  if added then begin
    result := PAnsiChar(Value^)+cardinal(ndx)*ElemSize;
    PRawUTF8(result)^ := aName; // store unique name at 1st elem position
  end else
    if ExceptionMsg='' then
      raise ESynException.CreateUTF8('Duplicated "%" name',[aName]) else
      raise ESynException.CreateUTF8(ExceptionMsg,ExceptionArgs);
end;

function TDynArrayHashed.FindHashedAndFill(var ElemToFill): integer;
begin
  if fHashs=nil then // Count<fHashCountTrigger
    result := Scan(ElemToFill) else
    if Assigned(fHashElement) then begin
      result := HashFindAndCompare(fHashElement(ElemToFill,fHasher),ElemToFill);
      if result<0 then
        result := -1;
    end else
      result := -1;
  if result>=0 then
    ElemCopy((PAnsiChar(Value^)+cardinal(result)*ElemSize)^,ElemToFill);
end;

function TDynArrayHashed.FindHashedAndUpdate(const Elem; AddIfNotExisting: boolean): integer;
var aHashCode: cardinal;
label h;
begin
  if fHashs=nil then begin // Count<fHashCountTrigger
    result := Scan(Elem);
    if result<0 then
      if AddIfNotExisting then
        if Count<fHashCountTrigger then
          result := Add(Elem) else begin
          ReHash; // compute hash of all previously added fHashCountTrigger items
          goto h;
        end else
        result := -1 else
      ElemCopy(Elem,(PAnsiChar(Value^)+cardinal(result)*ElemSize)^); // update
    exit;
  end;
h:if Assigned(fHashElement) then begin
    aHashCode := fHashElement(Elem,fHasher);
    if aHashCode=HASH_VOID then
      aHashCode := HASH_ONVOIDCOLISION; // as in HashFind() -> for HashAdd() below
    result := HashFindAndCompare(aHashCode,Elem);
    if result<0 then
      if AddIfNotExisting then begin
        // not existing -> add as new element
        HashAdd(Elem,aHashCode,result); // ReHash only if necessary
        ElemCopy(Elem,(PAnsiChar(Value^)+cardinal(result)*ElemSize)^);
      end else
        result := -1 else begin
      // copy from Elem into dynamic array found entry = Update
      ElemCopy(Elem,(PAnsiChar(Value^)+cardinal(result)*ElemSize)^);
      ReHash; // whole hash table should be re-created for next search
    end;
  end else
    result := -1;
end;

function TDynArrayHashed.FindHashedAndDelete(const Elem): integer;
begin
  if fHashs=nil then begin // Count<fHashCountTrigger
    result := Scan(Elem);
    if result>=0 then
      Delete(result);
  end else
  if Assigned(fHashElement) then begin
    result := HashFindAndCompare(fHashElement(Elem,fHasher),Elem);
    if result<0 then
      result := -1 else begin
      Delete(result);
      ReHash; // whole hash table should be re-created for next search
    end;
  end else
    result := -1;
end;

function HashAnsiString(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)<>0 then
    result := Hasher(0,Pointer(PtrUInt(Elem)),{$ifdef FPC}_LStrLenP(pointer(Elem))
      {$else}PInteger(PtrUInt(Elem)-SizeOf(integer))^{$endif}) else
    result := HASH_ONVOIDCOLISION;
end;

function HashAnsiStringI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,tmp,UpperCopy255Buf(tmp,pointer(Elem),
      {$ifdef FPC}_LStrLenP(pointer(Elem))
      {$else}PInteger(PtrUInt(Elem)-SizeOf(integer))^{$endif})-tmp);
end;

{$ifdef UNICODE}

function HashUnicodeString(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,Pointer(Elem),length(UnicodeString(Elem))*2);
end;

function HashUnicodeStringI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,tmp,UpperCopy255W(tmp,Pointer(Elem),length(UnicodeString(Elem)))-tmp);
end;

{$endif UNICODE}

function HashSynUnicode(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,Pointer(Elem),length(SynUnicode(Elem))*2);
end;

function HashSynUnicodeI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,tmp,UpperCopy255W(tmp,SynUnicode(Elem))-tmp);
end;

function HashWideString(const Elem; Hasher: THasher): cardinal;
begin // WideString internal size is in bytes, not WideChar
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,Pointer(Elem),Length(WideString(Elem))*2);
end;

function HashWideStringI(const Elem; Hasher: THasher): cardinal;
var tmp: array[byte] of AnsiChar; // avoid slow heap allocation
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,tmp,UpperCopy255W(tmp,pointer(Elem),Length(WideString(Elem)))-tmp);
end;

function HashPtrUInt(const Elem; Hasher: THasher): cardinal;
begin
  {$ifdef CPU64}
  result := Hasher(0,@Elem,SizeOf(PtrUInt));
  {$else}
  result := (PtrUInt(Elem) shr 4)+1; // naive but optimal for TDynArrayHashed
  {$endif}
end;

function HashPointer(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(pointer));
end;

function HashByte(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(byte));
end;

function HashWord(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(word));
end;

function HashInteger(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(integer));
end;

function HashInt64(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(Int64));
end;

function Hash128(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(THash128));
end;

function Hash256(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(THash256));
end;

function Hash512(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,SizeOf(THash512));
end;

{$ifndef NOVARIANTS}

function VariantHash(const value: variant; CaseInsensitive: boolean;
  Hasher: THasher): cardinal;
var Up: array[byte] of AnsiChar; // avoid heap allocation
  procedure ComplexType;
  var tmp: RawUTF8;
  begin // slow but always working conversion to string
    VariantSaveJSON(value,twNone,tmp);
    if CaseInsensitive then
      result := Hasher(TVarData(value).VType,Up,UpperCopy255(Up,tmp)-Up) else
      result := Hasher(TVarData(value).VType,pointer(tmp),length(tmp));
  end;
begin
  if not Assigned(Hasher) then
    Hasher := @crc32c;
  with TVarData(value) do
  case VType of
    varNull, varEmpty:
      result := VType+2; // not 0 (HASH_VOID) nor 1 (HASH_ONVOIDCOLISION)
    varShortInt, varByte:
      result := Hasher(VType,@VByte,1);
    varSmallint, varWord, varBoolean:
      result := Hasher(VType,@VWord,2);
    varLongWord, varInteger, varSingle:
      result := Hasher(VType,@VLongWord,4);
    varInt64, varDouble, varDate, varCurrency, varWord64:
      result := Hasher(VType,@VInt64,SizeOf(Int64));
    varString:
      if CaseInsensitive then
        result := Hasher(0,Up,UpperCopy255Buf(Up,VString,length(RawUTF8(VString)))-Up) else
        result := Hasher(0,VString,length(RawUTF8(VString)));
    varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}:
      if CaseInsensitive then
        result := Hasher(0,Up,UpperCopy255W(Up,VOleStr,StrLenW(VOleStr))-Up) else
        result := Hasher(0,VAny,StrLenW(VOleStr)*2);
  else
    ComplexType;
  end;
end;

function HashVariant(const Elem; Hasher: THasher): cardinal;
begin
  result := VariantHash(variant(Elem),false,Hasher);
end;

function HashVariantI(const Elem; Hasher: THasher): cardinal;
begin
  result := VariantHash(variant(Elem),true,Hasher);
end;

{$endif NOVARIANTS}

procedure TDynArrayHashed.InitSpecific(aTypeInfo: pointer; var aValue;
  aKind: TDynArrayKind; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
var Comp: TDynArraySortCompare;
    Hasher: TDynArrayHashOne;
begin
  Comp := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,aKind];
  Hasher := DYNARRAY_HASHFIRSTFIELD[aCaseInsensitive,aKind];
  if (@Hasher=nil) or (@Comp=nil) then
    raise ESynException.CreateUTF8('TDynArrayHashed.InitSpecific unsupported %',
      [ToText(aKind)^]);
  Init(aTypeInfo,aValue,Hasher,Comp,nil,aCountPointer,aCaseInsensitive);
  {$ifdef UNDIRECTDYNARRAY}with InternalDynArray do{$endif} begin
    fKnownType := aKind;
    fKnownSize := KNOWNTYPE_SIZE[aKind];
  end;
end;

procedure TDynArrayHashed.Init(aTypeInfo: pointer; var aValue;
  aHashElement: TDynArrayHashOne; aCompare: TDynArraySortCompare;
  aHasher: THasher; aCountPointer: PInteger; aCaseInsensitive: boolean);
var aKind: TDynArrayKind;
begin
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$else}inherited{$endif}
    Init(aTypeInfo,aValue,aCountPointer);
  fEventCompare := nil;
  fEventHash := nil;
  if @aHasher=nil then
    fHasher := DefaultHasher else
    fHasher := aHasher;
  if (@aHashElement=nil) or (@aCompare=nil) then begin
    // it's faster to retrieve now the hashing/compare function than in HashOne
    aKind := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}ToKnownType;
    if @aHashElement=nil then
      aHashElement := DYNARRAY_HASHFIRSTFIELD[aCaseInsensitive,aKind];
    if @aCompare=nil then
      aCompare := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,aKind];
  end;
  fHashElement := aHashElement;
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare := aCompare;
  fHashCountTrigger := 32;
  fHashs := nil; // = HashInvalidate;
  fHashFindCount := 0;
end;

procedure TDynArrayHashed.HashInvalidate;
begin
  fHashs := nil;
  fHashFindCount := 0;
end;

//var TDynArrayHashedCollisionCount: cardinal;

function TDynArrayHashed.HashFind(aHashCode: cardinal; aForAdd: boolean): integer;
var first,last: integer;
    h: cardinal;
    P: PAnsiChar;
begin
  if fHashs=nil then begin // Count=0 or Count<fHashCountTrigger
    if Assigned(fHashElement) then begin
      P := Value^;
      for result := 0 to Count-1 do begin
        h := fHashElement(P^,fHasher);
        if h=HASH_VOID then
          h := HASH_ONVOIDCOLISION;
        if h=aHashCode then
          exit else
          inc(P,ElemSize);
      end;
    end;
    result := -1;
    exit;
  end;
  if aHashCode=HASH_VOID then
    aHashCode := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
  if fHashsCount<=HASH_PO2 then // fHashs[] has a power of 2 length -> binary div
    result := (aHashCode-1) and (fHashsCount-1) else
    result := (aHashCode-1) mod cardinal(fHashsCount);
  last := fHashsCount;
  first := result;
  repeat
    with fHashs[result] do
      if (Hash=aHashCode) and not aForAdd then begin
        result := Index;
        exit;
      end else
      if Hash=HASH_VOID then begin
        result := -(result+1);
        exit; // aForAdd or not found -> returns void index in fHashs[] as negative
      end;
    inc(result); // try next entry on hash collision
    if result=last then
      // reached the end -> search once from fHash[0] to fHash[first-1]
      if result=first then
        break else begin
        result := 0;
        last := first;
      end;
  until false;
  RaiseFatalCollision('HashFind',aHashCode);
end;

function TDynArrayHashed.HashFindAndCompare(aHashCode: cardinal; const Elem): integer;
var first,last: integer;
    P: PAnsiChar;
begin
  if fHashs=nil then begin // e.g. Count<fHashCountTrigger
    result := Scan(Elem);
    exit;
  end;
  if aHashCode=HASH_VOID then
    aHashCode := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
  if fHashsCount<=HASH_PO2 then // fHashs[] has a power of 2 length -> binary div
    result := (aHashCode-1) and (fHashsCount-1) else
    result := (aHashCode-1) mod cardinal(fHashsCount);
  last := fHashsCount;
  first := result;
  repeat
    with fHashs[result] do
    if Hash=aHashCode then begin
      P := PAnsiChar(Value^)+Index*ElemSize;
      if not Assigned(fEventCompare) then
        if @{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare<>nil then begin
          if {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare(P^,Elem)=0 then begin
            result := Index;
            exit; // found -> returns index in dynamic array
          end;
        end else begin
          if {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}ElemEquals(P^,Elem) then begin
            result := Index;
            exit; // found
          end;
        end else
        if fEventCompare(P^,Elem)=0 then begin
          result := Index;
          exit; // found
        end;
    end else
    if Hash=HASH_VOID then begin
      result := -(result+1);
      exit; // not found -> returns void index in fHashs[] as negative
    end;
    // fHashs[Hash mod fHashsCount].Hash collision -> search next item
    {$ifdef DYNARRAYHASHCOLLISIONCOUNT}
    inc(fHashFindCollisions);
    {$endif}
    //inc(TDynArrayHashedCollisionCount);
    inc(result);
    if result=last then
      // reached the end -> search once from fHash[0] to fHash[first-1]
      if result=first then
        break else begin
        result := 0;
        last := first;
      end;
  until false;
  RaiseFatalCollision('HashFindAndCompare',aHashCode);
end;

procedure TDynArrayHashed.RaiseFatalCollision(const caller: RawUTF8;
  aHashCode: cardinal);
begin
  {$ifdef UNDIRECTDYNARRAY}with InternalDynArray do{$endif}
  raise ESynException.CreateUTF8('TDynArrayHashed.% fatal collision: '+
    'aHashCode=% fHashsCount=% Count=% Capacity=% ArrayType=% fKnownType=%',
    [caller,CardinalToHexShort(aHashCode),fHashsCount,GetCount,GetCapacity,
     ArrayTypeShort^,ToText(fKnownType)^]);
end;

function TDynArrayHashed.GetHashFromIndex(aIndex: PtrInt): Cardinal;
var P: pointer;
begin
  if (cardinal(aIndex)>=cardinal(Count)) or
    (not Assigned(fHashElement) and not Assigned(fEventHash)) then
    result := 0 else begin
    // it's faster to rehash than to loop in fHashs[].Index values
    // and it will also work with Count<fHashCountTrigger
    P := PAnsiChar(Value^)+PtrUInt(aIndex)*ElemSize;
    if Assigned(fEventHash) then
      result := fEventHash(P^) else
      result := fHashElement(P^,fHasher);
    if result=HASH_VOID then
      result := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
  end;
end;

function TDynArrayHashed.IsHashElementWithoutCollision: integer;
var i,j: integer;
    h: cardinal;
begin
  if Count>0 then begin
    ReHash;
    for i := 0 to fHashsCount-1 do begin
      h := fHashs[i].Hash;
      if h=HASH_VOID then
        continue;
      result := fHashs[i].Index;
      for j := 0 to fHashsCount-1 do
        if (i<>j) and (fHashs[j].Hash=h) then
          exit; // found duplicate
    end;
  end;
  result := -1;
end;

function TDynArrayHashed.ReHash(forAdd: boolean): boolean;
var i, n, cap, ndx: integer;
    P: PAnsiChar;
    aHashCode: cardinal;
begin
  result := false;
  fHashs := nil;
  fHashsCount := 0;
  n := {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}GetCount;
  if not forAdd and ((n=0) or (n<fHashCountTrigger)) then
    exit; // hash only if needed, and avoid GPF after TDynArray.Clear (Count=0)
  if not Assigned(fEventHash) and not Assigned(fHashElement) then
    exit;
  cap := Capacity*2; // Capacity better than Count; *2 to have void slots
  if cap>HASH_PO2 then // slightly slower lookup, but much less memory use
    fHashsCount := cap else begin
    fHashsCount := 256; // find nearest power of two for fast binary division
    while fHashsCount<cap do
      fHashsCount := fHashsCount shl 1;
  end;
  SetLength(fHashs,fHashsCount); // fill all fHashs[]=HASH_VOID=0
  // fill fHashs[] from all existing items
  P := Value^;
  for i := 0 to n-1 do begin
    if Assigned(fEventHash) then
      aHashCode := fEventHash(P^) else
      aHashCode := fHashElement(P^,fHasher);
    if aHashCode=HASH_VOID then
      aHashCode := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
    ndx := HashFindAndCompare(aHashCode,P^);
    if ndx<0 then
      // >=0 means found exact duplicate of P^: shouldn't happen -> ignore
      with fHashs[-ndx-1] do begin
        Hash := aHashCode;
        Index := i;
      end;
    inc(P,ElemSize);
  end;
  result := true;
end;


{ TObjectDynArrayWrapper }

constructor TObjectDynArrayWrapper.Create(var aValue; aOwnObjects: boolean);
begin
  fValue := @aValue;
  fOwnObjects := aOwnObjects;
end;

destructor TObjectDynArrayWrapper.Destroy;
begin
  Clear;
  inherited;
end;

function TObjectDynArrayWrapper.Find(Instance: TObject): integer;
begin
  for result := 0 to fCount-1 do
    if TObjectDynArray(fValue^)[result]=Instance then
      exit;
  result := -1;
end;

function TObjectDynArrayWrapper.Add(Instance: TObject): integer;
var cap: integer;
begin
  cap := length(TObjectDynArray(fValue^));
  if cap<=fCount then
    SetLength(TObjectDynArray(fValue^),NextGrow(cap));
  result := fCount;
  TObjectDynArray(fValue^)[result] := Instance;
  inc(fCount);
end;

procedure TObjectDynArrayWrapper.Delete(Index: integer);
begin
  if cardinal(Index)>=cardinal(fCount) then
    exit; // avoid Out of range
  if fOwnObjects then
    TObjectDynArray(fValue^)[Index].Free;
  dec(fCount);
  if fCount>Index then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      TObjectDynArray(fValue^)[Index+1],TObjectDynArray(fValue^)[Index],
      (fCount-Index)*SizeOf(pointer));
end;

procedure TObjectDynArrayWrapper.Clear;
var i: integer;
begin
  if fValue^<>nil then begin
    if fOwnObjects then
      for i := fCount-1 downto 0 do
      try
        TObjectDynArray(fValue^)[i].Free;
      except
        on Exception do;
      end;
    TObjectDynArray(fValue^) := nil; // set capacity to 0
    fCount := 0;
  end else
    if fCount>0 then
      raise ESynException.Create('You MUST define your IObjectDynArray field '+
        'BEFORE the corresponding dynamic array');
end;

procedure TObjectDynArrayWrapper.Slice;
begin
  SetLength(TObjectDynArray(fValue^),fCount);
end;

function TObjectDynArrayWrapper.Count: integer;
begin
  result := fCount;
end;

function TObjectDynArrayWrapper.Capacity: integer;
begin
  result := length(TObjectDynArray(fValue^));
end;

procedure TObjectDynArrayWrapper.Sort(Compare: TDynArraySortCompare);
begin
  if (@Compare<>nil) and (fCount>0) then
    QuickSortPtr(0,fCount-1,Compare,fValue^);
end;

function NewSynLocker: PSynLocker;
begin
  result := AllocMem(SizeOf(result^));
  result^.Init;
end;

function PtrArrayAdd(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

function PtrArrayAddOnce(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
    n: integer;
begin
  n := length(a);
  result := PtrUIntScanIndex(pointer(a),n,PtrUInt(aItem));
  if result>=0 then
    exit;
  SetLength(a,n+1);
  a[n] := aItem;
  result := n;
end;

function PtrArrayDelete(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
    n: integer;
begin
  n := length(a);
  result := PtrUIntScanIndex(pointer(a),n,PtrUInt(aItem));
  if result<0 then
    exit;
  dec(n);
  if n>result then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      a[result+1],a[result],(n-result)*SizeOf(pointer));
  SetLength(a,n);
end;

function PtrArrayFind(var aPtrArray; aItem: pointer): integer;
var a: TPointerDynArray absolute aPtrArray;
begin
  result := PtrUIntScanIndex(pointer(a),length(a),PtrUInt(aItem));
end;

{ wrapper functions to T*ObjArr types }

function ObjArrayAdd(var aObjArray; aItem: TObject): PtrInt;
var a: TObjectDynArray absolute aObjArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

function ObjArrayAppend(var aDestObjArray, aSourceObjArray): PtrInt;
var n: PtrInt;
    s: TObjectDynArray absolute aSourceObjArray;
    d: TObjectDynArray absolute aDestObjArray;
begin
  result := length(d);
  n := length(s);
  SetLength(d,result+n);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(s[0],d[result],n*SizeOf(pointer));
  s := nil; // s[] will be owned by d[]
  inc(result,n);
end;

function ObjArrayAddCount(var aObjArray; aItem: TObject; var aObjArrayCount: integer): PtrInt;
var a: TObjectDynArray absolute aObjArray;
begin
  result := aObjArrayCount;
  if result=length(a) then
    SetLength(a,NextGrow(result));
  a[result] := aItem;
  inc(aObjArrayCount);
end;

procedure ObjArrayAddOnce(var aObjArray; aItem: TObject);
var a: TObjectDynArray absolute aObjArray;
    n: PtrInt;
begin
  n := length(a);
  if not PtrUIntScanExists(pointer(a),n,PtrUInt(aItem)) then begin
    SetLength(a,n+1);
    a[n] := aItem;
  end;
end;

procedure ObjArraySetLength(var aObjArray; aLength: integer);
begin
  SetLength(TObjectDynArray(aObjArray),aLength);
end;

function ObjArrayFind(const aObjArray; aItem: TObject): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aObjArray),
    length(TObjectDynArray(aObjArray)),PtrUInt(aItem));
end;

function ObjArrayCount(const aObjArray): integer;
var i: PtrInt;
    a: TObjectDynArray absolute aObjArray;
begin
  result := 0;
  for i := 0 to length(a)-1 do
    if a[i]<>nil then
      inc(result);
end;

procedure ObjArrayDelete(var aObjArray; aItemIndex: PtrInt;
  aContinueOnException: boolean);
var n: PtrInt;
    a: TObjectDynArray absolute aObjArray;
begin
  n := length(a);
  if cardinal(aItemIndex)>=cardinal(n) then
    exit; // out of range
  if aContinueOnException then
    try
      a[aItemIndex].Free;
    except
    end else
    a[aItemIndex].Free;
  dec(n);
  if n>aItemIndex then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      a[aItemIndex+1],a[aItemIndex],(n-aItemIndex)*SizeOf(TObject));
  SetLength(a,n);
end;

function ObjArrayDelete(var aObjArray; aItem: TObject): PtrInt;
begin
  result := ObjArrayFind(aObjArray,aItem);
  if result>=0 then
    ObjArrayDelete(aObjArray,result);
end;

procedure ObjArraySort(var aObjArray; Compare: TDynArraySortCompare);
begin
  if @Compare<>nil then
    QuickSortPtr(0,length(TObjectDynArray(aObjArray))-1,Compare,pointer(aObjArray));
end;

procedure RawObjectsClear(o: PObject; n: integer);
var i: integer;
begin
  for i := 1 to n do begin
    if o^<>nil then // inlined o^.Free
      o^.Destroy;
    inc(o);
  end;
end;

procedure ObjArrayClear(var aObjArray);
var a: TObjectDynArray absolute aObjArray;
begin
  if a=nil then
    exit;
  RawObjectsClear(pointer(aObjArray),length(a));
  a := nil;
end;

procedure ObjArrayClear(var aObjArray; aCount: integer);
var a: TObjectDynArray absolute aObjArray;
    n: integer;
begin
  n := length(a);
  if n=0 then
    exit;
  if n>aCount then
    aCount := n;
  RawObjectsClear(pointer(aObjArray),aCount);
  a := nil;
end;

procedure ObjArrayClear(var aObjArray; aContinueOnException: boolean);
var n,i: PtrInt;
    a: TObjectDynArray absolute aObjArray;
begin
  n := length(a);
  if n=0 then
    exit;
  if aContinueOnException then
    for i := 0 to n-1 do
    try
      a[i].Free;
    except
    end
  else
    RawObjectsClear(pointer(a),n);
  a := nil;
end;

function ObjArrayToJSON(const aObjArray; aOptions: TTextWriterWriteObjectOptions): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
  try
    if woEnumSetsAsText in aOptions then
      CustomOptions := CustomOptions+[twoEnumSetsAsTextInRecord];
    AddObjArrayJSON(aObjArray,aOptions);
    SetText(result);
  finally
    Free;
  end;
end;


procedure ObjArrayObjArrayClear(var aObjArray);
var i: PtrInt;
    a: TPointerDynArray absolute aObjArray;
begin
  if a<>nil then begin
    for i := 0 to length(a)-1 do
      ObjArrayClear(a[i]);
    a := nil;
  end;
end;

procedure ObjArraysClear(const aObjArray: array of pointer);
var i: PtrInt;
begin
  for i := 0 to high(aObjArray) do
    if aObjArray[i]<>nil then
      ObjArrayClear(aObjArray[i]^);
end;

{$ifndef DELPHI5OROLDER}

function InterfaceArrayAdd(var aInterfaceArray; const aItem: IUnknown): PtrInt;
var a: TInterfaceDynArray absolute aInterfaceArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

procedure InterfaceArrayAddOnce(var aInterfaceArray; const aItem: IUnknown);
var a: TInterfaceDynArray absolute aInterfaceArray;
    n: PtrInt;
begin
  if PtrUIntScanExists(pointer(aInterfaceArray),
     length(TInterfaceDynArray(aInterfaceArray)),PtrUInt(aItem)) then
    exit;
  n := length(a);
  SetLength(a,n+1);
  a[n] := aItem;
end;

function InterfaceArrayFind(const aInterfaceArray; const aItem: IUnknown): PtrInt;
begin
  result := PtrUIntScanIndex(pointer(aInterfaceArray),
    length(TInterfaceDynArray(aInterfaceArray)),PtrUInt(aItem));
end;

procedure InterfaceArrayDelete(var aInterfaceArray; aItemIndex: PtrInt);
var n: PtrInt;
    a: TInterfaceDynArray absolute aInterfaceArray;
begin
  n := length(a);
  if PtrUInt(aItemIndex)>=PtrUInt(n) then
    exit; // out of range
  a[aItemIndex] := nil;
  dec(n);
  if n>aItemIndex then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      a[aItemIndex+1],a[aItemIndex],(n-aItemIndex)*SizeOf(IInterface));
  TPointerDynArray(aInterfaceArray)[n] := nil; // avoid GPF in SetLength()
  SetLength(a,n);
end;

function InterfaceArrayDelete(var aInterfaceArray; const aItem: IUnknown): PtrInt;
begin
  result := InterfaceArrayFind(aInterfaceArray,aItem);
  if result>=0 then
    InterfaceArrayDelete(aInterfaceArray,result);
end;

{$endif DELPHI5OROLDER}


{ TObjectHash }

const
  COUNT_TO_START_HASHING = 16;

function TObjectHash.Find(Item: TObject): integer;
var n: integer;
begin
  n := Count;
  if n<=COUNT_TO_START_HASHING then
    result := Scan(Item,n) else
    result := HashFind(Hash(Item),Item);
end;

function TObjectHash.Scan(Item: TObject; ListCount: integer): integer;
begin
  for result := 0 to ListCount-1 do
    if Compare(Get(result),Item) then
      exit;
  result := -1;
end;

function TObjectHash.HashFind(aHashCode: cardinal; Item: TObject): integer;
var n, first: integer;
    looped: boolean;
begin
  looped := false;
  if fHashs=nil then
    HashInit(Count);
  n := length(fHashs);
  result := (aHashCode-1) and (n-1); // fHashs[] has a power of 2 length
  first := result;
  repeat
    with fHashs[result] do
    if Hash=aHashCode then begin
      if Compare(Get(Index),Item) then begin
        result := Index;
        exit; // found -> returns index in list
      end;
    end else
    if Hash=0 then begin
      result := -(result+1);
      exit; // not found -> returns void index in fHashs[] as negative
    end;
    // hash colision -> search next item
    inc(result);
    if result=n then
      // reached the end -> search once from fHash[0] to fHash[first-1]
      if looped then
        Break else begin
        result := 0;
        n := first;
        looped := true;
      end;
  until false;
  raise ESynException.CreateUTF8('%.HashFind fatal collision',[self]);
end;

procedure TObjectHash.HashInit(aCountToHash: integer);
var PO2,i,ndx: integer;
    H: cardinal;
    O: TObject;
begin
  assert(fHashs=nil);
  // find nearest power of two for new fHashs[] size
  PO2 := 256;
  while PO2<aCountToHash*2 do
    PO2 := PO2 shl 1;
  SetLength(fHashs,PO2);
  // hash all items
  for i := 0 to aCountToHash-1 do begin
    O := Get(i);
    H := Hash(O);
    ndx := HashFind(H,O);
    if ndx>=0 then
      raise ESynException.CreateUTF8('%.HashInit found dup at index %',[self,ndx]);
    with fHashs[-ndx-1] do begin
      Hash := H;
      Index := i;
    end;
  end;
end;

procedure TObjectHash.Invalidate;
begin
  fHashs := nil; // force HashInit call on next Find()
end;

function TObjectHash.EnsureJustAddedNotDuplicated: boolean;
var H: cardinal;
    lastNdx,ndx: integer;
    lastObject: TObject;
begin
  lastNdx := Count-1;
  lastObject := Get(lastNdx);
  if lastObject=nil then
    raise ESynException.CreateUTF8('Invalid %.EnsureJustAddedNotDuplicated call',[self]);
  if lastNdx<COUNT_TO_START_HASHING then begin
    result := Scan(lastObject,lastNdx)<0; // O(n) search if not worth it
    exit;
  end;
  if lastNdx*2-lastNdx shr 3>length(fHashs) then begin
    fHashs := nil;
    HashInit(lastNdx); // re-compute fHashs up to Count-1 if not enough void positions
  end;
  H := Hash(lastObject);
  ndx := HashFind(H,lastObject);
  if ndx>=0 then begin
    result := false; // duplicate found
    exit;
  end;
  with fHashs[-ndx-1] do begin
    Hash := H;
    Index := lastNdx;
  end;
  result := true; // last inserted item is OK
end;


{ TInterfacedObjectWithCustomCreate }

constructor TInterfacedObjectWithCustomCreate.Create;
begin // nothing to do by default - overridden constructor may add custom code
end;

procedure TInterfacedObjectWithCustomCreate.RefCountUpdate(Release: boolean);
begin
  if Release then
    _Release else
    _AddRef;
end;


{ TAutoLock }

type
  /// used by TAutoLocker.ProtectMethod and TSynLocker.ProtectMethod
  TAutoLock = class(TInterfacedObject)
  protected
    fLock: PSynLocker;
  public
    constructor Create(aLock: PSynLocker);
    destructor Destroy; override;
  end;

constructor TAutoLock.Create(aLock: PSynLocker);
begin
  fLock := aLock;
  fLock^.Lock;
end;

destructor TAutoLock.Destroy;
begin
  fLock^.UnLock;
end;


{ TSynLocker }

procedure TSynLocker.Init;
begin
  fSectionPadding := 0;
  InitializeCriticalSection(fSection);
  PaddingMaxUsedIndex := -1;
  fLocked := false;
  fInitialized := true;
end;

procedure TSynLocker.Done;
var i: integer;
begin
  for i := 0 to PaddingMaxUsedIndex do
    if Padding[i].VType<>varUnknown then
      VarClear(variant(Padding[i]));
  DeleteCriticalSection(fSection);
  fInitialized := false;
end;

procedure TSynLocker.DoneAndFreeMem;
begin
  Done;
  FreeMem(@self);
end;

procedure TSynLocker.Lock;
begin
  EnterCriticalSection(fSection);
  fLocked := true;
end;

procedure TSynLocker.UnLock;
begin
  fLocked := false;
  LeaveCriticalSection(fSection);
end;

function TSynLocker.TryLock: boolean;
begin
  result := not fLocked and
    (TryEnterCriticalSection(fSection){$ifdef LINUX}{$ifdef FPC}<>0{$endif}{$endif});
end;

function TSynLocker.TryLockMS(retryms: integer): boolean;
begin
  repeat
    result := TryLock;
    if result or (retryms <= 0) then
      break;
    SleepHiRes(1);
    dec(retryms);
  until false;
end;

function TSynLocker.ProtectMethod: IUnknown;
begin
  result := TAutoLock.Create(@self);
end;

{$ifndef NOVARIANTS}

function TSynLocker.GetVariant(Index: integer): Variant;
begin
  if (Index>=0) and (Index<=PaddingMaxUsedIndex) then // PaddingMaxUsedIndex may be -1
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      result := variant(Padding[Index]);
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    VarClear(result);
end;

procedure TSynLocker.SetVariant(Index: integer; const Value: Variant);
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if Index>PaddingMaxUsedIndex then
        PaddingMaxUsedIndex := Index;
      variant(Padding[Index]) := Value;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end;
end;

function TSynLocker.GetInt64(Index: integer): Int64;
begin
  if (Index>=0) and (Index<=PaddingMaxUsedIndex) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if not VariantToInt64(variant(Padding[index]),result) then
        result := 0;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := 0;
end;

procedure TSynLocker.SetInt64(Index: integer; const Value: Int64);
begin
  SetVariant(Index,Value);
end;

function TSynLocker.GetBool(Index: integer): boolean;
begin
  if (Index>=0) and (Index<=PaddingMaxUsedIndex) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if not VariantToBoolean(variant(Padding[index]),result) then
        result := false;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := false;
end;

procedure TSynLocker.SetBool(Index: integer; const Value: boolean);
begin
  SetVariant(Index,Value);
end;

function TSynLocker.GetUnLockedInt64(Index: integer): Int64;
begin
  if (Index<0) or (Index>PaddingMaxUsedIndex) or
     not VariantToInt64(variant(Padding[index]),result) then
    result := 0;
end;

procedure TSynLocker.SetUnlockedInt64(Index: integer; const Value: Int64);
begin
  if cardinal(Index)<=high(Padding) then begin
    if Index>PaddingMaxUsedIndex then
      PaddingMaxUsedIndex := Index;
    variant(Padding[Index]) := Value;
  end;
end;

function TSynLocker.GetPointer(Index: integer): Pointer;
begin
  if (Index>=0) and (Index<=PaddingMaxUsedIndex) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      with Padding[index] do
        if VType=varUnknown then
          result := VUnknown else
          result := nil;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := nil;
end;

procedure TSynLocker.SetPointer(Index: integer; const Value: Pointer);
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if Index>PaddingMaxUsedIndex then
        PaddingMaxUsedIndex := Index;
      with Padding[index] do begin
        if VType<>varUnknown then begin
          VarClear(PVariant(@VType)^);
          VType := varUnknown;
        end;
        VUnknown := Value;
      end;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end;
end;

function TSynLocker.GetUTF8(Index: integer): RawUTF8;
var wasString: Boolean;
begin
  if (Index>=0) and (Index<=PaddingMaxUsedIndex) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      VariantToUTF8(variant(Padding[Index]),result,wasString);
      if not wasString then
        result := '';
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := '';
end;

procedure TSynLocker.SetUTF8(Index: integer; const Value: RawUTF8);
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      if Index>PaddingMaxUsedIndex then
        PaddingMaxUsedIndex := Index;
      RawUTF8ToVariant(Value,Padding[Index],varString);
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end;
end;

function TSynLocker.LockedInt64Increment(Index: integer; const Increment: Int64): Int64;
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      result := 0;
      if Index<=PaddingMaxUsedIndex then
        VariantToInt64(variant(Padding[index]),result) else
        PaddingMaxUsedIndex := Index;
      variant(Padding[Index]) := Int64(result+Increment);
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := 0;
end;

function TSynLocker.LockedExchange(Index: integer; const Value: Variant): Variant;
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      with Padding[index] do begin
        if Index<=PaddingMaxUsedIndex then
          result := PVariant(@VType)^ else begin
          PaddingMaxUsedIndex := Index;
          VarClear(result);
        end;
        PVariant(@VType)^ := Value;
      end;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    VarClear(result);
end;

function TSynLocker.LockedPointerExchange(Index: integer; Value: pointer): pointer;
begin
  if cardinal(Index)<=high(Padding) then
    try
      EnterCriticalSection(fSection);
      fLocked := true;
      with Padding[index] do begin
        if Index<=PaddingMaxUsedIndex then
          if VType=varUnknown then
            result := VUnknown else begin
            VarClear(PVariant(@VType)^);
            result := nil;
          end else begin
          PaddingMaxUsedIndex := Index;
          result := nil;
        end;
        VType := varUnknown;
        VUnknown := Value;
      end;
    finally
      fLocked := false;
      LeaveCriticalSection(fSection);
    end else
    result := nil;
end;

{$endif NOVARIANTS}


{ TInterfacedObjectLocked }

constructor TInterfacedObjectLocked.Create;
begin
  inherited Create;
  fSafe := NewSynLocker;
end;

destructor TInterfacedObjectLocked.Destroy;
begin
  inherited Destroy;
  fSafe^.DoneAndFreeMem;
end;


{ TPersistentWithCustomCreate }

constructor TPersistentWithCustomCreate.Create;
begin // nothing to do by default - overridden constructor may add custom code
end;


{ TSynPersistent }

constructor TSynPersistent.Create;
begin // nothing to do by default - overridden constructor may add custom code
end;

procedure TSynPersistent.AssignError(Source: TSynPersistent);
var SourceName: string;
begin
  if Source <> nil then
    SourceName := Source.ClassName else
    SourceName := 'nil';
  raise EConvertError.CreateFmt('Cannot assign a %s to a %s', [SourceName, ClassName]);
end;

procedure TSynPersistent.AssignTo(Dest: TSynPersistent);
begin
  Dest.AssignError(Self);
end;

procedure TSynPersistent.Assign(Source: TSynPersistent);
begin
  if Source<>nil then
    Source.AssignTo(Self) else
    AssignError(nil);
end;

{$ifdef FPC_OR_PUREPASCAL}
class function TSynPersistent.NewInstance: TObject;
begin // bypass vmtIntfTable and vmt^.vInitTable (management operators)
  result := AllocMem(InstanceSize);   // will zero memory
  PPointer(result)^ := pointer(self); // store VMT
end;
{$else}
class function TSynPersistent.NewInstance: TObject;
asm
        push    eax  // class
        mov     eax, [eax].vmtInstanceSize
        push    eax  // size
        call    System.@GetMem
        pop     edx  // size
        push    eax  // self
        mov     cl, 0
        call    dword ptr[FillcharFast]
        pop     eax   // self
        pop     edx   // class
        mov     [eax], edx // store VMT
end; // TSynPersistent has no interface -> bypass vmtIntfTable

procedure TSynPersistent.FreeInstance;
asm
        push    ebx
        mov     ebx, eax
@loop:  mov     ebx, [ebx] // handle three VMT levels per iteration
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jz      @end
        mov     ebx, [ebx]
        mov     edx, [ebx].vmtInitTable
        mov     ebx, [ebx].vmtParent
        test    edx, edx
        jnz     @clr
        test    ebx, ebx
        jnz     @loop
@end:   pop     ebx
        jmp     System.@FreeMem
        // TSynPersistent has no TMonitor -> bypass TMonitor.Destroy(self)
        // BTW, TMonitor.Destroy is private, so unreachable
@clr:   push    offset @loop // parent has never any vmtInitTable -> @loop
        jmp     RecordClear // eax=self edx=typeinfo
end;
{$endif FPC_OR_PUREPASCAL}


{ TSynPersistentLock }

constructor TSynPersistentLock.Create;
begin
  inherited Create;
  fSafe := NewSynLocker;
end;

destructor TSynPersistentLock.Destroy;
begin
  inherited Destroy;
  fSafe^.DoneAndFreeMem;
end;


{ TObjectListSorted }

destructor TObjectListSorted.Destroy;
var i: integer;
begin
  for i := 0 to fCount-1 do
    fObjArray[i].Free;
  inherited;
end;

function TObjectListSorted.FastLocate(const Value; out Index: Integer): boolean;
var n, i, cmp: integer;
begin
  result := False;
  n := Count;
  if n=0 then // a void array is always sorted
    Index := 0 else begin
    dec(n);
    if Compare(fObjArray[n],Value)<0 then begin // already sorted
      Index := n+1; // returns false + last position index to insert
      exit;
    end;
    Index := 0;
    while Index<=n do begin // O(log(n)) binary search of the sorted position
      i := (Index+n) shr 1;
      cmp := Compare(fObjArray[i],Value);
      if cmp=0 then begin
        Index := i; // index of existing Elem
        result := True;
        exit;
      end else
        if cmp<0 then
          Index := i+1 else
          n := i-1;
    end;
    // Elem not found: returns false + the index where to insert
  end;
end;

procedure TObjectListSorted.InsertNew(Item: TSynPersistentLock;
  Index: integer);
begin
  if fCount=length(fObjArray) then
    SetLength(fObjArray,NextGrow(fCount));
  if cardinal(Index)<cardinal(fCount) then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      fObjArray[Index],fObjArray[Index+1],(fCount-Index)*SizeOf(TObject)) else
    Index := fCount;
  fObjArray[Index] := Item;
  inc(fCount);
end;

function TObjectListSorted.Delete(const Value): boolean;
var i: integer;
begin
  result := false;
  fSafe.Lock;
  try
    if FastLocate(Value,i) and (cardinal(i)<cardinal(fCount)) then begin
      fObjArray[i].Free;
      dec(fCount);
      if fCount>i then
        {$ifdef FPC}Move{$else}MoveFast{$endif}(
          fObjArray[i+1],fObjArray[i],(fCount-i)*SizeOf(TObject));
      result := true;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TObjectListSorted.FindLocked(const Value): pointer;
var i: integer;
begin
  result := nil;
  fSafe.Lock;
  try
    if FastLocate(Value,i) then begin
      result := fObjArray[i];
      TSynPersistentLock(result).Safe.Lock;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TObjectListSorted.FindOrAddLocked(const Value; out added: boolean): pointer;
var i: integer;
begin
  added := false;
  fSafe.Lock;
  try
    if not FastLocate(Value,i) then begin
      InsertNew(NewItem(Value),i);
      added := true;
    end;
    result := fObjArray[i];
    TSynPersistentLock(result).Safe.Lock;
  finally
    fSafe.UnLock;
  end;
end;


{ ****************** text buffer and JSON functions and classes ********* }

{ TTextWriter }

procedure TTextWriter.CancelLastChar;
begin
  if B>=fTempBuf then // Add() methods append at B+1
    dec(B);
end;

function TTextWriter.LastChar: AnsiChar;
begin
  if B>=fTempBuf then
    result := B^ else
    result := #0; // returns #0 if no char has been written yet
end;

procedure TTextWriter.CancelLastChar(aCharToCancel: AnsiChar);
begin
  if (B>=fTempBuf) and (B^=aCharToCancel) then
    dec(B);
end;

function TTextWriter.PendingBytes: PtrUInt;
begin
  result := B-fTempBuf+1;
end;

procedure TTextWriter.CancelLastComma;
begin
  if (B>=fTempBuf) and (B^=',') then
    dec(B);
end;

procedure TTextWriter.Add(Value: PtrInt);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if BEnd-B<=16 then
    FlushToStream;
  if PtrUInt(Value)<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    Len := {$ifdef FPC}_LStrLenP(P){$else}PInteger(P-4)^{$endif};
  end else begin
    P := StrInt32(@tmp[23],value);
    Len := @tmp[23]-P;
  end;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P[0],B[1],Len);
  inc(B,Len);
end;

procedure TTextWriter.AddCurr64(const Value: Int64);
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Len: PtrUInt;
begin
  if BEnd-B<=31 then
    FlushToStream;
  P := StrCurr64(@tmp[31],Value);
  Len := @tmp[31]-P;
  if Len>4 then
    if P[Len-1]='0' then
      if P[Len-2]='0' then
        if P[Len-3]='0' then
          if P[Len-4]='0' then
            dec(Len,5) else
            dec(Len,3) else
          dec(Len,2) else
        dec(Len);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P[0],B[1],Len);
  inc(B,Len);
end;

procedure TTextWriter.AddCurr64(const Value: currency);
begin
  AddCurr64(PInt64(@Value)^);
end;

procedure TTextWriter.AddTimeLog(Value: PInt64);
begin
  if BEnd-B<=31 then
    FlushToStream;
  inc(B,PTimeLogBits(Value)^.Text(B+1,true,'T'));
end;

procedure TTextWriter.AddUnixTime(Value: PInt64);
begin // inlined UnixTimeToDateTime()
  AddDateTime(Value^/SecsPerDay+UnixDateDelta);
end;

procedure TTextWriter.AddUnixMSTime(Value: PInt64; WithMS: boolean);
begin // inlined UnixMSTimeToDateTime()
  AddDateTime(Value^/MSecsPerDay+UnixDateDelta,WithMS);
end;

procedure TTextWriter.AddDateTime(Value: PDateTime; FirstChar: AnsiChar;
  QuoteChar: AnsiChar; WithMS: boolean);
begin
  if (Value^=0) and (QuoteChar=#0) then
    exit;
  if BEnd-B<=25 then
    FlushToStream;
  inc(B);
  if QuoteChar<>#0 then
    B^ := QuoteChar else
    dec(B);
  if Value^<>0 then begin
    inc(B);
    if trunc(Value^)<>0 then begin
      DateToIso8601PChar(Value^,B,true);
      inc(B,10);
    end;
    if frac(Value^)<>0 then begin
      TimeToIso8601PChar(Value^,B,true,FirstChar,WithMS);
      if WithMS then
        inc(B,13) else
        inc(B,9);
    end;
    dec(B);
  end;
  if QuoteChar<>#0 then begin
    inc(B);
    B^ := QuoteChar;
  end;
end;

procedure TTextWriter.AddDateTime(const Value: TDateTime; WithMS: boolean);
begin
  if Value=0 then
    exit;
  if BEnd-B<=23 then
    FlushToStream;
  inc(B);
  if trunc(Value)<>0 then begin
    DateToIso8601PChar(Value,B,true);
    inc(B,10);
  end;
  if frac(Value)<>0 then begin
    TimeToIso8601PChar(Value,B,true,'T',WithMS);
    if WithMS then
      inc(B,13) else
      inc(B,9);
  end;
  dec(B);
end;

procedure TTextWriter.AddDateTimeMS(const Value: TDateTime; Expanded: boolean;
  FirstTimeChar: AnsiChar; const TZD: RawUTF8);
var T: TSynSystemTime;
begin
  if Value=0 then
    exit;
  T.FromDateTime(Value);
  Add(DTMS_FMT[Expanded], [UInt4DigitsToShort(T.Year),
    UInt2DigitsToShortFast(T.Month),UInt2DigitsToShortFast(T.Day),FirstTimeChar,
    UInt2DigitsToShortFast(T.Hour),UInt2DigitsToShortFast(T.Minute),
    UInt2DigitsToShortFast(T.Second),UInt3DigitsToShort(T.MilliSecond),TZD]);
end;

procedure TTextWriter.AddU(Value: cardinal);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if BEnd-B<=24 then
    FlushToStream;
  if Value<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    Len := {$ifdef FPC}_LStrLenP(P){$else}PInteger(P-4)^{$endif};
  end else begin
    P := StrUInt32(@tmp[23],Value);
    Len := @tmp[23]-P;
  end;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P[0],B[1],Len);
  inc(B,Len);
end;

procedure TTextWriter.AddQ(Value: QWord);
var tmp: array[0..23] of AnsiChar;
    V: Int64Rec absolute Value;
    P: PAnsiChar;
    Len: integer;
begin
  if BEnd-B<=32 then
    FlushToStream;
  if (V.Hi=0) and (V.Lo<=high(SmallUInt32UTF8)) then begin
    P := pointer(SmallUInt32UTF8[V.Lo]);
    Len := {$ifdef FPC}_LStrLenP(P){$else}PInteger(P-4)^{$endif};
  end else begin
    P := StrUInt64(@tmp[23],Value);
    Len := @tmp[23]-P;
  end;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P[0],B[1],Len);
  inc(B,Len);
end;

procedure TTextWriter.AddQHex(Value: QWord);
begin
  AddBinToHexDisplayQuoted(@Value,SizeOf(Value));
end;

procedure TTextWriter.Add(Value: Extended; precision: integer; noexp: boolean);
var S: ShortString;
begin
  if Value=0 then
    Add('0') else begin
    if noexp then
      S[0] := AnsiChar(ExtendedToStringNoExp(S,Value,precision)) else
      S[0] := AnsiChar(ExtendedToString(S,Value,precision));
    case PInteger(@S)^ and $ffdfdfdf of // inlined ExtendedToStringNan()
      3+ord('N')shl 8+ord('A')shl 16+ord('N')shl 24:
        AddShort(JSON_NAN[seNan]);
      3+ord('I')shl 8+ord('N')shl 16+ord('F')shl 24,
      4+ord('+')shl 8+ord('I')shl 16+ord('N')shl 24:
        AddShort(JSON_NAN[seInf]);
      4+ord('-')shl 8+ord('I')shl 16+ord('N')shl 24:
        AddShort(JSON_NAN[seNegInf]);
    else
      AddNoJSONEscape(@S[1],ord(S[0]));
    end;
  end;
end;

procedure TTextWriter.AddDouble(Value: double; noexp: boolean);
begin
  if Value=0 then
    Add('0') else
    Add(Value,DOUBLE_PRECISION,noexp);
end;

procedure TTextWriter.AddSingle(Value: single; noexp: boolean);
begin
  if Value=0 then
    Add('0') else
    Add(Value,SINGLE_PRECISION,noexp);
end;

{$ifndef CPU64} // Add(Value: PtrInt) already implemented it
procedure TTextWriter.Add(Value: Int64);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if BEnd-B<=24 then
    FlushToStream;
  if Value<0 then begin
    P := StrUInt64(@tmp[23],-Value)-1;
    P^ := '-';
    Len := @tmp[23]-P;
  end else
  if Value<=high(SmallUInt32UTF8) then begin
    P := pointer(SmallUInt32UTF8[Value]);
    Len := {$ifdef FPC}_LStrLenP(P){$else}PInteger(P-4)^{$endif};
  end else begin
    P := StrUInt64(@tmp[23],Value);
    Len := @tmp[23]-P;
  end;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P[0],B[1],Len);
  inc(B,Len);
end;
{$endif CPU64}

procedure TTextWriter.Add(Value: boolean);
begin
  if Value then
    AddShort('true') else
    AddShort('false');
end;

procedure TTextWriter.AddFloatStr(P: PUTF8Char);
var L: cardinal;
begin
  L := StrLen(P);
  if (L=0) or (L>30) then
    Add('0') else begin
    if BEnd-B<=31 then
      FlushToStream;
    inc(B);
    if PWord(P)^=ord('-')+ord('.')shl 8 then begin
      PWord(B)^ := ord('-')+ord('0')shl 8; // '-.3' -> '-0.3'
      inc(B,2);
      inc(P);
      dec(L);
    end else
    if P^='.' then begin
      B^ := '0'; // '.5' -> '0.5'
      inc(B);
    end;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,B^,L);
    inc(B,L-1);
  end;
end;

procedure TTextWriter.Add(c: AnsiChar);
begin
  if B>=BEnd then
    FlushToStream;
  B[1] := c;
  inc(B);
end;

procedure TTextWriter.Add(c1, c2: AnsiChar);
begin
  if BEnd-B<=1 then
    FlushToStream;
  B[1] := c1;
  B[2] := c2;
  inc(B,2);
end;

procedure TTextWriter.Add({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} guid: TGUID);
begin
  if BEnd-B<=36 then
    FlushToStream;
  GUIDToText(B+1,@guid);
  inc(B,36);
end;

procedure TTextWriter.AddCR;
begin
  if BEnd-B<=1 then
    FlushToStream;
  PWord(B+1)^ := 13+10 shl 8; // CR + LF
  inc(B,2);
end;

procedure TTextWriter.AddEndOfLine(aLevel: TSynLogInfo=sllNone);
var i: integer;
begin
  if BEnd-B<=1 then
    FlushToStream;
  if twoEndOfLineCRLF in fCustomOptions then begin
    PWord(B+1)^ := 13+10 shl 8; // CR + LF
    inc(B,2);
  end else begin
    B[1] := #10; // LF
    inc(B);
  end;
  if fEchos<>nil then begin
    fEchoStart := EchoFlush;
    for i := length(fEchos)-1 downto 0 do // for MultiEventRemove() below
    try
      fEchos[i](self,aLevel,fEchoBuf);
    except // remove callback in case of exception during echoing in user code
      MultiEventRemove(fEchos,i);
    end;
    fEchoBuf := '';
  end;
end;

procedure TTextWriter.AddCRAndIndent;
var ntabs: cardinal;
begin
  if B^=#9 then
    exit; // we most probably just added an indentation level
  ntabs := fHumanReadableLevel;
  if ntabs>=cardinal(fTempBufSize) then
    exit; // avoid buffer overflow
  if BEnd-B<=Integer(ntabs)+1 then
    FlushToStream;
  PWord(B+1)^ := 13+10 shl 8; // CR + LF
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(B[3],ntabs,9); // #9=tab
  inc(B,ntabs+2);
end;

procedure TTextWriter.AddChars(aChar: AnsiChar; aCount: integer);
var n: integer;
begin
  repeat
    n := BEnd-B;
    if aCount<n then
      n := aCount else
      FlushToStream; // loop to avoid buffer overflow
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(B[1],n,ord(aChar));
    inc(B,n);
    dec(aCount,n);
  until aCount<=0;
end;

procedure TTextWriter.Add2(Value: integer);
begin
  if BEnd-B<=3 then
    FlushToStream;
  if cardinal(Value)>99 then
    PCardinal(B+1)^ := $3030+ord(',')shl 16 else     // '00,' if overflow
    PCardinal(B+1)^ := TwoDigitLookupW[Value]+ord(',')shl 16;
  inc(B,3);
end;

procedure TTextWriter.Add4(Value: integer);
begin
  if BEnd-B<=5 then
    FlushToStream;
  if cardinal(Value)>9999 then
    PCardinal(B+1)^ := $30303030 else // '0000,' if overflow
    YearToPChar(Value,B+1);
  inc(B,5);
  B^ := ',';
end;

procedure TTextWriter.AddCurrentLogTime(LocalTime: boolean);
var time: TSynSystemTime;
begin
  FromGlobalTime(LocalTime,time);
  time.AddLogTime(self);
end;

function Value3Digits(V: PtrUInt; P: PUTF8Char; W: PWordArray): PtrUInt;
  {$ifdef HASINLINE}inline;{$endif}
begin
  result := V div 100;
  PWord(P+1)^ := W[V-result*100];
  V := result;
  result := result div 10;
  P^ := AnsiChar(V-result*10+48);
end;

procedure TTextWriter.AddMicroSec(MS: cardinal);
var W: PWordArray;
begin // 00.000.000
  if BEnd-B<=17 then
    FlushToStream;
  B[3] := '.';
  B[7] := '.';
  inc(B);
  W := @TwoDigitLookupW;
  MS := Value3Digits(Value3Digits(MS,B+7,W),B+3,W);
  if MS>99 then
    MS := 99;
  PWord(B)^:= W[MS];
  inc(B,9);
end;

procedure TTextWriter.Add3(Value: integer);
begin
  if BEnd-B<=4 then
    FlushToStream;
  if cardinal(Value)>999 then
    PCardinal(B+1)^ := $303030 else // '0000,' if overflow
    PCardinal(B+1)^ := TwoDigitLookupW[Value div 10]+
      ord(Value mod 10+48)shl 16;
  inc(B,4);
  B^ := ',';
end;

procedure TTextWriter.AddCSVInteger(const Integers: array of Integer);
var i: integer;
begin
  if length(Integers)=0 then
    exit;
  for i := 0 to high(Integers) do begin
    Add(Integers[i]);
    Add(',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.AddCSVDouble(const Doubles: array of double);
var i: integer;
begin
  if length(Doubles)=0 then
    exit;
  for i := 0 to high(Doubles) do begin
    AddDouble(Doubles[i]);
    Add(',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.AddCSVUTF8(const Values: array of RawUTF8);
var i: integer;
begin
  if length(Values)=0 then
    exit;
  for i := 0 to high(Values) do begin
    Add('"');
    AddJSONEscape(pointer(Values[i]));
    Add('"',',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.AddCSVConst(const Values: array of const);
var i: integer;
begin
  if length(Values)=0 then
    exit;
  for i := 0 to high(Values) do begin
    AddJSONEscape(Values[i]);
    Add(',');
  end;
  CancelLastComma;
end;

procedure TTextWriter.Add(const Values: array of const);
var i: Integer;
begin
  for i := 0 to high(Values) do
    AddJSONEscape(Values[i]);
end;

procedure TTextWriter.WriteObject(Value: TObject; Options: TTextWriterWriteObjectOptions);
var i: integer;
begin
  if Value<>nil then
    if Value.InheritsFrom(Exception) then
      Add('{"%":"%"}',[Value.ClassType,Exception(Value).Message]) else
    if Value.InheritsFrom(TRawUTF8List) then
    with TRawUTF8List(Value) do begin
      self.Add('[');
      for i := 0 to Count-1 do begin
        self.Add('"');
        self.AddJSONEscape(pointer(fList[i]));
        self.Add('"',',');
      end;
      self.CancelLastComma;
      self.Add(']');
      exit;
    end else
    if Value.InheritsFrom(TStrings) then
    with TStrings(Value) do begin
      self.Add('[');
      for i := 0 to Count-1 do begin
        self.Add('"');
        {$ifdef UNICODE}
        self.AddJSONEscapeW(pointer(Strings[i]),Length(Strings[i]));
        {$else}
        self.AddJSONEscapeAnsiString(Strings[i]);
        {$endif}
        self.Add('"',',');
      end;
      self.CancelLastComma;
      self.Add(']');
      exit;
    end else
    if not(woFullExpand in Options) or
       not(Value.InheritsFrom(TList)
       {$ifndef LVCL} or Value.InheritsFrom(TCollection){$endif}) then
      Value := nil;
  if Value=nil then begin
    AddShort('null');
    exit;
  end;
  Add('{');
  AddInstanceName(Value,':');
  Add('[');
  if Value.InheritsFrom(TList) then
    for i := 0 to TList(Value).Count-1 do
      AddInstanceName(TList(Value).List[i],',')
  {$ifndef LVCL} else
  if Value.InheritsFrom(TCollection) then
    for i := 0 to TCollection(Value).Count-1 do
      AddInstanceName(TCollection(Value).Items[i],',') {$endif} ;
  CancelLastComma;
  Add(']','}');
end;

function TTextWriter.InternalJSONWriter: TTextWriter;
begin
  if fInternalJSONWriter=nil then
    fInternalJSONWriter := DefaultTextWriterJSONClass.CreateOwnedStream else
    fInternalJSONWriter.CancelAll;
  result := fInternalJSONWriter;
end;

procedure TTextWriter.AddJSONEscape(Source: TTextWriter);
begin
  if Source.fTotalFileSize=0 then
    AddJSONEscape(Source.fTempBuf,Source.B-Source.fTempBuf+1) else
    AddJSONEscape(Pointer(Source.Text),0);
end;

procedure TTextWriter.AddNoJSONEscape(Source: TTextWriter);
begin
  if Source.fTotalFileSize=0 then
    AddNoJSONEscape(Source.fTempBuf,Source.B-Source.fTempBuf+1) else
    AddNoJSONEscapeUTF8(Source.Text);
end;

procedure TTextWriter.AddRawJSON(const json: RawJSON);
begin
  if json='' then
    AddShort('null') else
    AddNoJSONEscape(pointer(json),length(json));
end;

procedure TTextWriter.WriteObjectAsString(Value: TObject;
  Options: TTextWriterWriteObjectOptions);
begin
  Add('"');
  InternalJSONWriter.WriteObject(Value,Options);
  AddJSONEscape(fInternalJSONWriter);
  Add('"');
end;

class procedure TTextWriter.RegisterCustomJSONSerializer(aTypeInfo: pointer;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
begin
  GlobalJSONCustomParsers.RegisterCallbacks(aTypeInfo,aReader,aWriter);
end;

class procedure TTextWriter.UnRegisterCustomJSONSerializer(aTypeInfo: pointer);
begin
  GlobalJSONCustomParsers.RegisterCallbacks(aTypeInfo,nil,nil);
end;

{$ifndef NOVARIANTS}
class procedure TTextWriter.RegisterCustomJSONSerializerForVariant(
  aClass: TCustomVariantType;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
begin // here we register TCustomVariantTypeClass info instead of TypeInfo()
  GlobalJSONCustomParsers.RegisterCallbacksVariant(aClass,aReader,aWriter);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerForVariantByType(aVarType: TVarType;
  aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
var aClass: TCustomVariantType;
begin
  if FindCustomVariantType(aVarType,aClass) then
    RegisterCustomJSONSerializerForVariant(aClass,aReader,aWriter);
end;
{$endif NOVARIANTS}

class function TTextWriter.RegisterCustomJSONSerializerFromText(aTypeInfo: pointer;
  const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
begin
  result := GlobalJSONCustomParsers.RegisterFromText(aTypeInfo,aRTTIDefinition);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromText(
  const aTypeInfoTextDefinitionPairs: array of const);
var n,i: integer;
    def: RawUTF8;
begin
  n := length(aTypeInfoTextDefinitionPairs);
  if (n=0) or (n and 1=1) then
    exit;
  n := n shr 1;
  if n=0 then
    exit;
  for i := 0 to n-1 do
    if (aTypeInfoTextDefinitionPairs[i*2].VType<>vtPointer) or
       not VarRecToUTF8IsString(aTypeInfoTextDefinitionPairs[i*2+1],def) then
      raise ESynException.Create('RegisterCustomJSONSerializerFromText[?]') else
      GlobalJSONCustomParsers.RegisterFromText(
        aTypeInfoTextDefinitionPairs[i*2].VPointer,def);
end;

class function TTextWriter.RegisterCustomJSONSerializerSetOptions(aTypeInfo: pointer;
  aOptions: TJSONCustomParserSerializationOptions; aAddIfNotExisting: boolean): boolean;
var ndx: integer;
begin
  result := false;
  if aTypeInfo=nil then
    exit;
  case PTypeKind(aTypeInfo)^ of
  tkRecord{$ifdef FPC},tkObject{$endif}:
    ndx := GlobalJSONCustomParsers.RecordSearch(aTypeInfo,aAddIfNotExisting);
  tkDynArray:
    ndx := GlobalJSONCustomParsers.DynArraySearch(aTypeInfo,nil,aAddIfNotExisting);
  else
    exit;
  end;
  if (ndx>=0) and
     (GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser<>nil) then begin
    GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser.Options := aOptions;
    result := true;
  end;
end;

class function TTextWriter.RegisterCustomJSONSerializerSetOptions(
  const aTypeInfo: array of pointer; aOptions: TJSONCustomParserSerializationOptions;
  aAddIfNotExisting: boolean): boolean;
var i: integer;
begin
  result := true;
  for i := 0 to high(aTypeInfo) do
    if not RegisterCustomJSONSerializerSetOptions(aTypeInfo[i],aOptions) then
      result := false;
end;

class function TTextWriter.RegisterCustomJSONSerializerFindParser(
  aTypeInfo: pointer; aAddIfNotExisting: boolean=false): TJSONRecordAbstract;
var ndx: integer;
begin
  result := nil;
  if aTypeInfo=nil then
    exit;
  case PTypeKind(aTypeInfo)^ of
  tkRecord{$ifdef FPC},tkObject{$endif}:
    ndx := GlobalJSONCustomParsers.RecordSearch(aTypeInfo,aAddIfNotExisting);
  tkDynArray:
    ndx := GlobalJSONCustomParsers.DynArraySearch(aTypeInfo,nil,aAddIfNotExisting);
  else
    exit;
  end;
  if ndx>=0 then
    result := GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser;
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(
  aTypeInfo: pointer; const aTypeName: RawUTF8);
begin
  JSONSerializerFromTextSimpleTypeAdd(aTypeName,aTypeInfo,0,0);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(
  const aTypeInfos: array of pointer);
var i: integer;
begin
  for i := 0 to high(aTypeInfos) do
    RegisterCustomJSONSerializerFromTextSimpleType(aTypeInfos[i],'');
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType(
  aTypeInfo: pointer; aDataSize, aFieldSize: integer);
begin
  JSONSerializerFromTextSimpleTypeAdd('',aTypeInfo,aDataSize,aFieldSize);
end;

class procedure TTextWriter.RegisterCustomJSONSerializerFromTextBinaryType(
  const aTypeInfoDataFieldSize: array of const);
var n,i: integer;
    s1,s2: Int64;
begin
  n := length(aTypeInfoDataFieldSize);
  if n mod 3=0 then
    for i := 0 to (n div 3)-1 do
    if (aTypeInfoDataFieldSize[i*3].VType<>vtPointer) or
       not VarRecToInt64(aTypeInfoDataFieldSize[i*3+1],s1) or
       not VarRecToInt64(aTypeInfoDataFieldSize[i*3+2],s2) then
      raise ESynException.CreateUTF8('RegisterCustomJSONSerializerFromTextBinaryType[%]',[i]) else
      JSONSerializerFromTextSimpleTypeAdd('',aTypeInfoDataFieldSize[i*3].VPointer,s1,s2);
end;

procedure TTextWriter.AddRecordJSON(const Rec; TypeInfo: pointer);
var customWriter: TDynArrayJSONCustomWriter;
begin
  if (self=nil) or (@Rec=nil) or (TypeInfo=nil) or
     not(PTypeKind(TypeInfo)^ in tkRecordTypes) then
    raise ESynException.CreateUTF8('Invalid %.AddRecordJSON(%)',[self,TypeInfo]);
  if GlobalJSONCustomParsers.RecordSearch(TypeInfo,customWriter,nil) then
    customWriter(self,Rec) else
    WrRecord(Rec,TypeInfo);
end;

procedure TTextWriter.AddVoidRecordJSON(TypeInfo: pointer);
var tmp: TBytes;
    info: PTypeInfo;
begin
  info := GetTypeInfo(TypeInfo,tkRecordKinds);
  if (self=nil) or (info=nil) then
    raise ESynException.CreateUTF8('Invalid %.AddVoidRecordJSON(%)',[self,TypeInfo]);
  SetLength(tmp,info^.recSize {$ifdef FPC}and $7FFFFFFF{$endif});
  AddRecordJSON(tmp[0],TypeInfo);
end;

{$ifndef NOVARIANTS}
procedure TTextWriter.AddVariant(const Value: variant; Escape: TTextWriterKind);
var CustomVariantType: TCustomVariantType;
begin
  with TVarData(Value) do
  case VType of
  varEmpty,
  varNull:     AddShort('null');
  varSmallint: Add(VSmallint);
  varShortInt: Add(VShortInt);
  varByte:     AddU(VByte);
  varWord:     AddU(VWord);
  varLongWord: AddU(VLongWord);
  varInteger:  Add(VInteger);
  varInt64:    Add(VInt64);
  varWord64:   AddQ(VInt64);
  varSingle:   AddSingle(VSingle);
  varDouble:   AddDouble(VDouble);
  varDate:     AddDateTime(@VDate,'T','"');
  varCurrency: AddCurr64(VInt64);
  varBoolean:  Add(VBoolean); // 'true'/'false'
  varVariant:  AddVariant(PVariant(VPointer)^,Escape);
  varString: begin
    if Escape=twJSONEscape then
      Add('"');
    {$ifdef HASCODEPAGE}
    AddAnyAnsiString(RawByteString(VString),Escape);
    {$else}  // VString is expected to be a RawUTF8
    Add(VString,length(RawUTF8(VString)),Escape);
    {$endif}
    if Escape=twJSONEscape then
      Add('"');
  end;
  varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
    if Escape=twJSONEscape then
      Add('"');
    AddW(VAny,0,Escape);
    if Escape=twJSONEscape then
      Add('"');
  end;
  else
  if VType=varVariant or varByRef then
    AddVariant(PVariant(VPointer)^,Escape) else
  if VType=varByRef or varString then begin
    if Escape=twJSONEscape then
      Add('"');
    {$ifdef HASCODEPAGE}
    AddAnyAnsiString(PRawByteString(VAny)^,Escape);
    {$else}  // VString is expected to be a RawUTF8
    Add(PPointer(VAny)^,length(PRawUTF8(VAny)^),Escape);
    {$endif}
    if Escape=twJSONEscape then
      Add('"');
  end else
  if {$ifdef HASVARUSTRING}(VType=varByRef or varUString) or {$endif}
     (VType=varByRef or varOleStr) then begin
    if Escape=twJSONEscape then
      Add('"');
    AddW(PPointer(VAny)^,0,Escape);
    if Escape=twJSONEscape then
      Add('"');
  end else
  if FindCustomVariantType(VType,CustomVariantType) then
    if CustomVariantType.InheritsFrom(TSynInvokeableVariantType) then
      TSynInvokeableVariantType(CustomVariantType).ToJson(self,Value,Escape) else
      GlobalJSONCustomParsers.VariantWrite(CustomVariantType,self,Value,Escape) else
    raise ESynException.CreateUTF8('%.AddVariant VType=%',[self,ord(VType)]);
  end;
end;
{$endif NOVARIANTS}

procedure TTextWriter.AddDynArrayJSON(var aDynArray: TDynArrayHashed);
begin
  AddDynArrayJson(PDynArray(@aDynArray)^);
end;

procedure TTextWriter.AddDynArrayJSON(aTypeInfo: pointer; const aValue);
var DynArray: TDynArray;
begin
  DynArray.Init(aTypeInfo,pointer(@aValue)^);
  AddDynArrayJSON(DynArray);
end;

procedure TTextWriter.AddDynArrayJSONAsString(aTypeInfo: pointer; var aValue);
begin
  Add('"');
  InternalJSONWriter.AddDynArrayJSON(aTypeInfo,aValue);
  AddJSONEscape(fInternalJSONWriter);
  Add('"');
end;

procedure TTextWriter.AddObjArrayJSON(const aObjArray; aOptions: TTextWriterWriteObjectOptions);
var i: integer;
    a: TObjectDynArray absolute aObjArray;
begin
  Add('[');
  for i := 0 to length(a)-1 do begin
    WriteObject(a[i],aOptions);
    Add(',');
  end;
  CancelLastComma;
  Add(']');
end;

procedure TTextWriter.AddTypedJSON(aTypeInfo: pointer; const aValue);
var max, i: Integer;
    PS: PShortString;
    customWriter: TDynArrayJSONCustomWriter;
    DynArray: TDynArray;
  procedure AddPS; overload;
  begin
    Add('"');
    if twoTrimLeftEnumSets in fCustomOptions then
      AddTrimLeftLowerCase(PS) else
      AddShort(PS^);
    Add('"');
  end;
  procedure AddPS(bool: boolean); overload;
  begin
    AddPS;
    Add(':');
    Add(bool);
  end;
begin
  case PTypeKind(aTypeInfo)^ of
    tkClass:
      WriteObject(TObject(aValue),[woFullExpand]);
    tkEnumeration:
      if twoEnumSetsAsBooleanInRecord in fCustomOptions then begin
        PS := GetEnumName(aTypeInfo,byte(aValue));
        AddPS(true);
      end else
      if twoEnumSetsAsTextInRecord in fCustomOptions then begin
        PS := GetEnumName(aTypeInfo,byte(aValue));
        AddPS;
      end else
        AddU(byte(aValue));
    tkSet:
      if GetSetInfo(aTypeInfo,max,PS) then
        if twoEnumSetsAsBooleanInRecord in fCustomOptions then begin
          Add('{');
          for i := 0 to max do begin
            AddPS(GetBitPtr(@aValue,i));
            Add(',');
            inc(PByte(PS),ord(PS^[0])+1); // next short string
          end;
          CancelLastComma;
          Add('}');
        end else
        if twoEnumSetsAsTextInRecord in fCustomOptions then begin
          Add('[');
          if (twoFullSetsAsStar in fCustomOptions) and
             GetAllBits(cardinal(aValue),max+1) then
            AddShort('"*"') else begin
            for i := 0 to max do begin
              if GetBitPtr(@aValue,i) then begin
                AddPS;
                Add(',');
              end;
              inc(PByte(PS),ord(PS^[0])+1); // next short string
            end;
            CancelLastComma;
          end;
          Add(']');
        end else
        if max<8 then
          AddU(byte(aValue)) else
        if max<16 then
          AddU(word(aValue)) else
        if max<32 then
          AddU(cardinal(aValue)) else
          Add(Int64(aValue))
      else AddShort('null');
    tkRecord{$ifdef FPC},tkObject{$endif}: // inlined AddRecordJSON()
      if GlobalJSONCustomParsers.RecordSearch(aTypeInfo,customWriter,nil) then
        customWriter(self,aValue) else
        WrRecord(aValue,aTypeInfo);
    tkDynArray: begin
      DynArray.Init(aTypeInfo,(@aValue)^);
      AddDynArrayJSON(DynArray);
    end;
{$ifndef NOVARIANTS}
    tkVariant:
      AddVariant(variant(aValue),twJSONEscape);
{$endif}
    else
      AddShort('null');
  end;
end;

function TTextWriter.AddJSONReformat(JSON: PUTF8Char;
  Format: TTextWriterJSONFormat; EndOfObject: PUTF8Char): PUTF8Char;
var objEnd: AnsiChar;
    Name,Value: PUTF8Char;
    NameLen,ValueLen: integer;
begin
  result := nil;
  if JSON=nil then
    exit;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  case JSON^ of
  '[': begin // array
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if JSON^=']' then begin
      Add('[');
      inc(JSON);
    end else begin
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
        AddCRAndIndent;
      inc(fHumanReadableLevel);
      Add('[');
      repeat
        if JSON=nil then
          exit;
        if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
          AddCRAndIndent;
        JSON := AddJSONReformat(JSON,Format,@objEnd);
        if objEnd=']' then
          break;
        Add(objEnd);
      until false;
      dec(fHumanReadableLevel);
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
        AddCRAndIndent;
    end;
    Add(']');
  end;
  '{': begin // object
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    Add('{');
    inc(fHumanReadableLevel);
    if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
      AddCRAndIndent;
    if JSON^='}' then
      repeat inc(JSON) until not(JSON^ in [#1..' ']) else
    repeat
      Name := GetJSONPropName(JSON,@NameLen);
      if Name=nil then
        exit;
      if (Format in [jsonUnquotedPropName,jsonUnquotedPropNameCompact]) and
         JsonPropNameValid(Name) then
        AddNoJSONEscape(Name,NameLen) else begin
        Add('"');
        AddJSONEscape(Name);
        Add('"');
      end;
      if Format in [jsonCompact,jsonUnquotedPropNameCompact] then
        Add(':') else
        Add(':',' ');
      if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
      JSON := AddJSONReformat(JSON,Format,@objEnd);
      if objEnd='}' then
        break;
      Add(objEnd);
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
        AddCRAndIndent;
    until false;
    dec(fHumanReadableLevel);
      if not (Format in [jsonCompact,jsonUnquotedPropNameCompact]) then
      AddCRAndIndent;
    Add('}');
  end;
  '"': begin // string
    Value := JSON;
    JSON := GotoEndOfJSONString(JSON);
    if JSON^<>'"' then
      exit;
    inc(JSON);
    AddNoJSONEscape(Value,JSON-Value);
  end;
  else begin // numeric or true/false/null
    Value := GetJSONField(JSON,result,nil,EndOfObject,@ValueLen); // let wasString=nil
    if Value=nil then
      AddShort('null') else begin
      while (ValueLen>0) and (Value[ValueLen-1]<=' ') do dec(ValueLen);
      AddNoJSONEscape(Value,ValueLen);
    end;
    exit;
  end;
  end;
  if JSON<>nil then begin
    if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if EndOfObject<>nil then
      EndOfObject^ := JSON^;
    if JSON^<>#0 then
      repeat inc(JSON) until not(JSON^ in [#1..' ']);
  end;
  result := JSON;
end;

function TTextWriter.AddJSONToXML(JSON: PUTF8Char; ArrayName: PUTF8Char=nil;
  EndOfObject: PUTF8Char=nil): PUTF8Char;
var objEnd: AnsiChar;
    Name,Value: PUTF8Char;
    n,c: integer;
begin
  result := nil;
  if JSON=nil then
    exit;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  case JSON^ of
  '[': begin
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if JSON^=']' then
      JSON := GotoNextNotSpace(JSON+1) else begin
      n := 0;
      repeat
        if JSON=nil then
          exit;
        Add('<');
        if ArrayName=nil then
          Add(n) else
          AddXmlEscape(ArrayName);
        Add('>');
        JSON := AddJSONToXML(JSON,nil,@objEnd);
        Add('<','/');
        if ArrayName=nil then
          Add(n) else
          AddXmlEscape(ArrayName);
        Add('>');
        inc(n);
      until objEnd=']';
    end;
  end;
  '{': begin
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if JSON^='}' then
      repeat inc(JSON) until not(JSON^ in [#1..' ']) else
      repeat
        Name := GetJSONPropName(JSON);
        if Name=nil then
          exit;
        if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
        if JSON^='[' then // arrays are written as list of items, without root
          JSON := AddJSONToXML(JSON,Name,@objEnd) else begin
          Add('<');
          AddXmlEscape(Name);
          Add('>');
          JSON := AddJSONToXML(JSON,Name,@objEnd);
          Add('<','/');
          AddXmlEscape(Name);
          Add('>');
        end;
      until objEnd='}';
  end;
  else begin
    Value := GetJSONField(JSON,result,nil,EndOfObject); // let wasString=nil
    if Value=nil then
      AddShort('null') else begin
      c := PInteger(Value)^ and $ffffff;
      if (c=JSON_BASE64_MAGIC) or (c=JSON_SQLDATE_MAGIC) then
        inc(Value,3); // just ignore the Magic codepoint encoded as UTF-8
      AddXmlEscape(Value);
    end;
    exit;
  end;
  end;
  if JSON<>nil then begin
    if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
    if EndOfObject<>nil then
      EndOfObject^ := JSON^;
    if JSON^<>#0 then
      repeat inc(JSON) until not(JSON^ in [#1..' ']);
  end;
  result := JSON;
end;

procedure TTextWriter.AddDynArrayJSON(var aDynArray: TDynArray);
var i,n: integer;
    P: Pointer;
    T: TDynArrayKind;
    tmp: RawByteString;
    customWriter: TDynArrayJSONCustomWriter;
    customParser: TJSONRecordAbstract;
    nested: TDynArray;
    hr: boolean;
begin // code below must match TDynArray.LoadFromJSON
  n := aDynArray.Count-1;
  if n<0 then begin
    Add('[',']');
    exit;
  end;
  if aDynArray.HasCustomJSONParser then
    with GlobalJSONCustomParsers.fParser[aDynArray.fParser] do begin
      customWriter := Writer;
      customParser := RecordCustomParser;
    end else begin
      customWriter := nil;
      customParser := nil;
    end;
  if Assigned(customWriter) then
    T := djCustom else
    T := aDynArray.ToKnownType({exacttype=}true);
  P := aDynArray.fValue^;
  Add('[');
  case T of
  djNone:
    if (aDynArray.ElemType<>nil) and
       (PTypeKind(aDynArray.ElemType)^=tkDynArray) then begin
      for i := 0 to n do begin
        nested.Init(aDynArray.ElemType,P^);
        AddDynArrayJSON(nested);
        Add(',');
        inc(PByte(P),aDynArray.ElemSize);
      end;
    end else begin
      tmp := aDynArray.SaveTo;
      WrBase64(pointer(tmp),length(tmp),{withMagic=}true);
    end;
  djCustom: begin
      if customParser=nil then
        hr := false else
        hr := soWriteHumanReadable in customParser.Options;
      if hr then
        Inc(fHumanReadableLevel);
      for i := 0 to n do begin
        customWriter(self,P^);
        Add(',');
        inc(PByte(P),aDynArray.ElemSize);
      end;
      if hr then begin
        dec(fHumanReadableLevel);
        CancelLastComma;
        AddCRAndIndent;
      end;
    end;
  {$ifndef NOVARIANTS}
  djVariant:
    for i := 0 to n do begin
      AddVariant(PVariantArray(P)^[i],twJSONEscape);
      Add(',');
    end;
  {$endif}
  djRawByteString:
    for i := 0 to n do begin
      WrBase64(PPointerArray(P)^[i],Length(PRawByteStringArray(P)^[i]),{withMagic=}true);
      Add(',');
    end;
  djTimeLog..djString,djWideString..djInterface: // add textual JSON content
    for i := 0 to n do begin
      Add('"');
      case T of
      djTimeLog:    AddTimeLog(@PInt64Array(P)^[i]);
      djDateTime:   AddDateTime(@PDoubleArray(P)^[i],'T',#0,false);
      djDateTimeMS: AddDateTime(@PDoubleArray(P)^[i],'T',#0,true);
      djRawUTF8:    AddJSONEscape(PPointerArray(P)^[i]);
      djWideString, djSynUnicode: AddJSONEscapeW(PPointerArray(P)^[i]);
      djWinAnsi: AddAnyAnsiString(PRawByteStringArray(P)^[i],twJSONEscape,CODEPAGE_US);
      djString:
        {$ifdef UNICODE}
        AddJSONEscapeW(PPointerArray(P)^[i]);
        {$else}
        AddAnyAnsiString(PRawByteStringArray(P)^[i],twJSONEscape,0);
        {$endif}
      djHash128: AddBinToHexDisplayLower(@PHash128Array(P)[i],SizeOf(THash128));
      djHash256: AddBinToHexDisplayLower(@PHash256Array(P)[i],SizeOf(THash256));
      djHash512: AddBinToHexDisplayLower(@PHash512Array(P)[i],SizeOf(THash512));
      djInterface: AddPointer(PPtrIntArray(P)^[i]);
      end;
      Add('"',',');
    end;
  else // numerical JSON
    for i := 0 to n do begin
      case T of
      djBoolean:  Add(PBooleanArray(P)^[i]);
      djByte:     AddU(PByteArray(P)^[i]);
      djWord:     AddU(PWordArray(P)^[i]);
      djInteger:  Add(PIntegerArray(P)^[i]);
      djCardinal: AddU(PCardinalArray(P)^[i]);
      djSingle:   AddSingle(PSingleArray(P)^[i]);
      djInt64:    Add(PInt64Array(P)^[i]);
      djQWord:    AddQ(PQWordArray(P)^[i]);
      djDouble:   AddDouble(PDoubleArray(P)^[i]);
      djCurrency: AddCurr64(PInt64Array(P)^[i]);
      else raise ESynException.CreateUTF8('AddDynArrayJSON unsupported %',[ToText(T)^]);
      end;
      Add(',');
    end;
    end;
  CancelLastComma;
  Add(']');
end;

procedure TTextWriter.Add(const Format: RawUTF8; const Values: array of const;
  Escape: TTextWriterKind; WriteObjectOptions: TTextWriterWriteObjectOptions);
var ValuesIndex: integer;
    F: PUTF8Char;
label write;
begin // we put const char > #127 as #??? -> asiatic MBCS codepage OK
  if Format='' then
    exit;
  if (Format='%') and (high(Values)>=0) then begin
    Add(Values[0],Escape);
    exit;
  end;
  ValuesIndex := 0;
  F := pointer(Format);
  repeat
    repeat
      case ord(F^) of
      0: exit;
      ord('%'): break;
      {$ifdef OLDTEXTWRITERFORMAT}
      164: AddCR; // currency sign -> add CR,LF
      167: if B^=',' then dec(B); // section sign to ignore next comma
      ord('|'): begin
        inc(F); // |% -> %
        goto write;
      end;
      ord('$'),163,181: // dollar, pound, micro sign
        break; // process command value
      {$endif}
      else begin
write:  if B>=BEnd then
          FlushToStream;
        B[1] := F^;
        inc(B);
      end;
      end;
      inc(F);
    until false;
    // add next value as text
    if ValuesIndex<=high(Values) then // missing value will display nothing
    case ord(F^) of
    ord('%'):
      Add(Values[ValuesIndex],Escape,WriteObjectOptions);
    {$ifdef OLDTEXTWRITERFORMAT}
    ord('$'): with Values[ValuesIndex] do
           if Vtype=vtInteger then Add2(VInteger);
    163: with Values[ValuesIndex] do // pound sign
           if Vtype=vtInteger then Add4(VInteger);
    181: with Values[ValuesIndex] do // micro sign
           if Vtype=vtInteger then Add3(VInteger);
    {$endif}
    end;
    inc(F);
    inc(ValuesIndex);
  until false;
end;

procedure TTextWriter.AddLine(const Text: shortstring);
begin
  if BEnd-B<=ord(Text[0])+2 then
    FlushToStream;
  inc(B);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Text[1],B[0],ord(Text[0]));
  inc(B,ord(Text[0]));
  PWord(B)^ := 13+10 shl 8; // CR + LF
  inc(B);
end;

procedure TTextWriter.AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2-1)>=cardinal(fTempBufSize) then
    exit;
  if BEnd-B<=BinBytes*2 then
    FlushToStream;
  BinToHexDisplay(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddBinToHexDisplayLower(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2-1)>=cardinal(fTempBufSize) then
    exit;
  if BEnd-B<=BinBytes*2 then
    FlushToStream;
  BinToHexDisplayLower(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddBinToHexDisplayQuoted(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2+2)>=cardinal(fTempBufSize) then
    exit;
  if BEnd-B<=BinBytes*2+2 then
    FlushToStream;
  B[1] := '"';
  BinToHexDisplayLower(Bin,PAnsiChar(B+2),BinBytes);
  inc(B,BinBytes*2);
  B[2] := '"';
  inc(B,2);
end;

procedure TTextWriter.AddBinToHexDisplayMinChars(Bin: pointer; BinBytes: PtrInt);
begin
  if (BinBytes<=0) or (cardinal(BinBytes*2-1)>=cardinal(fTempBufSize)) then
    exit;
  repeat // append hexa chars up to the last non zero byte
    dec(BinBytes);
  until (BinBytes=0) or (PByteArray(Bin)[BinBytes]<>0);
  inc(BinBytes);
  if BEnd-B<=BinBytes*2 then
    FlushToStream;
  BinToHexDisplayLower(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddPointer(P: PtrUInt);
begin
  AddBinToHexDisplayMinChars(@P,SizeOf(P));
end;

procedure TTextWriter.AddBinToHex(Bin: Pointer; BinBytes: integer);
var ChunkBytes: PtrInt;
begin
  if BinBytes<=0 then
    exit;
  if B>=BEnd then
    FlushToStream;
  inc(B);
  repeat
    // guess biggest size to be added into buf^ at once
    ChunkBytes := (BEnd-B) shr 1; // div 2, *2 -> two hexa chars per byte
    if BinBytes<ChunkBytes then
      ChunkBytes := BinBytes;
    // add hexa characters
    SynCommons.BinToHex(PAnsiChar(Bin),PAnsiChar(B),ChunkBytes);
    inc(B,ChunkBytes*2);
    inc(PByte(Bin),ChunkBytes);
    dec(BinBytes,ChunkBytes);
    if BinBytes=0 then break;
    // Flush writes B-buf+1 -> special one below:
    ChunkBytes := B-fTempBuf;
    fStream.WriteBuffer(fTempBuf^,ChunkBytes);
    inc(fTotalFileSize,ChunkBytes);
    B := fTempBuf;
  until false;
  dec(B); // allow CancelLastChar
end;

procedure TTextWriter.AddQuotedStr(Text: PUTF8Char; Quote: AnsiChar;
  TextMaxLen: integer);
var BMax: PUTF8Char;
begin
  BMax := BEnd-3;
  if B>=BMax then begin
    FlushToStream;
    BMax := BEnd-3;
  end;
  B[1] := Quote;
  inc(B);
  if Text<>nil then
    repeat
      if B<BMax then begin
        if Text^=#0 then
          break;
        if TextMaxLen>0 then begin
          if TextMaxLen=3 then begin
            B[1] := '.'; // indicates truncated
            B[2] := '.';
            B[3] := '.';
            inc(B,3);
            break;
          end else
            dec(TextMaxLen);
        end;
        if Text^<>Quote then begin
          B[1] := Text^;
          inc(Text);
          inc(B);
        end else begin
          B[1] := Quote;
          B[2] := Quote;
          inc(B,2);
          inc(Text);
        end;
      end else begin
        FlushToStream;
        BMax := BEnd-2;
      end;
    until false;
  B[1] := Quote;
  inc(B);
end;

procedure TTextWriter.AddHtmlEscape(Text: PUTF8Char; Fmt: TTextWriterHTMLFormat);
var i,beg: PtrInt;
begin
  if Text=nil then
    exit;
  i := 0;
  repeat
    beg := i;
    case Fmt of
    hfAnyWhere:
      while true do
        if Text[i] in [#0,'&','"','<','>'] then
          break else
          inc(i);
    hfOutsideAttributes:
      while true do
        if Text[i] in [#0,'&','<','>'] then
          break else
          inc(i);
    hfWithinAttributes:
      while true do
        if Text[i] in [#0,'&','"'] then
          break else
          inc(i);
    end;
    AddNoJSONEscape(Text+beg,i-beg);
    repeat
      case Text[i] of
      #0: exit;
      '<': AddShort('&lt;');
      '>': AddShort('&gt;');
      '&': AddShort('&amp;');
      '"': AddShort('&quot;');
      else break;
      end;
      inc(i);
    until false;
  until false;
end;

procedure TTextWriter.AddHtmlEscape(Text: PUTF8Char; TextLen: integer;
  Fmt: TTextWriterHTMLFormat);
var i,beg: PtrInt;
begin
  if (Text=nil) or (TextLen<=0) then
    exit;
  i := 0;
  repeat
    beg := i;
    case Fmt of
    hfAnyWhere:
      while i<TextLen do
        if Text[i] in [#0,'&','"','<','>'] then
          break else
          inc(i);
    hfOutsideAttributes:
      while i<TextLen do
        if Text[i] in [#0,'&','<','>'] then
          break else
          inc(i);
    hfWithinAttributes:
      while i<TextLen do
        if Text[i] in [#0,'&','"'] then
          break else
          inc(i);
    end;
    AddNoJSONEscape(Text+beg,i-beg);
    repeat
      if i=TextLen then
        exit;
      case Text[i] of
      #0: exit;
      '<': AddShort('&lt;');
      '>': AddShort('&gt;');
      '&': AddShort('&amp;');
      '"': AddShort('&quot;');
      else break;
      end;
      inc(i);
    until false;
  until false;
end;

procedure TTextWriter.AddHtmlEscapeString(const Text: string; Fmt: TTextWriterHTMLFormat);
begin
  AddHtmlEscape(pointer(StringToUTF8(Text)),Fmt);
end;

procedure TTextWriter.AddHtmlEscapeUTF8(const Text: RawUTF8; Fmt: TTextWriterHTMLFormat);
begin
  AddHtmlEscape(pointer(Text),length(Text),Fmt);
end;

procedure TTextWriter.AddHtmlEscapeWiki(P: PUTF8Char);
var B: PUTF8Char;
    bold,italic: boolean;
  procedure Toggle(var value: Boolean; HtmlChar: AnsiChar);
  begin
    Add('<');
    if value then
      Add('/');
    Add(HtmlChar,'>');
    value := not value;
  end;
  procedure EndOfParagraph;
  begin
    if bold then
      Toggle(bold,'B');
    if italic then
      Toggle(italic,'I');
    AddShort('</p>');
  end;
begin
  bold := false;
  italic := false;
  AddShort('<p>');
  if P<>nil then
    repeat
      B := P;
      while not (ord(P^) in [0,13,10,ord('*'),ord('+')]) do
        if (P^='h') and IdemPChar(P+1,'TTP://') then
          break else
          inc(P);
      AddHtmlEscape(B,P-B,hfOutsideAttributes);
      case ord(P^) of
      0: break;
      10,13: begin
        EndOfParagraph;
        AddShort('<p>');
        while P[1] in [#10,#13] do inc(P);
      end;
      ord('*'):
        Toggle(italic,'I');
      ord('+'):
        Toggle(bold,'B');
      ord('h'): begin
        B := P;
        while P^>' ' do inc(P);
        AddShort('<a href=');
        AddHtmlEscape(B,P-B);
        Add('>');
        AddHtmlEscape(B,P-B);
        AddShort('</a>');
        continue;
      end;
      end;
      inc(P);
    until P^=#0;
  EndOfParagraph;
end;

procedure TTextWriter.AddXmlEscape(Text: PUTF8Char);
const XML_ESCAPE: TSynByteSet =
  [0..31,ord('<'),ord('>'),ord('&'),ord('"'),ord('''')];
var i,beg: PtrInt;
begin
  if Text=nil then
    exit;
  i := 0;
  repeat
    beg := i;
    if not(ord(Text[i]) in XML_ESCAPE) then begin
      repeat // it is faster to handle all not-escaped chars at once
        inc(i);
      until ord(Text[i]) in XML_ESCAPE;
      AddNoJSONEscape(Text+beg,i-beg);
    end;
    repeat
      case Text[i] of
      #0: exit;
      #1..#8,#11,#12,#14..#31:
        ; // ignore invalid character - see http://www.w3.org/TR/xml/#NT-Char
      #9,#10,#13: begin // characters below ' ', #9 e.g. -> // '&#x09;'
        AddShort('&#x');
        AddByteToHex(ord(Text[i]));
        Add(';');
      end;
      '<': AddShort('&lt;');
      '>': AddShort('&gt;');
      '&': AddShort('&amp;');
      '"': AddShort('&quot;');
      '''': AddShort('&apos;');
      else break; // should match XML_ESCAPE[] constant above
      end;
      inc(i);
    until false;
  until false;
end;

procedure TTextWriter.AddReplace(Text: PUTF8Char; Orig,Replaced: AnsiChar);
begin
  if Text<>nil then
    while Text^<>#0 do begin
      if Text^=Orig then
        Add(Replaced) else
        Add(Text^);
      inc(Text);
    end;
end;

procedure TTextWriter.AddByteToHex(Value: byte);
begin
  if BEnd-B<=1 then
    FlushToStream;
  PWord(B+1)^ := TwoDigitsHexWB[Value];
  inc(B,2);
end;

procedure TTextWriter.AddInt18ToChars3(Value: cardinal);
begin
  if BEnd-B<=3 then
    FlushToStream;
  PCardinal(B+1)^ := ((Value shr 12) and $3f)+
                     ((Value shr 6) and $3f)shl 8+
                     (Value and $3f)shl 16+$202020;
  //assert(Chars3ToInt18(B+1)=Value);
  inc(B,3);
end;

function Int18ToChars3(Value: cardinal): RawUTF8;
begin
  FastSetString(result,nil,3);
  PCardinal(result)^ := ((Value shr 12) and $3f)+
                        ((Value shr 6) and $3f)shl 8+
                        (Value and $3f)shl 16+$202020;
end;

procedure Int18ToChars3(Value: cardinal; var result: RawUTF8);
begin
  FastSetString(result,nil,3);
  PCardinal(result)^ := ((Value shr 12) and $3f)+
                        ((Value shr 6) and $3f)shl 8+
                        (Value and $3f)shl 16+$202020;
end;

function Chars3ToInt18(P: pointer): cardinal;
begin
  result := PCardinal(P)^-$202020;
  result := ((result shr 16)and $3f)+
            ((result shr 8) and $3f)shl 6+
            (result and $3f)shl 12;
end;

procedure TTextWriter.AddNoJSONEscape(P: Pointer);
begin
  AddNoJSONEscape(P,StrLen(PUTF8Char(P)));
end;

procedure TTextWriter.AddNoJSONEscape(P: Pointer; Len: PtrInt);
var i: PtrInt;
begin
  if (P<>nil) and (Len>0) then begin
    inc(B); // allow CancelLastChar
    repeat
      i := BEnd-B+1; // guess biggest size to be added into buf^ at once
      if Len<i then
        i := Len;
      // add UTF-8 bytes
      {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,B^,i);
      inc(B,i);
      if i=Len then
        break;
      inc(PByte(P),i);
      dec(Len,i);
      // FlushInc writes B-buf+1 -> special one below:
      i := B-fTempBuf;
      fStream.WriteBuffer(fTempBuf^,i);
      inc(fTotalFileSize,i);
      B := fTempBuf;
    until false;
    dec(B); // allow CancelLastChar
  end;
end;

procedure TTextWriter.AddNoJSONEscapeUTF8(const text: RawByteString);
begin
  AddNoJSONEscape(pointer(text),length(text));
end;

procedure TTextWriter.AddNoJSONEscapeW(WideChar: PWord; WideCharCount: integer);
var PEnd: PtrUInt;
    BMax: PUTF8Char;
begin
  if WideChar=nil then
    exit;
  BMax := BEnd-7; // ensure enough space for biggest Unicode glyph as UTF-8
  if WideCharCount=0 then
    repeat
      if B>=BMax then begin
        FlushToStream;
        BMax := BEnd-7; // B may have been resized -> recompute BMax
      end;
      if WideChar^=0 then
        break;
      if WideChar^<=126 then begin
        B[1] := AnsiChar(ord(WideChar^));
        inc(WideChar);
        inc(B);
      end else
        inc(B,UTF16CharToUtf8(B+1,WideChar));
    until false else begin
    PEnd := PtrUInt(WideChar)+PtrUInt(WideCharCount)*SizeOf(WideChar^);
    repeat
      if B>=BMax then begin
        FlushToStream;
        BMax := BEnd-7;
      end;
      if WideChar^=0 then
        break;
      if WideChar^<=126 then begin
        B[1] := AnsiChar(ord(WideChar^));
        inc(WideChar);
        inc(B);
        if PtrUInt(WideChar)<PEnd then continue else break;
      end;
      inc(B,UTF16CharToUtf8(B+1,WideChar));
      if PtrUInt(WideChar)<PEnd then continue else break;
    until false;
  end;
end;

procedure TTextWriter.Add(P: PUTF8Char; Escape: TTextWriterKind);
begin
  if P<>nil then
  case Escape of
    twNone:       AddNoJSONEscape(P,StrLen(P));
    twJSONEscape: AddJSONEscape(P);
    twOnSameLine: AddOnSameLine(P);
  end;
end;

procedure TTextWriter.Add(P: PUTF8Char; Len: PtrInt; Escape: TTextWriterKind);
begin
  if P<>nil then
  case Escape of
    twNone:       AddNoJSONEscape(P,Len);
    twJSONEscape: AddJSONEscape(P,Len);
    twOnSameLine: AddOnSameLine(P,Len);
  end;
end;

procedure TTextWriter.AddW(P: PWord; Len: PtrInt; Escape: TTextWriterKind);
begin
  if P<>nil then
  case Escape of
    twNone:       AddNoJSONEscapeW(P,Len);
    twJSONEscape: AddJSONEScapeW(P,Len);
    twOnSameLine: AddOnSameLineW(P,Len);
  end;
end;

procedure TTextWriter.AddAnsiString(const s: AnsiString; Escape: TTextWriterKind);
begin
  AddAnyAnsiBuffer(pointer(s),length(s),Escape,0);
end;

procedure TTextWriter.AddAnyAnsiString(const s: RawByteString;
  Escape: TTextWriterKind; CodePage: Integer);
var L: integer;
begin
  L := length(s);
  if L=0 then
    exit;
  if (L>2) and (PInteger(s)^ and $ffffff=JSON_BASE64_MAGIC) then begin
    AddNoJSONEscape(pointer(s),L); // identified as a BLOB content
    exit;
  end;
  if CodePage<0 then
    {$ifdef HASCODEPAGE}
    CodePage := StringCodePage(s);
    {$else}
    CodePage := 0; // TSynAnsiConvert.Engine(0)=CurrentAnsiConvert
    {$endif}
  AddAnyAnsiBuffer(pointer(s),L,Escape,CodePage);
end;

procedure TTextWriter.AddAnyAnsiBuffer(P: PAnsiChar; Len: integer;
  Escape: TTextWriterKind; CodePage: Integer);
var B: PUTF8Char;
begin
  if Len>0 then
  case CodePage of
  CP_UTF8, CP_RAWBYTESTRING:
    Add(PUTF8Char(P),Len,Escape);  // direct write of RawUTF8/RawByteString content
  CP_UTF16:
    AddW(PWord(P),0,Escape); // direct write of UTF-16 content
  CP_SQLRAWBLOB: begin
    AddNoJSONEscape(@PByteArray(@JSON_BASE64_MAGIC_QUOTE_VAR)[1],3);
    WrBase64(P,Len,{withMagic=}false);
  end;
  else begin
    // first handle trailing 7 bit ASCII chars, by quad
    B := pointer(P);
    if Len>=4 then
      repeat
        if PCardinal(P)^ and $80808080<>0 then
          break; // break on first non ASCII quad
        inc(P,4);
        dec(Len,4);
      until Len<4;
    if (Len>0) and (P^<#128)  then
    repeat
      inc(P);
      dec(Len);
    until (Len=0) or (P^>=#127);
    if P<>pointer(B) then
      Add(B,P-B,Escape);
    if Len=0 then
      exit;
    // rely on explicit conversion for all remaining ASCII characters
    TSynAnsiConvert.Engine(CodePage).InternalAppendUTF8(P,Len,self,Escape);
  end;
  end;
end;

const
{$ifdef OPT4AMD} // circumvent Delphi 5 and Delphi 6 compilation issues :(
  JSON_ESCAPE: TSynByteSet = [0..31,ord('\'),ord('"')];
{$else}
  // see http://www.ietf.org/rfc/rfc4627.txt
  JSON_ESCAPE = [0..31,ord('\'),ord('"')];
  // "set of byte" uses BT[mem] opcode which is actually slower than three SUB
{$endif}
var
  JSON_ESCAPE_BYTE: TSynByteBoolean;

function NeedsJsonEscape(const Text: RawUTF8): boolean;
var tab: ^TSynByteBoolean;
    P: PByteArray;
    i: PtrInt;
begin
  result := true;
  tab := @JSON_ESCAPE_BYTE;
  P := pointer(Text);
  for i := 0 to length(Text)-1 do
    if tab[P^[i]] then
      exit;
  result := false;
end;

procedure TTextWriter.InternalAddFixedAnsi(Source: PAnsiChar; SourceChars: Cardinal;
  const AnsiToWide: TWordDynArray; Escape: TTextWriterKind);
var c: cardinal;
begin
  while SourceChars>0 do begin
    c := byte(Source^);
    if c<=$7F then begin
      if B>=BEnd then
        FlushToStream;
      case Escape of
      twNone: begin
        inc(B);
        B^ := AnsiChar(c);
      end;
      twJSONEscape:
        if c in JSON_ESCAPE then
          AddJsonEscape(Source,1) else begin
          inc(B);
          B^ := AnsiChar(c);
        end;
      twOnSameLine: begin
        inc(B);
        if c<32 then
          B^ := ' ' else
          B^ := AnsiChar(c);
      end;
      end
    end else begin // no surrogate is expected in TSynAnsiFixedWidth charsets
      if BEnd-B<=3 then
        FlushToStream;
      c := AnsiToWide[c]; // convert FixedAnsi char into Unicode char
      if c>$7ff then begin
        B[1] := AnsiChar($E0 or (c shr 12));
        B[2] := AnsiChar($80 or ((c shr 6) and $3F));
        B[3] := AnsiChar($80 or (c and $3F));
        inc(B,3);
      end else begin
        B[1] := AnsiChar($C0 or (c shr 6));
        B[2] := AnsiChar($80 or (c and $3F));
        inc(B,2);
      end;
    end;
    dec(SourceChars);
    inc(Source);
  end;
end;

procedure TTextWriter.AddOnSameLine(P: PUTF8Char);
begin
  if P<>nil then
    while P^<>#0 do begin
      if B>=BEnd then
        FlushToStream;
      if P^<' ' then
        B[1] := ' ' else
        B[1] := P^;
      inc(P);
      inc(B);
    end;
end;

procedure TTextWriter.AddOnSameLine(P: PUTF8Char; Len: PtrInt);
var i: PtrInt;
begin
  if P<>nil then
    for i := 0 to Len-1 do begin
      if B>=BEnd then
        FlushToStream;
      if P[i]<' ' then
        B[1] := ' ' else
        B[1] := P[i];
      inc(B);
    end;
end;

procedure TTextWriter.AddOnSameLineW(P: PWord; Len: PtrInt);
var PEnd: PtrUInt;
begin
  if P=nil then exit;
  if Len=0 then
    PEnd := 0 else
    PEnd := PtrUInt(P)+PtrUInt(Len)*SizeOf(WideChar);
  while (Len=0) or (PtrUInt(P)<PEnd) do begin
    if BEnd-B<=7 then
      FlushToStream;
    // escape chars, so that all content will stay on the same text line
    case P^ of
      0: break;
      1..32: begin
        B[1] := ' ';
        inc(B);
        inc(P);
      end;
      33..126: begin
        B[1] := AnsiChar(ord(P^)); // direct store 7 bits ASCII
        inc(B);
        inc(P);
      end;
      else // characters higher than #126 -> UTF-8 encode
        inc(B,UTF16CharToUtf8(B+1,P));
    end;
  end;
end;

procedure TTextWriter.AddJSONEscape(P: Pointer; Len: PtrInt);
var i,c: PtrInt;
    {$ifndef CPUX86NOTPIC}tab: ^TSynByteBoolean;{$endif}
label noesc;
begin
  if P=nil then
    exit;
  if Len=0 then
    Len := MaxInt;
  i := 0;
  {$ifdef CPUX86NOTPIC}
  repeat
    if not(PByteArray(P)[i] in JSON_ESCAPE) then begin
noesc:c := i;
      repeat
        inc(i);
      until (i>=Len) or (PByteArray(P)[i] in JSON_ESCAPE);
  {$else}
  tab := @JSON_ESCAPE_BYTE;
  repeat
    if not tab^[PByteArray(P)[i]] then begin
noesc:c := i;
      repeat
        inc(i);
      until (i>=Len) or tab^[PByteArray(P)[i]];
  {$endif CPUX86NOTPIC}
      inc(PByte(P),c);
      dec(i,c);
      dec(Len,c);
      if BEnd-B<=i then
        AddNoJSONEscape(P,i) else begin
        {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,B[1],i);
        inc(B,i);
      end;
      if i>=Len then
        exit;
    end;
    repeat
      c := PByteArray(P)[i];
      case c of
      0:  exit;
      8:  c := ord('\')+ord('b')shl 8;
      9:  c := ord('\')+ord('t')shl 8;
      10: c := ord('\')+ord('n')shl 8;
      12: c := ord('\')+ord('f')shl 8;
      13: c := ord('\')+ord('r')shl 8;
      ord('\'): c := ord('\')+ord('\')shl 8;
      ord('"'): c := ord('\')+ord('"')shl 8;
      1..7,11,14..31: begin // characters below ' ', #7 e.g. -> // 'u0007'
        AddShort('\u00');
        c := TwoDigitsHexWB[c];
      end;
      else goto noesc;
      end;
      if BEnd-B<=1 then
        FlushToStream;
      inc(i);
      PWord(B+1)^ := c;
      inc(B,2);
      if i>=Len then
        exit;
    until false;
  until i>=Len;
end;

procedure TTextWriter.AddJSONEscapeW(P: PWord; Len: PtrInt);
var i,c: PtrInt;
begin
  if P=nil then
    exit;
  if Len=0 then
    Len := MaxInt;
  i := 0;
  while i<Len do begin
    c := i;
    if not(PWordArray(P)[i] in JSON_ESCAPE) then begin
      repeat
        inc(i);
      until (i>=Len) or (PWordArray(P)[i] in JSON_ESCAPE);
      AddNoJSONEscapeW(@PWordArray(P)[c],i-c);
    end;
    while i<Len do begin
      c := PWordArray(P)[i];
      case c of
      0:  exit;
      8:  Add('\','b');
      9:  Add('\','t');
      10: Add('\','n');
      12: Add('\','f');
      13: Add('\','r');
      ord('\'),ord('"'): Add('\',AnsiChar(c));
      1..7,11,14..31: begin // characters below ' ', #7 e.g. -> // 'u0007'
        AddShort('\u00');
        AddByteToHex(c);
      end;
      else break;
      end;
      inc(i);
    end;
  end;
end;

procedure TTextWriter.AddJSONEscape(const V: TVarRec);
begin
  with V do
  case VType of
    vtPointer: AddShort('null');
    vtString, vtAnsiString,{$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString, vtClass: begin
      Add('"');
      case VType of
        vtString: if VString^[0]<>#0 then AddJSONEscape(@VString^[1],ord(VString^[0]));
        vtAnsiString: AddJSONEscape(pointer(RawUTF8(VAnsiString)));
        {$ifdef HASVARUSTRING}
        vtUnicodeString: AddJSONEscapeW(
          pointer(UnicodeString(VUnicodeString)),length(UnicodeString(VUnicodeString)));
        {$endif}
        vtPChar:      AddJSONEscape(VPChar);
        vtChar:       AddJSONEscape(@VChar,1);
        vtWideChar:   AddJSONEscapeW(@VWideChar,1);
        vtWideString: AddJSONEscapeW(VWideString);
        vtClass:      AddClassName(VClass);
      end;
      Add('"');
    end;
    vtBoolean:  Add(VBoolean); // 'true'/'false'
    vtInteger:  Add(VInteger);
    vtInt64:    Add(VInt64^);
    {$ifdef FPC}
    vtQWord:    AddQ(V.VQWord^);
    {$endif}
    vtExtended: Add(VExtended^,DOUBLE_PRECISION);
    vtCurrency: AddCurr64(VInt64^);
    vtObject:   WriteObject(VObject);
    {$ifndef NOVARIANTS}
    vtVariant:  AddVariant(VVariant^,twJSONEscape);
    {$endif}
  end;
end;

procedure TTextWriter.AddJSONString(const Text: RawUTF8);
begin
  Add('"');
  AddJSONEscape(pointer(Text));
  Add('"');
end;

procedure TTextWriter.Add(const V: TVarRec; Escape: TTextWriterKind;
  WriteObjectOptions: TTextWriterWriteObjectOptions);
begin
  with V do
  case Vtype of
  vtInteger:      Add(VInteger);
  vtBoolean:      if VBoolean then Add('1') else Add('0'); // normalize
  vtChar:         Add(@VChar,1,Escape);
  vtExtended:     Add(VExtended^,DOUBLE_PRECISION);
  vtCurrency:     AddCurr64(VInt64^);
  vtInt64:        Add(VInt64^);
  {$ifdef FPC}
  vtQWord:        AddQ(VQWord^);
  {$endif}
  {$ifndef NOVARIANTS}
  vtVariant:      AddVariant(VVariant^,Escape);
  {$endif}
  vtString:  if VString^[0]<>#0 then Add(@VString^[1],ord(VString^[0]),Escape);
  vtInterface,
  vtPointer:      AddBinToHexDisplayMinChars(@VPointer,SizeOf(VPointer));
  vtPChar:        Add(PUTF8Char(VPChar),Escape);
  vtObject:       WriteObject(VObject,WriteObjectOptions);
  vtClass:        AddClassName(VClass);
  vtWideChar:     AddW(@VWideChar,1,Escape);
  vtPWideChar:
    AddW(pointer(VPWideChar),StrLenW(VPWideChar),Escape);
  vtAnsiString:
    if VAnsiString<>nil then
      Add(VAnsiString,length(RawUTF8(VAnsiString)),Escape); // expect RawUTF8
  vtWideString:
    if VWideString<>nil then
      AddW(VWideString,length(WideString(VWideString)),Escape);
  {$ifdef HASVARUSTRING}
  vtUnicodeString:
    if VUnicodeString<>nil then // convert to UTF-8
      AddW(VUnicodeString,length(UnicodeString(VUnicodeString)),Escape);
  {$endif}
  end;
end;

{$ifndef NOVARIANTS}
procedure TTextWriter.AddJSON(const Format: RawUTF8; const Args,Params: array of const);
var temp: variant;
begin
  _JsonFmt(Format,Args,Params,JSON_OPTIONS_FAST,temp);
  AddVariant(temp,twJSONEscape);
end;
{$endif}

procedure TTextWriter.AddJSONArraysAsJSONObject(keys,values: PUTF8Char);
var k,v: PUTF8Char;
begin
  if (keys=nil) or (keys^<>'[') or (values=nil) or (values^<>'[') then begin
    AddShort('null');
    exit;
  end;
  inc(keys); // jump initial [
  inc(values);
  Add('{');
  repeat
    k := GotoEndJSONItem(keys);
    v := GotoEndJSONItem(values);
    if (k=nil) or (v=nil) then
      break; // invalid JSON input
    AddNoJSONEscape(keys,k-keys);
    Add(':');
    AddNoJSONEscape(values,v-values);
    Add(',');
    if (k^<>',') or (v^<>',') then
      break; // reached the end of the input JSON arrays
    keys := k+1;
    values := v+1;
  until false;
  CancelLastComma;
  Add('}');
end;

procedure TTextWriter.AddJSONEscape(const NameValuePairs: array of const);
var a: integer;
procedure WriteValue;
begin
  case VarRecAsChar(NameValuePairs[a]) of
  ord('['): begin
    Add('[');
    while a<high(NameValuePairs) do begin
      inc(a);
      if VarRecAsChar(NameValuePairs[a])=ord(']') then
        break;
      WriteValue;
    end;
    CancelLastComma;
    Add(']');
  end;
  ord('{'): begin
    Add('{');
    while a<high(NameValuePairs) do begin
      inc(a);
      if VarRecAsChar(NameValuePairs[a])=ord('}') then
        break;
      AddJSONEscape(NameValuePairs[a]);
      Add(':');
      inc(a);
      WriteValue;
    end;
    CancelLastComma;
    Add('}');
  end else
    AddJSONEscape(NameValuePairs[a]);
  end;
  Add(',');
end;
begin
  Add('{');
  a := 0;
  while a<high(NameValuePairs) do begin
    AddJSONEscape(NameValuePairs[a]);
    inc(a);
    Add(':');
    WriteValue;
    inc(a);
  end;
  CancelLastComma;
  Add('}');
end;

procedure TTextWriter.AddNoJSONEscapeString(const s: string);
begin
  if s<>'' then
    {$ifdef UNICODE}
    AddNoJSONEscapeW(pointer(s),0);
    {$else}
    AddAnsiString(s,twNone);
    {$endif}
end;

procedure TTextWriter.AddJSONEscapeString(const s: string);
begin
  if s<>'' then
    {$ifdef UNICODE}
    AddJSONEscapeW(pointer(s),Length(s));
    {$else}
    AddAnyAnsiString(s,twJSONEscape,0);
    {$endif}
end;

procedure TTextWriter.AddJSONEscapeAnsiString(const s: AnsiString);
begin
  AddAnyAnsiString(s,twJSONEscape,0);
end;

procedure TTextWriter.AddPropName(const PropName: ShortString);
begin
  if ord(PropName[0])=0 then
    exit;
  if BEnd-B<=ord(PropName[0])+3 then
    FlushToStream;
  if twoForceJSONExtended in CustomOptions then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(PropName[1],B[1],ord(PropName[0]));
    inc(B,ord(PropName[0])+1);
    B^ := ':';
  end else begin
    B[1] := '"';
    {$ifdef FPC}Move{$else}MoveFast{$endif}(PropName[1],B[2],ord(PropName[0]));
    inc(B,ord(PropName[0])+2);
    PWord(B)^ := ord('"')+ord(':')shl 8;
    inc(B);
  end;
end;

procedure TTextWriter.AddPropJSONString(const PropName: shortstring; const Text: RawUTF8);
begin
  AddPropName(PropName);
  AddJSONString(Text);
  Add(',');
end;

procedure TTextWriter.AddPropJSONInt64(const PropName: shortstring; Value: Int64);
begin
  AddPropName(PropName);
  Add(Value);
  Add(',');
end;

procedure TTextWriter.AddFieldName(const FieldName: RawUTF8);
begin
  AddFieldName(Pointer(FieldName),length(FieldName));
end;

procedure TTextWriter.AddFieldName(FieldName: PUTF8Char; FieldNameLen: integer);
begin
  if BEnd-B<=FieldNameLen+3 then
    FlushToStream;
  B[1] := '"';
  {$ifdef FPC}Move{$else}MoveFast{$endif}(FieldName^,B[2],FieldNameLen);
  inc(B,FieldNameLen+2);
  PWord(B)^ := ord('"')+ord(':')shl 8;
  inc(B);
end;

procedure TTextWriter.AddClassName(aClass: TClass);
begin
  if aClass<>nil then
    AddShort(PShortString(PPointer(PtrInt(PtrUInt(aClass))+vmtClassName)^)^);
end;

procedure TTextWriter.AddInstanceName(Instance: TObject; SepChar: AnsiChar);
begin
  Add('"');
  if Instance=nil then
    AddShort('void') else
    AddShort(PShortString(PPointer(PPtrInt(Instance)^+vmtClassName)^)^);
  Add('(');
  AddBinToHexDisplayMinChars(@Instance,SizeOf(Instance));
  Add(')','"');
  if SepChar<>#0 then
    Add(SepChar);
end;

procedure TTextWriter.AddInstancePointer(Instance: TObject; SepChar: AnsiChar;
  IncludeUnitName, IncludePointer: boolean);
begin
  AddShort(PShortString(PPointer(PPtrInt(Instance)^+vmtClassName)^)^);
  if IncludePointer then begin
    Add('(');
    AddBinToHexDisplayMinChars(@Instance,SizeOf(Instance));
    Add(')');
  end;
  if SepChar<>#0 then
    Add(SepChar);
end;

procedure TTextWriter.AddShort(const Text: ShortString);
begin
  if ord(Text[0])=0 then
    exit;
  if BEnd-B<=ord(Text[0]) then
    FlushToStream;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Text[1],B[1],ord(Text[0]));
  inc(B,ord(Text[0]));
end;

procedure TTextWriter.AddQuotedStringAsJSON(const QuotedString: RawUTF8);
var L: integer;
    P,B: PUTF8Char;
    quote: AnsiChar;
begin
  L := length(QuotedString);
  if L>0 then begin
    quote := QuotedString[1];
    if (quote in ['''','"']) and (QuotedString[L]=quote) then begin
      Add('"');
      P := pointer(QuotedString);
      inc(P);
      repeat
        B := P;
        while P[0]<>quote do inc(P);
        if P[1]<>quote then
          break; // end quote
        inc(P);
        AddJSONEscape(B,P-B);
        inc(P); // ignore double quote
      until false;
      if P-B<>0 then
        AddJSONEscape(B,P-B);
      Add('"');
    end else
      AddNoJSONEscape(pointer(QuotedString),length(QuotedString));
  end;
end;

procedure TTextWriter.AddTrimLeftLowerCase(Text: PShortString);
var P: PAnsiChar;
    L: integer;
begin
  L := length(Text^);
  P := @Text^[1];
  while (L>0) and (P^ in ['a'..'z']) do begin
    inc(P);
    dec(L);
  end;
  if L=0 then
    AddShort(Text^) else
    AddNoJSONEscape(P,L);
end;

procedure TTextWriter.AddString(const Text: RawUTF8);
var L: integer;
begin
  if PtrInt(Text)=0 then
    exit;
  L := {$ifdef FPC}_LStrLen(Text){$else}PInteger(PtrInt(Text)-SizeOf(integer))^{$endif};
  if L<fTempBufSize then begin
    if BEnd-B<=L then
      FlushToStream;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Text)^,B[1],L);
    inc(B,L);
  end else
    AddNoJSONEscape(pointer(Text),L);
end;

procedure TTextWriter.AddStringCopy(const Text: RawUTF8; start,len: integer);
var L: integer;
begin
  if (len<=0) or (PtrInt(Text)=0) then
    exit;
  if start<0 then
    start := 0 else
    dec(start);
  L := {$ifdef FPC}_LStrLen(Text){$else}PInteger(PtrInt(Text)-SizeOf(integer))^{$endif};
  dec(L,start);
  if L>0 then begin
    if len<L then
      L := len;
    AddNoJSONEscape(@PByteArray(Text)[start],L);
  end;
end;

procedure TTextWriter.AddStrings(const Text: array of RawUTF8);
var i: integer;
begin
  for i := 0 to high(Text) do
    AddString(Text[i]);
end;

procedure TTextWriter.AddStrings(const Text: RawUTF8; count: integer);
var i,L: integer;
begin
  L := length(Text);
  if L*count>fTempBufSize then
    for i := 1 to count do
      AddString(Text) else begin
    if BEnd-B<=L*count then
      FlushToStream;
    for i := 1 to count do begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Text)^,B[1],L);
      inc(B,L);
    end;
  end;
end;

procedure TTextWriter.CancelAll;
begin
  if self=nil then
    exit; // avoid GPF
  if fTotalFileSize<>0 then
    fTotalFileSize := fStream.Seek(fInitialStreamPosition,soBeginning);
  B := fTempBuf-1;
end;

procedure TTextWriter.SetBuffer(aBuf: pointer; aBufSize: integer);
begin
  if aBufSize<=16 then
    raise ESynException.CreateUTF8('%.SetBuffer(size=%)',[self,aBufSize]);
  if aBuf=nil then
    GetMem(fTempBuf,aBufSize) else begin
    fTempBuf := aBuf;
    Include(fCustomOptions,twoBufferIsExternal);
  end;
  fTempBufSize := aBufSize;
  B := fTempBuf-1; // Add() methods will append at B+1
  BEnd := fTempBuf+fTempBufSize-16; // -16 to avoid buffer overwrite/overread
  if DefaultTextWriterTrimEnum then
    Include(fCustomOptions,twoTrimLeftEnumSets);
end;

constructor TTextWriter.Create(aStream: TStream; aBufSize: integer);
begin
  SetStream(aStream);
  if aBufSize<256 then
    aBufSize := 256;
  SetBuffer(nil,aBufSize);
end;

constructor TTextWriter.Create(aStream: TStream; aBuf: pointer; aBufSize: integer);
begin
  SetStream(aStream);
  SetBuffer(aBuf,aBufSize);
end;

constructor TTextWriter.CreateOwnedStream(aBufSize: integer);
begin
  Create(TRawByteStringStream.Create,aBufSize);
  Include(fCustomOptions,twoStreamIsOwned);
end;

constructor TTextWriter.CreateOwnedStream(aBuf: pointer; aBufSize: integer);
begin
  SetStream(TRawByteStringStream.Create);
  SetBuffer(aBuf,aBufSize);
  Include(fCustomOptions,twoStreamIsOwned);
end;

constructor TTextWriter.CreateOwnedStream(var aStackBuf: TTextWriterStackBuffer;
  aBufSize: integer);
begin
  if aBufSize>SizeOf(aStackBuf) then // too small -> allocate on heap
    CreateOwnedStream(aBufSize) else
    CreateOwnedStream(@aStackBuf,SizeOf(aStackBuf));
end;

constructor TTextWriter.CreateOwnedFileStream(const aFileName: TFileName;
  aBufSize: integer);
begin
  DeleteFile(aFileName);
  Create(TFileStream.Create(aFileName,fmCreate or fmShareDenyWrite),aBufSize);
  Include(fCustomOptions,twoStreamIsOwned);
end;

destructor TTextWriter.Destroy;
begin
  if twoStreamIsOwned in fCustomOptions then
    fStream.Free;
  if not (twoBufferIsExternal in fCustomOptions) then
    FreeMem(fTempBuf);
  fInternalJSONWriter.Free;
  inherited;
end;

class procedure TTextWriter.SetDefaultJSONClass(aClass: TTextWriterClass);
begin
  DefaultTextWriterJSONClass := aClass;
end;

class function TTextWriter.GetDefaultJSONClass: TTextWriterClass;
begin
  result := DefaultTextWriterJSONClass;
end;

class procedure TTextWriter.SetDefaultEnumTrim(aShouldTrimEnumsAsText: boolean);
begin
  DefaultTextWriterTrimEnum := aShouldTrimEnumsAsText;
end;

procedure TTextWriter.SetStream(aStream: TStream);
begin
  if fStream<>nil then
    if twoStreamIsOwned in fCustomOptions then begin
      FreeAndNil(fStream);
      Exclude(fCustomOptions,twoStreamIsOwned);
    end;
  if aStream<>nil then begin
    fStream := aStream;
    fInitialStreamPosition := fStream.Seek(0,soFromCurrent);
    fTotalFileSize := fInitialStreamPosition;
  end;
end;

procedure TTextWriter.FlushToStream;
var i: PtrInt;
    written: PtrUInt;
begin
  if fEchos<>nil then begin
    EchoFlush;
    fEchoStart := 0;
  end;
  i := B-fTempBuf+1;
  if i<=0 then
    exit;
  fStream.WriteBuffer(fTempBuf^,i);
  inc(fTotalFileSize,i);
  if not (twoFlushToStreamNoAutoResize in fCustomOptions) and
     not (twoBufferIsExternal in fCustomOptions) then begin
    written := fTotalFileSize-fInitialStreamPosition;
    if (fTempBufSize<49152) and (written>1 shl 18) then // 256KB -> 64KB buffer
      written := 65536 else
    if (fTempBufSize<1 shl 20) and (written>40 shl 20) then // 40MB -> 1MB buffer
      written := 1 shl 20 else
      written := 0;
    if written>0 then begin
      fTempBufSize := written;
      FreeMem(fTempBuf); // with big content comes bigger buffer
      GetMem(fTempBuf,fTempBufSize);
      BEnd := fTempBuf+(fTempBufSize-2);
    end;
  end;
  B := fTempBuf-1;
end;

function TTextWriter.GetEndOfLineCRLF: boolean;
begin
  result := twoEndOfLineCRLF in fCustomOptions;
end;

procedure TTextWriter.SetEndOfLineCRLF(aEndOfLineCRLF: boolean);
begin
  if aEndOfLineCRLF then
    include(fCustomOptions,twoEndOfLineCRLF) else
    exclude(fCustomOptions,twoEndOfLineCRLF);
end;

function TTextWriter.GetTextLength: PtrUInt;
begin
  if self=nil then
    result := 0 else
    result := PtrUInt(B-fTempBuf+1)+fTotalFileSize-fInitialStreamPosition;
end;

function TTextWriter.Text: RawUTF8;
begin
  SetText(result);
end;

procedure TTextWriter.ForceContent(const text: RawUTF8);
begin
  CancelAll;
  if (fInitialStreamPosition=0) and fStream.InheritsFrom(TRawByteStringStream) then
    TRawByteStringStream(fStream).fDataString := text else
    fStream.WriteBuffer(pointer(text)^,length(text));
  fTotalFileSize := fInitialStreamPosition+cardinal(length(text));
end;

procedure TTextWriter.FlushFinal;
begin
  Include(fCustomOptions,twoFlushToStreamNoAutoResize);
  FlushToStream;
end;

procedure TTextWriter.SetText(var result: RawUTF8; reformat: TTextWriterJSONFormat);
var Len: cardinal;
begin
  FlushFinal;
  Len := fTotalFileSize-fInitialStreamPosition;
  if Len=0 then
    result := '' else
  if fStream.InheritsFrom(TRawByteStringStream) then
    with TRawByteStringStream(fStream) do
    if fInitialStreamPosition=0 then begin
      {$ifdef HASCODEPAGE} // FPC expects this
      SetCodePage(fDataString,CP_UTF8,false);
      {$endif}
      result := fDataString;
      fDataString := '';
    end else
      FastSetString(result,PAnsiChar(pointer(DataString))+fInitialStreamPosition,Len) else
  if fStream.InheritsFrom(TCustomMemoryStream) then
    with TCustomMemoryStream(fStream) do
      FastSetString(result,PAnsiChar(Memory)+fInitialStreamPosition,Len) else begin
    FastSetString(result,nil,Len);
    fStream.Seek(fInitialStreamPosition,soBeginning);
    fStream.Read(pointer(result)^,Len);
  end;
  if reformat <> jsonCompact then begin // reformat using the very same instance
    CancelAll;
    AddJSONReformat(pointer(result),reformat,nil);
    SetText(result);
  end;
end;

procedure TTextWriter.WrRecord(const Rec; TypeInfo: pointer);
var L: integer;
    tmp: RawByteString;
begin
  L := RecordSaveLength(Rec,TypeInfo);
  SetString(tmp,nil,L);
  if L<>0 then
    RecordSave(Rec,pointer(tmp),TypeInfo);
  WrBase64(pointer(tmp),L,{withMagic=}true);
end;

procedure TTextWriter.WrBase64(P: PAnsiChar; Len: cardinal; withMagic: boolean);
var trailing, main, n: cardinal;
begin
  if withMagic then
    if len<=0 then begin
      AddShort('null'); // JSON null is better than "" for BLOBs
      exit;
    end else
    AddNoJSONEscape(@JSON_BASE64_MAGIC_QUOTE_VAR,4);
  if len>0 then begin
    n := Len div 3;
    trailing := Len-n*3;
    dec(Len,trailing);
    if BEnd-B>integer(n+1) shl 2 then begin
      // will fit in available space in Buf -> fast in-buffer Base64 encoding
      n := Base64EncodeMain(@B[1],P,Len);
      inc(B,n*4);
      inc(P,n*3);
    end else begin
      // bigger than available space in Buf -> do it per chunk
      FlushToStream;
      while Len>0 do begin // length(buf) const -> so is ((length(buf)-4)shr2 )*3
        n := ((fTempBufSize-4)shr 2)*3;
        if Len<n then
          n := Len;
        main := Base64EncodeMain(PAnsiChar(fTempBuf),P,n);
        n := main*4;
        if n<cardinal(fTempBufSize)-4 then
          inc(B,n) else begin
          fStream.WriteBuffer(fTempBuf^,n);
          inc(fTotalFileSize,n);
        end;
        n := main*3;
        inc(P,n);
        dec(Len,n);
      end;
    end;
    if trailing>0 then begin
      Base64EncodeTrailing(@B[1],P,trailing);
      inc(B,4);
    end;
  end;
  if withMagic then
    Add('"');
end;

procedure TTextWriter.EchoAdd(const aEcho: TOnTextWriterEcho);
begin
  if self<>nil then
    if MultiEventAdd(fEchos,TMethod(aEcho)) then
      if fEchos<>nil then
        fEchoStart := B-fTempBuf+1; // ignore any previous buffer
end;

procedure TTextWriter.EchoRemove(const aEcho: TOnTextWriterEcho);
begin
  if self<>nil then
    MultiEventRemove(fEchos,TMethod(aEcho));
end;

function TTextWriter.EchoFlush: PtrInt;
var L,LI: PtrInt;
    P: PByteArray;
begin
  result := B-fTempBuf+1;
  L := result-fEchoStart;
  P := @PByteArray(fTempBuf)[fEchoStart];
  while (L>0) and (P[L-1] in [10,13]) do // trim right CR/LF chars
    dec(L);
  LI := length(fEchoBuf); // fast append to fEchoBuf
  SetLength(fEchoBuf,LI+L);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(P^,PByteArray(fEchoBuf)[LI],L);
end;

procedure TTextWriter.EchoReset;
begin
  fEchoBuf := '';
end;



function JSONEncode(const NameValuePairs: array of const): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  if high(NameValuePairs)<1 then
    result := '{}' else // return void JSON object on error
    with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
    try
      AddJSONEscape(NameValuePairs);
      SetText(result);
    finally
      Free
    end;
end;

{$ifndef NOVARIANTS}
function JSONEncode(const Format: RawUTF8; const Args,Params: array of const): RawUTF8;
var temp: TTextWriterStackBuffer;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
  try
    AddJSON(Format,Args,Params);
    SetText(result);
  finally
    Free
  end;
end;
{$endif}

function JSONEncodeArrayDouble(const Values: array of double): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    W.Add('[');
    W.AddCSVDouble(Values);
    W.Add(']');
    W.SetText(result);
  finally
    W.Free
  end;
end;

function JSONEncodeArrayUTF8(const Values: array of RawUTF8): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    W.Add('[');
    W.AddCSVUTF8(Values);
    W.Add(']');
    W.SetText(result);
  finally
    W.Free
  end;
end;

function JSONEncodeArrayInteger(const Values: array of integer): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    W.Add('[');
    W.AddCSVInteger(Values);
    W.Add(']');
    W.SetText(result);
  finally
    W.Free
  end;
end;

function JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean): RawUTF8;
begin
  JSONEncodeArrayOfConst(Values,WithoutBraces,result);
end;

procedure JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean; var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  if length(Values)=0 then
    if WithoutBraces then
      result := '' else
      result := '[]' else
    with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
    try
      if not WithoutBraces then
        Add('[');
      AddCSVConst(Values);
      if not WithoutBraces then
        Add(']');
      SetText(result);
    finally
      Free
    end;
end;

procedure JSONEncodeNameSQLValue(const Name,SQLValue: RawUTF8;
  var result: RawUTF8);
var temp: TTextWriterStackBuffer;
begin
  if (SQLValue<>'') and (SQLValue[1] in ['''','"']) then
    // unescape SQL quoted string value into a valid JSON string
    with DefaultTextWriterJSONClass.CreateOwnedStream(temp) do
    try
      Add('{','"');
      AddNoJSONEscapeUTF8(Name);
      Add('"',':');
      AddQuotedStringAsJSON(SQLValue);
      Add('}');
      SetText(result);
    finally
      Free;
    end else
    // Value is a number or null/true/false
    result := '{"'+Name+'":'+SQLValue+'}';
end;

procedure TValuePUTF8Char.ToUTF8(var Text: RawUTF8);
begin
  FastSetString(Text,Value,ValueLen);
end;

function TValuePUTF8Char.ToUTF8: RawUTF8;
begin
  FastSetString(result,Value,ValueLen);
end;

function TValuePUTF8Char.ToString: string;
begin
  UTF8DecodeToString(Value,ValueLen,result);
end;

function TValuePUTF8Char.ToInteger: PtrInt;
begin
  result := GetInteger(Value);
end;

function TValuePUTF8Char.ToCardinal: PtrUInt;
begin
  result := GetCardinal(Value);
end;

function TValuePUTF8Char.Idem(const Text: RawUTF8): boolean;
begin
  if length(Text)=ValueLen then
    result := IdemPropNameUSameLen(pointer(Text),Value,ValueLen) else
    result := false;
end;

procedure JSONDecode(var JSON: RawUTF8; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean);
begin
  JSONDecode(UniqueRawUTF8(JSON),Names,Values,HandleValuesAsObjectOrArray);
end;

procedure JSONDecode(var JSON: RawJSON; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean);
begin
  JSONDecode(UniqueRawUTF8(RawUTF8(JSON)),Names,Values,HandleValuesAsObjectOrArray);
end;

function JSONDecode(P: PUTF8Char; const Names: array of RawUTF8;
  Values: PValuePUTF8CharArray; HandleValuesAsObjectOrArray: Boolean): PUTF8Char;
var n, i: PtrInt;
    namelen, valuelen: integer;
    name, value: PUTF8Char;
    EndOfObject: AnsiChar;
begin
  result := nil;
  if Values=nil then
    exit; // avoid GPF
  n := length(Names);
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(Values[0],n*SizeOf(Values[0]),0);
  dec(n);
  if P=nil then
    exit;
  while P^<>'{' do
    if P^=#0 then
      exit else
      inc(P);
  inc(P); // jump {
  repeat
    name := GetJSONPropName(P,@namelen);
    if name=nil then
      exit;  // invalid JSON content
    value := GetJSONFieldOrObjectOrArray(P,nil,@EndOfObject,HandleValuesAsObjectOrArray,true,@valuelen);
    if not(EndOfObject in [',','}']) then
      exit; // invalid item separator
    for i := 0 to n do
      if (Values[i].Value=nil) and IdemPropNameU(Names[i],name,namelen) then begin
        Values[i].Value := value;
        Values[i].ValueLen := valuelen;
        break;
      end;
  until (P=nil) or (EndOfObject='}');
  if P=nil then // result=nil indicates failure -> points to #0 for end of text
    result := @NULCHAR else
    result := P;
end;

function JSONDecode(var JSON: RawUTF8; const aName: RawUTF8;
  wasString: PBoolean; HandleValuesAsObjectOrArray: Boolean): RawUTF8;
var P, Name, Value: PUTF8Char;
    NameLen, ValueLen: integer;
    EndOfObject: AnsiChar;
begin
  result := '';
  P := pointer(JSON);
  if P=nil then
    exit;
  while P^<>'{' do
    if P^=#0 then
      exit else
      inc(P);
  inc(P); // jump {
  repeat
    Name := GetJSONPropName(P,@NameLen);
    if Name=nil then
      exit;  // invalid JSON content
    Value := GetJSONFieldOrObjectOrArray(
      P,wasString,@EndOfObject,HandleValuesAsObjectOrArray,true,@ValueLen);
    if not(EndOfObject in [',','}']) then
      exit; // invalid item separator
    if IdemPropNameU(aName,Name,NameLen) then begin
      FastSetString(result,Value,ValueLen);
      exit;
    end;
  until (P=nil) or (EndOfObject='}');
end;

function JSONDecode(P: PUTF8Char; out Values: TNameValuePUTF8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean): PUTF8Char;
var n: PtrInt;
    field: TNameValuePUTF8Char;
    EndOfObject: AnsiChar;
begin
  {$ifdef FPC}
  Values := nil;
  {$endif}
  result := nil;
  n := 0;
  if P<>nil then begin
    while P^<>'{' do
      if P^=#0 then
        exit else
        inc(P);
    inc(P); // jump {
    repeat
      field.Name := GetJSONPropName(P,@field.NameLen);
      if field.Name=nil then
        exit;  // invalid JSON content
      field.Value := GetJSONFieldOrObjectOrArray(P,nil,@EndOfObject,
        HandleValuesAsObjectOrArray,true,@field.ValueLen);
      if not(EndOfObject in [',','}']) then
        exit; // invalid item separator
      if n=length(Values) then
        SetLength(Values,n+32);
      Values[n] := field;
      inc(n);
    until (P=nil) or (EndOfObject='}');
  end;
  SetLength(Values,n);
  if P=nil then // result=nil indicates failure -> points to #0 for end of text
    result := @NULCHAR else
    result := P;
end;

function JSONRetrieveStringField(P: PUTF8Char; out Field: PUTF8Char;
  out FieldLen: integer; ExpectNameField: boolean): PUTF8Char;
begin
  result := nil;
  // retrieve string field
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if P^<>'"' then exit;
  Field := P+1;
  P := GotoEndOfJSONString(P);
  if P^<>'"' then
    exit; // here P^ should be '"'
  FieldLen := P-Field;
  // check valid JSON delimiter
  repeat inc(P) until (P^>' ') or (P^=#0);
  if ExpectNameField then begin
    if P^<>':' then
      exit; // invalid name field
  end else
    if not (P^ in ['}',',']) then
      exit; // invalid value field
  result := P; // return either ':' for name field, either '}',',' for value
end;

/// decode a JSON field into an UTF-8 encoded buffer, stored inplace of JSON data
function GetJSONField(P: PUTF8Char; out PDest: PUTF8Char;
  wasString: PBoolean; EndOfObject: PUTF8Char; Len: PInteger): PUTF8Char;
var D: PUTF8Char;
    b,c4,surrogate,j: integer;
    tab: {$ifdef CPUX86NOTPIC}TNormTableByte absolute ConvertHexToBin{$else}PNormTableByte{$endif};
label slash,num;
begin
  if wasString<>nil then
    wasString^ := false; // not a string by default
  PDest := nil; // PDest=nil indicates error or unexpected end (#0)
  result := nil;
  if P=nil then exit;
  if P^<=' ' then repeat inc(P); if P^=#0 then exit; until P^>' ';
  case P^ of
  'n':
    if (PInteger(P)^=NULL_LOW) and (P[4] in EndOfJSONValueField)  then begin
      result := nil; // null -> returns nil and wasString=false
      if Len<>nil then
        Len^ := 0; // when result is converted to string
      inc(P,4);
    end else
      exit; // PDest=nil to indicate error
  'f':
    if (PInteger(P+1)^=ord('a')+ord('l')shl 8+ord('s')shl 16+ord('e')shl 24) and
       (P[5] in EndOfJSONValueField) then begin
      result := P; // false -> returns 'false' and wasString=false
      if Len<>nil then
        Len^ := 5;
      inc(P,5);
    end else
      exit; // PDest=nil to indicate error
  't':
    if (PInteger(P)^=TRUE_LOW) and (P[4] in EndOfJSONValueField) then begin
      result := P; // true -> returns 'true' and wasString=false
      if Len<>nil then
        Len^ := 4;
      inc(P,4);
    end else
      exit; // PDest=nil to indicate error
  '"': begin
    // '"string \"\\field"' -> 'string "\field'
    if wasString<>nil then
      wasString^ := true;
    inc(P);
    result := P;
    D := P;
    repeat // unescape P^ into U^ (cf. http://www.ietf.org/rfc/rfc4627.txt)
      case P^ of
      #0:  exit;  // leave PDest=nil for unexpected end
      '"': break; // end of string
      '\': goto slash;
      else begin
        D^ := P^; // 3 stages pipelined process of unescaped chars
        inc(P);
        inc(D);
        case P^ of
        #0:  exit;
        '"': break;
        '\': goto slash;
        else begin
          D^ := P^;
          inc(P);
          inc(D);
          case P^ of
          #0:  exit;
          '"': break;
          '\': goto slash;
          else begin
            D^ := P^;
            inc(P);
            inc(D);
            continue;
          end;
          end;
        end;
        end;
      end;
      end;
slash:inc(P);
      case P^ of // unescape JSON string
        #0: exit; // to avoid potential buffer overflow issue for \#0
        'b': D^ := #08;
        't': D^ := #09;
        'n': D^ := #$0a;
        'f': D^ := #$0c;
        'r': D^ := #$0d;
        'u': begin // inlined decoding of '\u0123' UTF-16 codepoint into UTF-8
          {$ifndef CPUX86NOTPIC}tab := @ConvertHexToBin;{$endif} // faster on PIC and x86_64
          c4 := tab[ord(P[1])];
          if c4<=15 then begin
            b := tab[ord(P[2])];
            if b<=15 then begin
              c4 := c4 shl 4+b;
              b := tab[ord(P[3])];
              if b<=15 then begin
                c4 := c4 shl 4+b;
                b := tab[ord(P[4])];
                if b<=15 then begin
                  c4 := c4 shl 4+b;
                  case c4 of
                  0: begin
                    D^ := '?'; // \u0000 is an invalid value
                    inc(D);
                  end;
                  1..$7f: begin
                    D^ := AnsiChar(c4);
                    inc(D);
                  end;
                  $80..$7ff: begin
                    D[0] := AnsiChar($C0 or (c4 shr 6));
                    D[1] := AnsiChar($80 or (c4 and $3F));
                    inc(D,2);
                  end;
                  UTF16_HISURROGATE_MIN..UTF16_LOSURROGATE_MAX:
                    if PWord(P+5)^=ord('\')+ord('u') shl 8 then begin
                      inc(P,6);
                      surrogate := (tab[ord(P[1])] shl 12)+
                                   (tab[ord(P[2])] shl 8)+
                                   (tab[ord(P[3])] shl 4)+
                                    tab[ord(P[4])]; // optimistic approach
                      case c4 of // inlined UTF16CharToUtf8()
                      UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX:
                        c4 := ((c4-$D7C0)shl 10)+(surrogate xor UTF16_LOSURROGATE_MIN);
                      UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX:
                        c4 := ((surrogate-$D7C0)shl 10)+(c4 xor UTF16_LOSURROGATE_MIN);
                      end;
                      case c4 of
                      0..$7ff: b := 2;
                      $800..$ffff: b := 3;
                      $10000..$1FFFFF: b := 4;
                      $200000..$3FFFFFF: b := 5;
                      else b := 6;
                      end;
                      for j := b-1 downto 1 do begin
                        D[j] := AnsiChar((c4 and $3f)+$80);
                        c4 := c4 shr 6;
                      end;
                      D^ := AnsiChar(Byte(c4) or UTF8_FIRSTBYTE[b]);
                      inc(D,b);
                    end else begin
                      D^ := '?'; // unexpected surrogate without its pair
                      inc(D);
                    end;
                  else begin
                    D[0] := AnsiChar($E0 or (c4 shr 12));
                    D[1] := AnsiChar($80 or ((c4 shr 6) and $3F));
                    D[2] := AnsiChar($80 or (c4 and $3F));
                    inc(D,3);
                  end;
                  end;
                  inc(P,5);
                  continue;
                end;
              end;
            end;
          end;
          D^ := '?'; // bad formated hexa number -> '?0123'
        end;
        else D^ := P^; // litterals: '\"' -> '"'
      end;
      inc(P);
      inc(D);
    until false;
    // here P^='"'
    D^ := #0; // make zero-terminated
    if Len<>nil then
      Len^ := D-result;
    inc(P);
    if P^=#0 then
      exit;
  end;
  '0':
    if P[1] in ['0'..'9'] then // 0123 excluded by JSON!
      exit else // leave PDest=nil for unexpected end
      goto num; // may be 0.123
  '-','1'..'9': begin // numerical field: all chars before end of field
num:result := P;
    repeat
      if not (P^ in DigitFloatChars) then
        break;
      inc(P);
    until false;
    if P^=#0 then
      exit;
    if Len<>nil then
      Len^ := P-result;
    if P^<=' ' then begin
      P^ := #0; // force numerical field with no trailing ' '
      inc(P);
    end;
  end;
  else exit; // PDest=nil to indicate error
  end;
  while not (P^ in EndOfJSONField) do begin
    if P^=#0 then
      exit; // leave PDest=nil for unexpected end
    inc(P);
  end;
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  P^ := #0; // make zero-terminated
  PDest := @P[1];
  if P[1]=#0 then
    PDest := nil;
end;

function GetJSONPropName(var P: PUTF8Char; Len: PInteger): PUTF8Char;
var Name: PUTF8Char;
    wasString: boolean;
    EndOfObject: AnsiChar;
begin // should match GotoNextJSONObjectOrArray() and JsonPropNameValid()
  result := nil;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  Name := P; // put here to please some versions of Delphi compiler
  case P^ of
  '_','A'..'Z','a'..'z','0'..'9','$': begin // e.g. '{age:{$gt:18}}'
    repeat
      inc(P);
    until not (ord(P[0]) in IsJsonIdentifier);
    if Len<>nil then
      Len^ := P-Name;
    if (P^<=' ') and (P^<>#0) then begin
      P^ := #0;
      inc(P);
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    if not (P^ in [':','=']) then // allow both age:18 and age=18 pairs
      exit;
    P^ := #0;
    inc(P);
  end;
  '''': begin // single quotes won't handle nested quote character
    inc(P);
    Name := P;
    while P^<>'''' do
      if P^<' ' then
        exit else
        inc(P);
    if Len<>nil then
      Len^ := P-Name;
    P^ := #0;
    repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then
      exit;
    inc(P);
  end;
  '"': begin
    Name := GetJSONField(P,P,@wasString,@EndOfObject,Len);
    if (Name=nil) or not wasString or (EndOfObject<>':') then
      exit;
  end else
    exit;
  end;
  result := Name;
end;

procedure GetJSONPropName(var P: PUTF8Char; out PropName: shortstring);
var Name: PAnsiChar;
begin // match GotoNextJSONObjectOrArray() and overloaded GetJSONPropName()
  PropName[0] := #0;
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  Name := pointer(P);
  case P^ of
  '_','A'..'Z','a'..'z','0'..'9','$': begin // e.g. '{age:{$gt:18}}'
    repeat
      inc(P);
    until not (ord(P^) in IsJsonIdentifier);
    SetString(PropName,Name,P-Name);
    while (P^<=' ') and (P^<>#0) do inc(P);
    if not (P^ in [':','=']) then begin // allow both age:18 and age=18 pairs
      PropName[0] := #0;
      exit;
    end;
    inc(P);
  end;
  '''': begin // single quotes won't handle nested quote character
    inc(P);
    inc(Name);
    while P^<>'''' do
      if P^<' ' then
        exit else
        inc(P);
    SetString(PropName,Name,P-Name);
    repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then begin
      PropName[0] := #0;
      exit;
    end;
    inc(P);
  end;
  '"': begin
    inc(Name);
    P := GotoEndOfJSONString(P); // won't unescape JSON strings
    if P^<>'"' then
      exit;
    SetString(PropName,Name,P-Name);
    repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then begin
      PropName[0] := #0;
      exit;
    end;
    inc(P);
  end else
    exit;
  end;
end;

function GotoNextJSONPropName(P: PUTF8Char): PUTF8Char;
label s;
begin  // should match GotoNextJSONObjectOrArray()
  while (P^<=' ') and (P^<>#0) do inc(P);
  result := nil;
  if P=nil then
    exit;
  case P^ of
  '_','A'..'Z','a'..'z','0'..'9','$': begin // e.g. '{age:{$gt:18}}'
    repeat
      inc(P);
    until not (ord(P^) in IsJsonIdentifier);
    if (P^<=' ') and (P^<>#0) then
      inc(P);
    while (P^<=' ') and (P^<>#0) do inc(P);
    if not (P^ in [':','=']) then // allow both age:18 and age=18 pairs
      exit;
  end;
  '''': begin // single quotes won't handle nested quote character
    inc(P);
    while P^<>'''' do
      if P^<' ' then
        exit else
        inc(P);
    goto s;
  end;
  '"': begin
    P := GotoEndOfJSONString(P);
    if P^<>'"' then
      exit;
s:  repeat inc(P) until (P^>' ') or (P^=#0);
    if P^<>':' then
      exit;
  end else
    exit;
  end;
  repeat inc(P) until (P^>' ') or (P^=#0);
  result := P;
end;

function GetJSONFieldOrObjectOrArray(var P: PUTF8Char; wasString: PBoolean;
  EndOfObject: PUTF8Char; HandleValuesAsObjectOrArray: Boolean;
  NormalizeBoolean: Boolean; Len: PInteger): PUTF8Char;
var Value: PUTF8Char;
    wStr: boolean;
begin
  result := nil;
  if P=nil then
    exit;
  while ord(P^) in [1..32] do inc(P);
  if HandleValuesAsObjectOrArray and (P^ in ['{','[']) then begin
    Value := P;
    P := GotoNextJSONObjectOrArray(P);
    if P=nil then
      exit; // invalid content
    if Len<>nil then
      Len^ := P-Value;
    if wasString<>nil then
      wasString^ := false; // was object or array
    while ord(P^) in [1..32] do inc(P);
    if EndOfObject<>nil then
     EndOfObject^ := P^;
    P^ := #0; // make zero-terminated
    if P[1]=#0 then
      P := nil else
      inc(P);
    result := Value;
  end else begin
    result := GetJSONField(P,P,@wStr,EndOfObject,Len);
    if wasString<>nil then
      wasString^ := wStr;
    if not wStr and NormalizeBoolean and (result<>nil) then begin
      if PInteger(result)^=TRUE_LOW then
        result := '1' else   // normalize true -> 1
      if PInteger(result)^=FALSE_LOW then
        result := '0' else   // normalize false -> 0
        exit;
      if Len<>nil then
        Len^ := 1;
    end;
  end;
end;

function IsString(P: PUTF8Char): boolean;  // test if P^ is a "string" value
begin
  if P=nil then begin
    result := false;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  if (P[0] in ['0'..'9']) or // is first char numeric?
     ((P[0] in ['-','+']) and (P[1] in ['0'..'9'])) then begin
    // check if P^ is a true numerical value
    repeat inc(P) until not (P^ in ['0'..'9']); // check digits
    if P^='.' then
      repeat inc(P) until not (P^ in ['0'..'9']); // check fractional digits
    if (P^ in ['e','E']) and (P[1] in DigitChars) then begin
      inc(P);
      if P^='+' then inc(P) else
      if P^='-' then inc(P);
      while P^ in ['0'..'9'] do inc(P);
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    result := (P^<>#0);
    exit;
  end else
    result := true; // don't begin with a numerical value -> must be a string
end;

function IsStringJSON(P: PUTF8Char): boolean;  // test if P^ is a "string" value
var c4: integer;
begin
  if P=nil then begin
    result := false;
    exit;
  end;
  while (P^<=' ') and (P^<>#0) do inc(P);
  c4 := PInteger(P)^;
  if (((c4=NULL_LOW)or(c4=TRUE_LOW)) and (P[4] in EndOfJSONValueField)) or
     ((c4=FALSE_LOW) and (P[4]='e') and (P[5] in EndOfJSONValueField)) then begin
    result := false; // constants are no string
    exit;
  end else
  if (P[0] in ['1'..'9']) or // is first char numeric?
     ((P[0]='0') and not (P[1] in ['0'..'9'])) or // '012' excluded by JSON
     ((P[0]='-') and (P[1] in ['0'..'9'])) then begin
    // check if P^ is a true numerical value
    repeat inc(P) until not (P^ in ['0'..'9']); // check digits
    if P^='.' then
      repeat inc(P) until not (P^ in ['0'..'9']); // check fractional digits
    if (P^ in ['e','E']) and (P[1] in DigitChars) then begin
      inc(P);
      if P^='+' then inc(P) else
      if P^='-' then inc(P);
      while P^ in ['0'..'9'] do inc(P);
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    result := (P^<>#0);
    exit;
  end else
    result := true; // don't begin with a numerical value -> must be a string
end;

function GotoEndJSONItem(P: PUTF8Char): PUTF8Char;
begin
  result := nil; // to notify unexpected end
  if P=nil then
    exit;
  while (P^<=' ') and (P^<>#0) do inc(P);
  // get a field
  case P^ of
  #0: exit;
  '"': begin
    P := GotoEndOfJSONString(P);
    if P^<>'"' then
      exit; // P^ should be '"' here -> execute repeat.. below
  end;
  '[','{': begin
    P := GotoNextJSONObjectOrArray(P);
    if P=nil then
      exit;
    while (P^<=' ') and (P^<>#0) do inc(P);
    if P^<>#0 then
      result := P;
    exit;
  end;
  end;
  repeat // numeric or true/false/null or MongoDB extended {age:{$gt:18}}
    inc(P);
    if P^=#0 then exit; // unexpected end
  until P^ in [':',',',']','}'];
  if P^=#0 then
    exit;
  result := P;
end;

procedure GetJSONItemAsRawJSON(var P: PUTF8Char; var result: RawJSON;
  EndOfObject: PAnsiChar);
var B: PUTF8Char;
begin
  result := '';
  if P=nil then
    exit;
  B := P;
  P := GotoEndJSONItem(B);
  if P=nil then
    exit;
  FastSetString(RawUTF8(result),B,P-B);
  while (P^<=' ') and (P^<>#0) do inc(P);
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  if P^<>#0 then //if P^=',' then
    repeat inc(P) until (P^>' ') or (P^=#0);
end;

function GetJSONItemAsRawUTF8(var P: PUTF8Char; var output: RawUTF8;
  wasString: PBoolean; EndOfObject: PUTF8Char): boolean;
var V: PUTF8Char;
    VLen: integer;
begin
  V := GetJSONFieldOrObjectOrArray(P,wasstring,EndOfObject,true,true,@VLen);
  if V=nil then // parsing error
    result := false else begin
    FastSetString(output,V,VLen);
    result := true;
  end;
end;

function GotoNextJSONItem(P: PUTF8Char; NumberOfItemsToJump: cardinal;
  EndOfObject: PAnsiChar): PUTF8Char;
label next;
begin
 result := nil; // to notify unexpected end
 while NumberOfItemsToJump>0 do begin
   while (P^<=' ') and (P^<>#0) do inc(P);
   // get a field
   case P^ of
   #0: exit;
   '"': begin
     P := GotoEndOfJSONString(P);
     if P^<>'"' then
       exit; // P^ should be '"' here
   end;
   '[','{': begin
     P := GotoNextJSONObjectOrArray(P);
     if P=nil then
       exit;
     while (P^<=' ') and (P^<>#0) do inc(P);
     goto next;
   end;
   end;
   repeat // numeric or true/false/null or MongoDB extended {age:{$gt:18}}
     inc(P);
     if P^=#0 then exit; // unexpected end
   until P^ in [':',',',']','}'];
next:
   if P^=#0 then
     exit;
   if EndOfObject<>nil then
     EndOfObject^ := P^;
   inc(P);
   dec(NumberOfItemsToJump);
 end;
 result := P;
end;

function GotoNextJSONObjectOrArrayInternal(P,PMax: PUTF8Char; EndChar: AnsiChar): PUTF8Char;
label Prop;
begin // should match GetJSONPropName()
  result := nil;
  repeat
    case P^ of
    '{','[': begin
      if PMax=nil then
        P := GotoNextJSONObjectOrArray(P) else
        P := GotoNextJSONObjectOrArrayMax(P,PMax);
      if P=nil then exit;
    end;
    ':': if EndChar<>'}' then exit else inc(P); // syntax for JSON object only
    ',': inc(P); // comma appears in both JSON objects and arrays
    '}': if EndChar='}' then break else exit;
    ']': if EndChar=']' then break else exit;
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '-','+','0'..'9': // '0123' excluded by JSON, but not here
      repeat
        inc(P);
      until not (P^ in DigitFloatChars);
    't': if PInteger(P)^=TRUE_LOW then inc(P,4) else goto Prop;
    'f': if PInteger(P)^=FALSE_LOW then inc(P,5) else goto Prop;
    'n': if PInteger(P)^=NULL_LOW then inc(P,4) else goto Prop;
    '''': begin
      repeat inc(P); if P^<=' ' then exit; until P^='''';
      repeat inc(P) until (P^>' ') or (P^=#0);
      if P^<>':' then exit;
    end;
    '/': begin
      repeat // allow extended /regex/ syntax
        inc(P);
        if P^=#0 then
          exit;
      until P^='/';
      repeat inc(P) until (P^>' ') or (P^=#0);
    end;
    else begin
Prop: if not (ord(P^) in IsJsonIdentifierFirstChar) then
        exit; // expect e.g. '{age:{$gt:18}}'
      repeat
        inc(P);
      until not (ord(P^) in IsJsonIdentifier);
      while (P^<=' ') and (P^<>#0) do inc(P);
      if P^='(' then begin // handle e.g. "born":isodate("1969-12-31")
        inc(P);
        while (P^<=' ') and (P^<>#0) do inc(P);
        if P^='"' then begin
         P := GotoEndOfJSONString(P);
         if P^<>'"' then
          exit;
        end;
        inc(P);
        while (P^<=' ') and (P^<>#0) do inc(P);
        if P^<>')' then
          exit;
        inc(P);
       end
       else
       if P^<>':' then exit;
    end;
    end;
    while (P^<=' ') and (P^<>#0) do inc(P);
    if (PMax<>nil) and (P>=PMax) then
      exit;
  until P^=EndChar;
  result := P+1;
end;

function GotoNextJSONObjectOrArray(P: PUTF8Char): PUTF8Char;
var EndChar: AnsiChar;
begin // should match GetJSONPropName()
  result := nil; // mark error or unexpected end (#0)
  while (P^<=' ') and (P^<>#0) do inc(P);
  case P^ of
  '[': EndChar := ']';
  '{': EndChar := '}';
  else exit;
  end;
  repeat inc(P) until (P^>' ') or (P^=#0);
  result := GotoNextJSONObjectOrArrayInternal(P,nil,EndChar);
end;

function GotoNextJSONObjectOrArray(P: PUTF8Char; EndChar: AnsiChar): PUTF8Char;
begin // should match GetJSONPropName()
  while (P^<=' ') and (P^<>#0) do inc(P);
  result := GotoNextJSONObjectOrArrayInternal(P,nil,EndChar);
end;

function GotoNextJSONObjectOrArrayMax(P,PMax: PUTF8Char): PUTF8Char;
var EndChar: AnsiChar;
begin // should match GetJSONPropName()
  result := nil; // mark error or unexpected end (#0)
  while (P^<=' ') and (P^<>#0) do inc(P);
  case P^ of
  '[': EndChar := ']';
  '{': EndChar := '}';
  else exit;
  end;
  repeat inc(P) until (P^>' ') or (P^=#0);
  result := GotoNextJSONObjectOrArrayInternal(P,PMax,EndChar);
end;

function JSONArrayCount(P: PUTF8Char): integer;
var n: integer;
begin
  result := -1;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>']' then
  repeat
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        exit; // invalid content
    end;
    end;
    while not (P^ in [#0,',',']']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  until false;
  if P^=']' then
    result := n;
end;

function JSONArrayDecode(P: PUTF8Char; out Values: TPUTF8CharDynArray): boolean;
var n,max: integer;
begin
  result := false;
  max := 0;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>']' then
  repeat
    if max=n then begin
      max := NextGrow(max);
      SetLength(Values,max);
    end;
    Values[n] := P;
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        exit; // invalid content
    end;
    end;
    while not (P^ in [#0,',',']']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  until false;
  if P^=']' then begin
    SetLength(Values,n);
    result := true;
  end else
    Values := nil;
end;

function JSONArrayItem(P: PUTF8Char; Index: integer): PUTF8Char;
begin
  if P<>nil then begin
    P := GotoNextNotSpace(P);
    if P^='[' then begin
      P := GotoNextNotSpace(P+1);
      if P^<>']' then
      repeat
        if Index<=0 then begin
          result := P;
          exit;
        end;
        case P^ of
        '"': begin
          P := GotoEndOfJSONString(P);
          if P^<>'"' then
            break; // invalid content
          inc(P);
        end;
        '{','[': begin
          P := GotoNextJSONObjectOrArray(P);
          if P=nil then
            break; // invalid content
        end;
        end;
        while not (P^ in [#0,',',']']) do inc(P);
        if P^<>',' then break;
        repeat inc(P) until (P^>' ') or (P^=#0);
        dec(Index);
      until false;
    end;
  end;
  result := nil;
end;

function JSONArrayCount(P,PMax: PUTF8Char): integer;
var n: integer;
begin
  result := -1;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>']' then
  while P<PMax do begin
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArrayMax(P,PMax);
      if P=nil then
        exit; // invalid content or PMax reached
      end;
    end;
    while not (P^ in [#0,',',']']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  end;
  if P^=']' then
    result := n;
end;

function JSONObjectPropCount(P: PUTF8Char): integer;
var n: integer;
begin
  result := -1;
  n := 0;
  P := GotoNextNotSpace(P);
  if P^<>'}' then
  repeat
    P := GotoNextJSONPropName(P);
    if P=nil then
      exit;
    case P^ of
    '"': begin
      P := GotoEndOfJSONString(P);
      if P^<>'"' then
        exit;
      inc(P);
    end;
    '{','[': begin
      P := GotoNextJSONObjectOrArray(P);
      if P=nil then
        exit; // invalid content
    end;
    end;
    while not (P^ in [#0,',','}']) do inc(P);
    inc(n);
    if P^<>',' then break;
    repeat inc(P) until (P^>' ') or (P^=#0);
  until false;
  if P^='}' then
    result := n;
end;

function JsonObjectItem(P: PUTF8Char; const PropName: RawUTF8;
  PropNameFound: PRawUTF8): PUTF8Char;
var name: shortstring; // no memory allocation nor P^ modification
    PropNameLen: integer;
    PropNameUpper: array[byte] of AnsiChar;
begin
  if P<>nil then begin
    P := GotoNextNotSpace(P);
    PropNameLen := length(PropName);
    if PropNameLen<>0 then begin
      if PropName[PropNameLen]='*' then begin
        UpperCopy255Buf(PropNameUpper,pointer(PropName),PropNameLen-1)^ := #0;
        PropNameLen := 0;
      end;
      if P^='{' then
        P := GotoNextNotSpace(P+1);
      if P^<>'}' then
      repeat
        GetJSONPropName(P,name);
        if (name[0]=#0) or (name[0]>#200) then
          break;
        while (P^<=' ') and (P^<>#0) do inc(P);
        if PropNameLen=0 then begin
          name[ord(name[0])+1] := #0; // make ASCIIZ
          if IdemPChar(@name[1],PropNameUpper) then begin
            if PropNameFound<>nil then
              FastSetString(PropNameFound^,@name[1],ord(name[0]));
            result := P;
            exit;
          end;
        end else
        if IdemPropName(name,pointer(PropName),PropNameLen) then begin
          result := P;
          exit;
        end;
        case P^ of
        '"': begin
          P := GotoEndOfJSONString(P);
          if P^<>'"' then
            break; // invalid content
          inc(P);
        end;
        '{','[': begin
          P := GotoNextJSONObjectOrArray(P);
          if P=nil then
            break; // invalid content
        end;
        end;
        while not (P^ in [#0,',','}']) do inc(P);
        if P^<>',' then break;
        repeat inc(P) until (P^>' ') or (P^=#0);
      until false;
    end;
  end;
  result := nil;
end;

function JsonObjectByPath(JsonObject,PropPath: PUTF8Char): PUTF8Char;
var objName: RawUTF8;
begin
  result := nil;
  if (JsonObject=nil) or (PropPath=nil) then
    exit;
  repeat
    GetNextItem(PropPath,'.',objName);
    if objName='' then
      exit;
    JsonObject := JsonObjectItem(JsonObject,objName);
    if JsonObject=nil then
      exit;
  until PropPath=nil; // found full name scope
  result := JsonObject;
end;

function JsonObjectsByPath(JsonObject,PropPath: PUTF8Char): RawUTF8;
var itemName,objName,propNameFound,objPath: RawUTF8;
    start,ending,obj: PUTF8Char;
    WR: TTextWriter;
    temp: TTextWriterStackBuffer;
  procedure AddFromStart(const name: RaWUTF8);
  begin
    start := GotoNextNotSpace(start);
    ending := GotoEndJSONItem(start);
    if ending=nil then
      exit;
    if WR=nil then begin
      WR := TTextWriter.CreateOwnedStream(temp);
      WR.Add('{');
    end else
      WR.Add(',');
    WR.AddFieldName(name);
    while (ending>start) and (ending[-1]<=' ') do dec(ending); // trim right
    WR.AddNoJSONEscape(start,ending-start);
  end;
begin
  result := '';
  if (JsonObject=nil) or (PropPath=nil) then
    exit;
  WR := nil;
  try
    repeat
      GetNextItem(PropPath,',',itemName);
      if itemName='' then
        break;
      if itemName[length(itemName)]<>'*' then begin
        start := JsonObjectByPath(JsonObject,pointer(itemName));
        if start<>nil then
          AddFromStart(itemName);
      end else begin
        objPath := '';
        obj := pointer(itemName);
        repeat
          GetNextItem(obj,'.',objName);
          if objName='' then
            exit;
          propNameFound := '';
          JsonObject := JsonObjectItem(JsonObject,objName,@propNameFound);
          if JsonObject=nil then
            exit;
          if obj=nil then begin // found full name scope
            start := JsonObject;
            repeat
              AddFromStart(objPath+propNameFound);
              ending := GotoNextNotSpace(ending);
              if ending^<>',' then
                break;
              propNameFound := '';
              start := JsonObjectItem(GotoNextNotSpace(ending+1),objName,@propNameFound);
            until start=nil;
            break;
          end else
            objPath := objPath+objName+'.';
        until false;
      end;
    until PropPath=nil;
    if WR<>nil then begin
      WR.Add('}');
      WR.SetText(result);
    end;
  finally
    WR.Free;
  end;
end;

function JSONObjectAsJSONArrays(JSON: PUTF8Char; out keys,values: RawUTF8): boolean;
var wk,wv: TTextWriter;
    kb,ke,vb,ve: PUTF8Char;
    temp1,temp2: TTextWriterStackBuffer;
begin
  result := false;
  if (JSON=nil) or (JSON^<>'{') then
    exit;
  wk := TTextWriter.CreateOwnedStream(temp1);
  wv := TTextWriter.CreateOwnedStream(temp2);
  try
    wk.Add('[');
    wv.Add('[');
    kb := JSON+1;
    repeat
      ke := GotoEndJSONItem(kb);
      if (ke=nil) or (ke^<>':') then
        exit; // invalid input content
      vb := ke+1;
      ve := GotoEndJSONItem(vb);
      if (ve=nil) or not(ve^ in [',','}']) then
        exit;
      wk.AddNoJSONEscape(kb,ke-kb);
      wk.Add(',');
      wv.AddNoJSONEscape(vb,ve-vb);
      wv.Add(',');
      kb := ve+1;
    until ve^='}';
    wk.CancelLastComma;
    wk.Add(']');
    wk.SetText(keys);
    wv.CancelLastComma;
    wv.Add(']');
    wv.SetText(values);
    result := true;
  finally
    wv.Free;
    wk.Free;
  end;
end;

procedure RemoveCommentsFromJSON(P: PUTF8Char);
begin // replace comments by ' ' characters which will be ignored by parser
  if P<>nil then
  while P^<>#0 do begin
    case P^ of
      '"': begin
        P := GotoEndOfJSONString(P);
        if P^<>'"' then
          exit;
      end;
      '/': begin
         inc(P);
         case P^ of
           '/': begin // this is // comment - replace by ' '
             dec(P);
             repeat
               P^ := ' ';
               inc(P)
             until P^ in [#0, #10, #13];
           end;
           '*': begin // this is /* comment - replace by ' ' but keep CRLF
             P[-1] := ' ';
             repeat
               if not(P^ in [#10, #13]) then
                 P^ := ' '; // keep CRLF for correct line numbering (e.g. for error)
               inc(P);
               if PWord(P)^=ord('*')+ord('/')shl 8 then begin
                 PWord(P)^ := $2020;
                 inc(P,2);
                 break;
               end;
             until P^=#0;
           end;
         end;
      end;
    end;
    inc(P);
  end;
end;

procedure JSONBufferToXML(P: PUTF8Char; const Header,NameSpace: RawUTF8;
  out result: RawUTF8);
var i,j,L: integer;
    temp: TTextWriterStackBuffer;
begin
  if P=nil then
    result := Header else
    with TTextWriter.CreateOwnedStream(temp) do
    try
      AddNoJSONEscape(pointer(Header),length(Header));
      L := length(NameSpace);
      if L<>0 then
        AddNoJSONEscape(pointer(NameSpace),L);
      AddJSONToXML(P);
      if L<>0 then
        for i := 1 to L do
          if NameSpace[i]='<' then begin
            for j := i+1 to L do
              if NameSpace[j] in [' ','>'] then begin
                Add('<','/');
                AddStringCopy(NameSpace,i+1,j-i-1);
                Add('>');
                break;
              end;
            break;
          end;
      SetText(result);
    finally
      Free;
    end;
end;

function JSONToXML(const JSON: RawUTF8; const Header: RawUTF8;
  const NameSpace: RawUTF8): RawUTF8;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    JSONBufferToXML(tmp.buf,Header,NameSpace,result);
  finally
    tmp.Done;
  end;
end;

procedure JSONBufferReformat(P: PUTF8Char; out result: RawUTF8;
  Format: TTextWriterJSONFormat);
var temp: array[word] of byte; // 64KB buffer
begin
  if P<>nil then
    with TTextWriter.CreateOwnedStream(@temp,SizeOf(temp)) do
    try
      AddJSONReformat(P,Format,nil);
      SetText(result);
    finally
      Free;
    end;
end;

function JSONReformat(const JSON: RawUTF8; Format: TTextWriterJSONFormat): RawUTF8;
var tempIn: TSynTempBuffer;
    tempOut: TTextWriterStackBuffer;
begin
  tempIn.Init(JSON);
  with TTextWriter.CreateOwnedStream(tempOut) do
  try
    AddJSONReformat(tempIn.buf,Format,nil);
    SetText(result);
  finally
    Free;
    tempIn.Done;
  end;
end;

function JSONBufferReformatToFile(P: PUTF8Char; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;
var F: TFileStream;
    temp: array[word] of word; // 128KB
begin
  try
    F := TFileStream.Create(Dest,fmCreate);
    try
      with TTextWriter.Create(F,@temp,SizeOf(temp)) do
      try
        AddJSONReformat(P,Format,nil);
        FlushFinal;
      finally
        Free;
      end;
      result := true;
    finally
      F.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function JSONReformatToFile(const JSON: RawUTF8; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;
var tmp: TSynTempBuffer;
begin
  tmp.Init(JSON);
  try
    result := JSONBufferReformatToFile(tmp.buf,Dest,Format);
  finally
    tmp.Done;
  end;
end;


{ ************ some console functions }

var
  TextAttr: integer = ord(ccDarkGray);

{$ifdef MSWINDOWS}

procedure InitConsole;
begin
  if StdOut=0 then begin
   StdOut := GetStdHandle(STD_OUTPUT_HANDLE);
   if StdOut=INVALID_HANDLE_VALUE then
     StdOut := 0;
  end;
end;

procedure TextColor(Color: TConsoleColor);
var oldAttr: integer;
begin
  InitConsole;
  oldAttr := TextAttr;
  TextAttr := (TextAttr and $F0) or ord(Color);
  if TextAttr<>oldAttr then
    SetConsoleTextAttribute(StdOut,TextAttr);
end;

procedure TextBackground(Color: TConsoleColor);
var oldAttr: integer;
begin
  InitConsole;
  oldAttr := TextAttr;
  TextAttr := (TextAttr and $0F) or (ord(Color) shl 4);
  if TextAttr<>oldAttr then
    SetConsoleTextAttribute(StdOut,TextAttr);
end;

function ConsoleKeyPressed(ExpectedKey: Word): Boolean;
var lpNumberOfEvents: DWORD;
    lpBuffer: TInputRecord;
    lpNumberOfEventsRead : DWORD;
    nStdHandle: THandle;
begin
  result := false;
  nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  lpNumberOfEvents := 0;
  GetNumberOfConsoleInputEvents(nStdHandle,lpNumberOfEvents);
  if lpNumberOfEvents<>0 then begin
    PeekConsoleInput(nStdHandle,lpBuffer,1,lpNumberOfEventsRead);
    if lpNumberOfEventsRead<>0 then
      if lpBuffer.EventType=KEY_EVENT then
        if lpBuffer.Event.KeyEvent.bKeyDown and
           ((ExpectedKey=0) or (lpBuffer.Event.KeyEvent.wVirtualKeyCode=ExpectedKey)) then
          result := true else
          FlushConsoleInputBuffer(nStdHandle) else
        FlushConsoleInputBuffer(nStdHandle);
  end;
end;

procedure ConsoleWaitForEnterKey;
{$ifdef DELPHI5OROLDER}
begin
  readln;
end;
{$else}
var msg: TMsg;
begin
  while not ConsoleKeyPressed(VK_RETURN) do begin
    {$ifndef LVCL}
    if GetCurrentThreadID=MainThreadID then
      CheckSynchronize{$ifdef WITHUXTHEME}(1000){$endif}  else
    {$endif}
      WaitMessage;
    while PeekMessage(msg,0,0,0,PM_REMOVE) do
      if Msg.Message=WM_QUIT then
        exit else begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
  end;
end;
{$endif DELPHI5OROLDER}

{$else MSWINDOWS}

// we by-pass crt.pp since this unit cancels the SIGINT signal

{$I-}
procedure TextColor(Color: TConsoleColor);
const AnsiTbl : string[8]='04261537';
begin
{$ifdef FPC}{$ifdef Linux}
  if not stdoutIsTTY then
    exit;
{$endif}{$endif}
  if ord(color)=TextAttr then
    exit;
  TextAttr := ord(color);
  if ord(color)>=8 then
    write(#27'[1;3',AnsiTbl[(ord(color) and 7)+1],'m') else
    write(#27'[0;3',AnsiTbl[(ord(color) and 7)+1],'m');
  ioresult;
end;
{$I+}

procedure TextBackground(Color: TConsoleColor);
begin // not implemented yet - but not needed either
end;

procedure ConsoleWaitForEnterKey;
begin
  Readln;
end;

{$endif MSWINDOWS}

function Utf8ToConsole(const S: RawUTF8): RawByteString;
begin
  {$ifdef MSWINDOWS}
  result := TSynAnsiConvert.Engine(CP_OEMCP).UTF8ToAnsi(S);
  {$else}
  result := S; // expect a UTF-8 console under Linux
  {$endif}
end;

function StringToConsole(const S: string): RawByteString;
begin
  result := Utf8ToConsole(StringToUTF8(S));
end;

{$I-}
procedure ConsoleShowFatalException(E: Exception; WaitForEnterKey: boolean);
begin
  ioresult;
  TextColor(ccLightRed);
  write(#13#10'Fatal exception ');
  TextColor(ccWhite);
  write(E.ClassName);
  TextColor(ccLightRed);
  Writeln(' raised with message:');
  TextColor(ccLightMagenta);
  Writeln(' ',StringToConsole(E.Message));
  TextColor(ccLightGray);
  if WaitForEnterKey then begin
    writeln(#13#10'Program will now abort');
    {$ifndef LINUX}
    writeln('Press [Enter] to quit');
    if ioresult=0 then
      Readln;
    {$endif}
  end;
  ioresult;
end;
{$I+}


{$ifndef NOVARIANTS}

{ TCommandLine }

constructor TCommandLine.Create;
var i: integer;
    p, sw: RawUTF8;
begin
  inherited Create;
  fValues.InitFast(ParamCount shr 1,dvObject);
  for i := 1 to ParamCount do begin
    p := StringToUTF8(ParamStr(i));
    if p<>'' then
      if p[1] in ['-','/'] then begin
        if sw<>'' then
          fValues.AddValue(sw,true); // -flag -switch value -> flag=true
        sw := LowerCase(copy(p,2,100));
        if sw='noprompt' then begin
          fNoPrompt := true;
          sw := '';
        end;
      end else
        if sw<>'' then begin
          fValues.AddValueFromText(sw,p,true);
          sw := '';
        end;
  end;
  if sw<>'' then
    fValues.AddValue(sw,true); // trailing -flag
end;

constructor TCommandLine.Create(const switches: variant; aNoConsole: boolean);
begin
  inherited Create;
  fValues.InitCopy(switches,JSON_OPTIONS_FAST);
  fNoPrompt := true;
  fNoConsole := aNoConsole;
end;

constructor TCommandLine.Create(const NameValuePairs: array of const; aNoConsole: boolean);
begin
  inherited Create;
  fValues.InitObject(NameValuePairs,JSON_OPTIONS_FAST);
  fNoPrompt := true;
  fNoConsole := aNoConsole;
end;

constructor TCommandLine.CreateAsArray(firstParam: integer);
var i: integer;
begin
  inherited Create;
  fValues.InitFast(ParamCount,dvArray);
  for i := firstParam to ParamCount do
    fValues.AddItem(ParamStr(i));
end;

function TCommandLine.NoPrompt: boolean;
begin
  result := fNoPrompt;
end;

function TCommandLine.ConsoleText(const LineFeed: RawUTF8): RawUTF8;
begin
  result := RawUTF8ArrayToCSV(fLines,LineFeed);
end;

procedure TCommandLine.SetNoConsole(value: boolean);
begin
  if value=fNoConsole then
    exit;
  if value then
    fNoPrompt := true;
  fNoConsole := false;
end;

procedure TCommandLine.TextColor(Color: TConsoleColor);
begin
  if not fNoPrompt then
    SynCommons.TextColor(Color);
end;

procedure TCommandLine.Text(const Fmt: RawUTF8; const Args: array of const;
  Color: TConsoleColor);
var msg: RawUTF8;
begin
  FormatUTF8(Fmt,Args,msg);
  {$I-}
  if msg<>'' then begin
    TextColor(Color);
    AddRawUTF8(fLines,msg);
    if not fNoConsole then
      write(Utf8ToConsole(msg));
  end;
  if not fNoConsole then begin
    writeln;
    ioresult;
  end;
  {$I+}
end;

function TCommandLine.AsUTF8(const Switch, Default: RawUTF8;
  const Prompt: string): RawUTF8;
var i: integer;
begin
  i := fValues.GetValueIndex(Switch);
  if i>=0 then begin // found
    VariantToUTF8(fValues.Values[i],result);
    fValues.Delete(i);
    exit;
  end;
  result := Default;
  if fNoPrompt or (Prompt='') then
    exit;
  TextColor(ccLightGray);
  {$I-}
  writeln(Prompt);
  if ioresult<>0 then
    exit; // no console -> no prompt
  TextColor(ccCyan);
  write(Switch);
  if Default<>'' then
    write(' [',Default,'] ');
  write(': ');
  TextColor(ccWhite);
  readln(result);
  writeln;
  ioresult;
  {$I+}
  TextColor(ccLightGray);
  result := trim(result);
  if result='' then
    result := Default;
end;

function TCommandLine.AsInt(const Switch: RawUTF8; Default: Int64;
  const Prompt: string): Int64;
var res: RawUTF8;
begin
  res := AsUTF8(Switch, Int64ToUtf8(Default), Prompt);
  result := GetInt64Def(pointer(res),Default);
end;

function TCommandLine.AsDate(const Switch: RawUTF8; Default: TDateTime;
  const Prompt: string): TDateTime;
var res: RawUTF8;
begin
  res := AsUTF8(Switch, DateTimeToIso8601Text(Default), Prompt);
  if res='0' then begin
    result := 0;
    exit;
  end;
  result := Iso8601ToDateTime(res);
  if result=0 then
    result := Default;
end;

function TCommandLine.AsEnum(const Switch, Default: RawUTF8; TypeInfo: pointer;
  const Prompt: string): integer;
var res: RawUTF8;
begin
  res := AsUTF8(Switch, Default, Prompt);
  if not ToInteger(res,result) then
    result := GetEnumNameValue(TypeInfo,pointer(res),length(res),true);
end;

function TCommandLine.AsArray: TRawUTF8DynArray;
begin
  fValues.ToRawUTF8DynArray(result);
end;

function TCommandLine.AsJSON(Format: TTextWriterJSONFormat): RawUTF8;
begin
  result := fValues.ToJSON('','',Format);
end;

function TCommandLine.AsString(const Switch: RawUTF8; const Default, Prompt: string): string;
begin
  result := UTF8ToString(AsUTF8(Switch,StringToUTF8(Default),Prompt));
end;

{$endif NOVARIANTS}


{ ************ Unit-Testing classes and functions }

procedure KB(bytes: Int64; out result: TShort16; nospace: boolean);
type TUnits = (kb,mb,gb,tb,pb,eb,b);
const TXT: array[boolean,TUnits] of RawUTF8 =
    ((' KB',' MB',' GB',' TB',' PB',' EB','% B'), ('KB','MB','GB','TB','PB','EB','%B'));
var hi,rem: cardinal;
    u: TUnits;
begin
  if bytes<1 shl 10-(1 shl 10) div 10 then begin
    FormatShort16(TXT[nospace,b],[integer(bytes)],result);
    exit;
  end;
  if bytes<1 shl 20-(1 shl 20) div 10 then begin
    u := kb;
    rem := bytes;
    hi := bytes shr 10;
  end else
  if bytes<1 shl 30-(1 shl 30) div 10 then begin
    u := mb;
    rem := bytes shr 10;
    hi := bytes shr 20;
  end else
  if bytes<Int64(1) shl 40-(Int64(1) shl 40) div 10 then begin
    u := gb;
    rem := bytes shr 20;
    hi := bytes shr 30;
  end else
  if bytes<Int64(1) shl 50-(Int64(1) shl 50) div 10 then begin
    u := tb;
    rem := bytes shr 30;
    hi := bytes shr 40;
  end else
  if bytes<Int64(1) shl 60-(Int64(1) shl 60) div 10 then begin
    u := pb;
    rem := bytes shr 40;
    hi := bytes shr 50;
  end else begin
    u := eb;
    rem := bytes shr 50;
    hi := bytes shr 60;
  end;
  rem := rem and 1023;
  if rem<>0 then
    rem := rem div 102;
  if rem=10 then begin
    rem := 0;
    inc(hi); // round up as expected by (most) human beings
  end;
  if rem<>0 then
    FormatShort16('%.%%',[hi,rem,TXT[nospace,u]],result) else
    FormatShort16('%%',[hi,TXT[nospace,u]],result);
end;

function KB(bytes: Int64): TShort16;
begin
  KB(bytes,result,{nospace=}false);
end;

function KBNoSpace(bytes: Int64): TShort16;
begin
  KB(bytes,result,{nospace=}true);
end;

function KB(bytes: Int64; nospace: boolean): TShort16;
begin
  KB(bytes,result,nospace);
end;

function KB(const buffer: RawByteString): TShort16;
begin
  KB(length(buffer),result,{nospace=}false);
end;

procedure KBU(bytes: Int64; var result: RawUTF8);
var tmp: TShort16;
begin
  KB(bytes,tmp,{nospace=}false);
  FastSetString(result,@tmp[1],ord(tmp[0]));
end;

function IntToThousandString(Value: integer; const ThousandSep: TShort4): shortstring;
var i,L,Len: cardinal;
begin
  str(Value,result);
  L := length(result);
  Len := L+1;
  if Value<0 then
    dec(L,2) else // ignore '-' sign
    dec(L);
  for i := 1 to L div 3 do
    insert(ThousandSep,result,Len-i*3);
end;

function MicroSecToString(Micro: QWord): TShort16;
begin
  MicroSecToString(Micro,result);
end;

procedure MicroSecToString(Micro: QWord; out result: TShort16);
  procedure TwoDigitToString(value: cardinal; const u: shortstring; var result: TShort16);
  var d100: TDiv100Rec;
  begin
    if value<100 then
      FormatShort16('0.%%',[UInt2DigitsToShortFast(value),u],result) else begin
      Div100(value,d100);
      if d100.m=0 then
        FormatShort16('%%',[d100.d,u],result) else
        FormatShort16('%.%%',[d100.d,UInt2DigitsToShortFast(d100.m),u],result);
    end;
  end;
  procedure TimeToString(value: cardinal; const u: shortstring; var result: TShort16);
  var d: cardinal;
  begin
    d := value div 60;
    FormatShort16('%%%',[d,u,UInt2DigitsToShortFast(value-(d*60))],result);
  end;
begin
  if Int64(Micro)<=0 then
    result := '0us' else
  if Micro<1000 then
    FormatShort16('%us',[Micro],result) else
  if Micro<1000000 then
    TwoDigitToString({$ifdef CPU32}PCardinal(@Micro)^{$else}Micro{$endif} div 10,'ms',result) else
  if Micro<60000000 then
    TwoDigitToString({$ifdef CPU32}PCardinal(@Micro)^{$else}Micro{$endif} div 10000,'s',result) else
  if Micro<QWord(3600000000) then
    TimeToString({$ifdef CPU32}PCardinal(@Micro)^{$else}Micro{$endif} div 1000000,'m',result) else
  if Micro<QWord(86400000000*2) then
    TimeToString(Micro div 60000000,'h',result) else
    FormatShort16('%d',[Micro div QWord(86400000000)],result)
end;

function IsInitializedCriticalSection(const CS: TRTLCriticalSection): Boolean;
begin
  result := not IsZero(@CS,SizeOf(CS));
end;

procedure InitializeCriticalSectionIfNeededAndEnter(var CS: TRTLCriticalSection);
begin
  if IsZero(@CS,SizeOf(CS)) then
    InitializeCriticalSection(CS);
  EnterCriticalSection(CS);
end;

procedure DeleteCriticalSectionIfNeeded(var CS: TRTLCriticalSection);
begin
  if not IsZero(@CS,SizeOf(CS)) then
    DeleteCriticalSection(CS);
end;


{ ******************* process monitoring / statistics ********************** }

{ TPrecisionTimer }

function TPrecisionTimer.ByCount(Count: QWord): TShort16;
begin
  if Count=0 then
    result := '0' else // avoid div per 0 exception
    MicroSecToString(fTime div Count,result);
end;

function TPrecisionTimer.PerSec(const Count: QWord): QWord;
begin
  if fTime<=0 then // avoid negative value in case of incorrect Start/Stop sequence
    result := 0 else // avoid div per 0 exception
    result := (Count*1000000) div fTime;
end;

function TPrecisionTimer.SizePerSec(Size: QWord): shortstring;
begin
  FormatShort('% in % i.e. %/s',[KB(Size),Stop,KB(PerSec(Size))],result);
end;

{$ifdef FPC} {$push} {$endif} {$HINTS OFF} // avoid "loop executed zero times"
procedure TPrecisionTimer.Init;
begin
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(self,SizeOf(self),0);
end;

procedure TPrecisionTimer.Start;
begin
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(self,SizeOf(self),0);
  {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(fStart);
  fLast := fStart;
end;
{$ifdef FPC} {$pop} {$else} {$HINTS ON} {$endif}

function TPrecisionTimer.Started: boolean;
begin
  result := fStart <> 0;
end;

procedure TPrecisionTimer.ComputeTime;
begin
  {$ifdef LINUX}
  QueryPerformanceMicroSeconds(fStop);
  fTime := fStop-fStart;
  fLastTime := fStop-fLast;
  {$else}
  QueryPerformanceCounter(fStop);
  if fWinFreq=0 then begin
    QueryPerformanceFrequency(fWinFreq);
    if fWinFreq=0 then begin
      fTime := 0;
      fLastTime := 0;
      exit;
    end;
  end;
  {$ifdef DELPHI5OROLDER} // circumvent C1093 Error
  fTime := ((fStop-fStart)*1000000) div fWinFreq;
  if fLast=fStart then
    fLastTime := fTime else
    fLastTime := ((fStop-fLast)*1000000) div fWinFreq;
  {$else}
  fTime := (QWord(fStop-fStart)*QWord(1000000)) div QWord(fWinFreq);
  if fLast=fStart then
    fLastTime := fTime else
    fLastTime := (QWord(fStop-fLast)*QWord(1000000)) div QWord(fWinFreq);
  {$endif DELPHI5OROLDER}
  {$endif LINUX}
end;

procedure TPrecisionTimer.FromExternalMicroSeconds(const MicroSeconds: QWord);
begin
  fLastTime := MicroSeconds;
  inc(fTime,MicroSeconds);
end;

function TPrecisionTimer.FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
begin // mimics ComputeTime from already known elapsed time
  {$ifdef LINUX}
  FromExternalMicroSeconds(CounterDiff);
  {$else}
  if fWinFreq=0 then begin
    fTime := 0;
    fLastTime := 0;
    QueryPerformanceFrequency(fWinFreq);
  end;
  if fWinFreq<>0 then
    FromExternalMicroSeconds((CounterDiff*1000000)div PQWord(@fWinFreq)^);
  {$endif LINUX}
  result := fLastTime;
end;

function TPrecisionTimer.Stop: TShort16;
begin
  ComputeTime;
  MicroSecToString(fTime,result);
end;

procedure TPrecisionTimer.Pause;
begin
  {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(fResume);
  dec(fResume,fStart);
  inc(fPauseCount);
end;

procedure TPrecisionTimer.Resume;
begin
  {$ifdef LINUX}QueryPerformanceMicroSeconds{$else}QueryPerformanceCounter{$endif}(fStart);
  fLast := fStart;
  dec(fStart,fResume);
  fResume := 0;
end;

function TPrecisionTimer.Time: TShort16;
begin
  MicroSecToString(fTime,result);
end;

function TPrecisionTimer.LastTime: TShort16;
begin
  MicroSecToString(fLastTime,result);
end;


type
  /// a class used internaly by TPrecisionTimer.ProfileMethod
  TPrecisionTimerProfiler = class(TInterfacedObject)
  protected
    fTimer: PPrecisionTimer;
  public
    constructor Create(aTimer: PPrecisionTimer);
    destructor Destroy; override;
  end;

constructor TPrecisionTimerProfiler.Create(aTimer: PPrecisionTimer);
begin
  fTimer := aTimer;
end;

destructor TPrecisionTimerProfiler.Destroy;
begin
  if fTimer<>nil then
    fTimer^.Pause;
  inherited;
end;


function TPrecisionTimer.ProfileCurrentMethod: IUnknown;
begin
  if fStart=0 then
    Start else
    Resume;
  result := TPrecisionTimerProfiler.Create(@self);
end;


{ TLocalPrecisionTimer }

function TLocalPrecisionTimer.ByCount(Count: cardinal): RawUTF8;
begin
  result := fTimer.ByCount(Count);
end;

procedure TLocalPrecisionTimer.Pause;
begin
  fTimer.Pause;
end;

function TLocalPrecisionTimer.PerSec(Count: cardinal): cardinal;
begin
  result := fTimer.PerSec(Count);
end;

procedure TLocalPrecisionTimer.Resume;
begin
  fTimer.Resume;
end;

procedure TLocalPrecisionTimer.Start;
begin
  fTimer.Start;
end;

function TLocalPrecisionTimer.Stop: TShort16;
begin
  result := fTimer.Stop;
end;

constructor TLocalPrecisionTimer.CreateAndStart;
begin
  inherited;
  fTimer.Start;
end;

{ TSynMonitorTime }

function TSynMonitorTime.GetAsText: TShort16;
begin
  MicroSecToString(fMicroSeconds,result);
end;

function TSynMonitorTime.PerSecond(const Count: QWord): QWord;
begin
  if {$ifdef FPC}Int64(fMicroSeconds){$else}PInt64(@fMicroSeconds)^{$endif}<=0 then
    result := 0 else // avoid negative or div per 0
    result := (Count*1000000) div fMicroSeconds;
end;


{ TSynMonitorOneTime }

function TSynMonitorOneTime.GetAsText: TShort16;
begin
  MicroSecToString(fMicroSeconds,result);
end;

function TSynMonitorOneTime.PerSecond(const Count: QWord): QWord;
begin
  if {$ifdef FPC}Int64(fMicroSeconds){$else}PInt64(@fMicroSeconds)^{$endif}<=0 then
    result := 0 else
    result := (Count*QWord(1000000)) div fMicroSeconds;
end;


{ TSynMonitorSizeParent }

constructor TSynMonitorSizeParent.Create(aTextNoSpace: boolean);
begin
  inherited Create;
  fTextNoSpace := aTextNoSpace;
end;

{ TSynMonitorSize }

function TSynMonitorSize.GetAsText: TShort16;
begin
  KB(fBytes,result,fTextNoSpace);
end;

{ TSynMonitorOneSize }

function TSynMonitorOneSize.GetAsText: TShort16;
begin
  KB(fBytes,result,fTextNoSpace);
end;

{ TSynMonitorThroughput }

function TSynMonitorThroughput.GetAsText: TShort16;
begin
  FormatShort16('%/s',[KB(fBytesPerSec,fTextNoSpace)],result);
end;


{ TSynMonitor }

constructor TSynMonitor.Create;
begin
  inherited Create;
  fTotalTime := TSynMonitorTime.Create;
  fLastTime := TSynMonitorOneTime.Create;
  fMinimalTime := TSynMonitorOneTime.Create;
  fAverageTime := TSynMonitorOneTime.Create;
  fMaximalTime := TSynMonitorOneTime.Create;
end;

constructor TSynMonitor.Create(const aName: RawUTF8);
begin
  Create;
  fName := aName;
end;

destructor TSynMonitor.Destroy;
begin
  fMaximalTime.Free;
  fAverageTime.Free;
  fMinimalTime.Free;
  fLastTime.Free;
  fTotalTime.Free;
  inherited Destroy;
end;

procedure TSynMonitor.Lock;
begin
  fSafe^.Lock;
end;

procedure TSynMonitor.UnLock;
begin
  fSafe^.UnLock;
end;

procedure TSynMonitor.Changed;
begin // do nothing by default - overriden classes may track modified changes
end;

procedure TSynMonitor.ProcessStart;
begin
  if fProcessing then
    raise ESynException.CreateUTF8('Reentrant %.ProcessStart',[self]);
  fSafe^.Lock;
  try
    InternalTimer.Resume;
    fTaskStatus := taskNotStarted;
    fProcessing := true;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessDoTask;
begin
  fSafe^.Lock;
  try
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessStartTask;
begin
  if fProcessing then
    raise ESynException.CreateUTF8('Reentrant %.ProcessStart',[self]);
  fSafe^.Lock;
  try
    InternalTimer.Resume;
    fProcessing := true;
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessEnd;
begin
  fSafe^.Lock;
  try
    InternalTimer.Pause;
    InternalTimer.ComputeTime;
    LockedFromProcessTimer;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.LockedFromProcessTimer;
begin
  fTotalTime.MicroSec := InternalTimer.TimeInMicroSec;
  if fTaskStatus=taskStarted then begin
    fLastTime.MicroSec := InternalTimer.LastTimeInMicroSec;
    if (fMinimalTime.MicroSec=0) or
       (InternalTimer.LastTimeInMicroSec<fMinimalTime.MicroSec) then
      fMinimalTime.MicroSec := InternalTimer.LastTimeInMicroSec;
    if InternalTimer.LastTimeInMicroSec>fMaximalTime.MicroSec then
      fMaximalTime.MicroSec := InternalTimer.LastTimeInMicroSec;
    fTaskStatus := taskNotStarted;
  end;
  LockedPerSecProperties;
  fProcessing := false;
  Changed;
end;

function TSynMonitor.FromExternalQueryPerformanceCounters(const CounterDiff: QWord): QWord;
begin
  fSafe^.Lock;
  try // thread-safe ProcessStart+ProcessDoTask+ProcessEnd
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    result := InternalTimer.FromExternalQueryPerformanceCounters(CounterDiff);
    LockedFromProcessTimer;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.FromExternalMicroSeconds(const MicroSecondsElapsed: QWord);
begin
  fSafe^.Lock;
  try // thread-safe ProcessStart+ProcessDoTask+ProcessEnd
    inc(fTaskCount);
    fTaskStatus := taskStarted;
    InternalTimer.FromExternalMicroSeconds(MicroSecondsElapsed);
    LockedFromProcessTimer;
  finally
    fSafe^.UnLock;
  end;
end;

class procedure TSynMonitor.InitializeObjArray(var ObjArr; Count: integer);
var i: integer;
begin
  ObjArrayClear(ObjArr);
  SetLength(TPointerDynArray(ObjArr),Count);
  for i := 0 to Count-1 do
    TPointerDynArray(ObjArr)[i] := Create;
end;

procedure TSynMonitor.ProcessError(const info: variant);
begin
  fSafe^.Lock;
  try
    if not VarIsEmptyOrNull(info) then
      inc(fInternalErrors);
    fLastInternalError := info;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ProcessErrorFmt(const Fmt: RawUTF8; const Args: array of const);
begin
  ProcessError({$ifndef NOVARIANTS}RawUTF8ToVariant{$endif}(FormatUTF8(Fmt,Args)));
end;

procedure TSynMonitor.ProcessErrorRaised(E: Exception);
begin
  {$ifndef NOVARIANTS}if E.InheritsFrom(ESynException) then
    ProcessError(_ObjFast([E,ObjectToVariant(E,true)])) else{$endif}
    ProcessErrorFmt('%: %', [E,E.Message]);
end;

procedure TSynMonitor.ProcessErrorNumber(info: integer);
begin
  ProcessError(info);
end;

procedure TSynMonitor.LockedPerSecProperties;
begin
  if fTaskCount=0 then
    exit; // avoid division per zero
  fPerSec := fTotalTime.PerSecond(fTaskCount);
  fAverageTime.MicroSec := fTotalTime.MicroSec div fTaskCount;
end;

procedure TSynMonitor.Sum(another: TSynMonitor);
begin
  if (self=nil) or (another=nil) then
    exit;
  fSafe^.Lock;
  another.fSafe^.Lock;
  try
    LockedSum(another);
  finally
    another.fSafe^.UnLock;
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.LockedSum(another: TSynMonitor);
begin
  fTotalTime.MicroSec := fTotalTime.MicroSec+another.fTotalTime.MicroSec;
  if (fMinimalTime.MicroSec=0) or
     (another.fMinimalTime.MicroSec<fMinimalTime.MicroSec) then
    fMinimalTime.MicroSec := another.fMinimalTime.MicroSec;
  if another.fMaximalTime.MicroSec>fMaximalTime.MicroSec then
    fMaximalTime.MicroSec := another.fMaximalTime.MicroSec;
  inc(fTaskCount,another.fTaskCount);
  if another.Processing then
    fProcessing := true; // if any thread is active, whole daemon is active
  inc(fInternalErrors,another.Errors);
end;

procedure TSynMonitor.WriteDetailsTo(W: TTextWriter);
begin
  fSafe^.Lock;
  try
    W.WriteObject(self);
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitor.ComputeDetailsTo(W: TTextWriter);
begin
  fSafe^.Lock;
  try
    LockedPerSecProperties; // may not have been calculated after Sum()
    WriteDetailsTo(W);
  finally
    fSafe^.UnLock;
  end;
end;

function TSynMonitor.ComputeDetailsJSON: RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream(temp);
  try
    ComputeDetailsTo(W);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

{$ifndef NOVARIANTS}
function TSynMonitor.ComputeDetails: variant;
begin
  _Json(ComputeDetailsJSON,result,JSON_OPTIONS_FAST);
end;
{$endif}


{ TSynMonitorWithSize}

constructor TSynMonitorWithSize.Create;
begin
  inherited Create;
  fSize := TSynMonitorSize.Create({nospace=}false);
  fThroughput := TSynMonitorThroughput.Create({nospace=}false);
end;

destructor TSynMonitorWithSize.Destroy;
begin
  inherited Destroy;
  fThroughput.Free;
  fSize.Free;
end;

procedure TSynMonitorWithSize.LockedPerSecProperties;
begin
  inherited LockedPerSecProperties;
  fThroughput.BytesPerSec := fTotalTime.PerSecond(fSize.Bytes);
end;

procedure TSynMonitorWithSize.AddSize(const Bytes: QWord);
begin
  fSafe^.Lock;
  try
    fSize.Bytes := fSize.Bytes+Bytes;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorWithSize.LockedSum(another: TSynMonitor);
begin
  inherited LockedSum(another);
  if another.InheritsFrom(TSynMonitorWithSize) then
    AddSize(TSynMonitorWithSize(another).Size.Bytes);
end;


{ TSynMonitorInputOutput }

constructor TSynMonitorInputOutput.Create;
begin
  inherited Create;
  fInput := TSynMonitorSize.Create({nospace=}false);
  fOutput := TSynMonitorSize.Create({nospace=}false);
  fInputThroughput := TSynMonitorThroughput.Create({nospace=}false);
  fOutputThroughput := TSynMonitorThroughput.Create({nospace=}false);
end;

destructor TSynMonitorInputOutput.Destroy;
begin
  fOutputThroughput.Free;
  fOutput.Free;
  fInputThroughput.Free;
  fInput.Free;
  inherited Destroy;
end;

procedure TSynMonitorInputOutput.LockedPerSecProperties;
begin
  inherited LockedPerSecProperties;
  fInputThroughput.BytesPerSec := fTotalTime.PerSecond(fInput.Bytes);
  fOutputThroughput.BytesPerSec := fTotalTime.PerSecond(fOutput.Bytes);
end;

procedure TSynMonitorInputOutput.AddSize(const Incoming, Outgoing: QWord);
begin
  fSafe^.Lock;
  try
    fInput.Bytes := fInput.Bytes+Incoming;
    fOutput.Bytes := fOutput.Bytes+Outgoing;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorInputOutput.LockedSum(another: TSynMonitor);
begin
  inherited LockedSum(another);
  if another.InheritsFrom(TSynMonitorInputOutput) then begin
    fInput.Bytes := fInput.Bytes+TSynMonitorInputOutput(another).Input.Bytes;
    fOutput.Bytes := fOutput.Bytes+TSynMonitorInputOutput(another).Output.Bytes;
  end;
end;


{ TSynMonitorServer }

procedure TSynMonitorServer.ClientConnect;
begin
  if self=nil then
    exit;
  fSafe^.Lock;
  try
    inc(fClientsCurrent);
    if fClientsCurrent>fClientsMax then
      fClientsMax := fClientsCurrent;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorServer.ClientDisconnect;
begin
  if self=nil then
    exit;
  fSafe^.Lock;
  try
    if fClientsCurrent>0 then
      dec(fClientsCurrent);
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

procedure TSynMonitorServer.ClientDisconnectAll;
begin
  if self=nil then
    exit;
  fSafe^.Lock;
  try
    fClientsCurrent := 0;
    Changed;
  finally
    fSafe^.UnLock;
  end;
end;

function TSynMonitorServer.GetClientsCurrent: TSynMonitorOneCount;
begin
  if self=nil then begin
    result := 0;
    exit;
  end;
  fSafe^.Lock;
  try
    result := fClientsCurrent;
  finally
    fSafe^.UnLock;
  end;
end;

function TSynMonitorServer.AddCurrentRequestCount(diff: integer): integer;
begin
  if self=nil then begin
    result := 0;
    exit;
  end;
  fSafe^.Lock;
  try
    inc(fCurrentRequestCount,diff);
    result := fCurrentRequestCount;
  finally
    fSafe^.UnLock;
  end;
end;


{ ******************* cross-cutting classes and functions ***************** }

{ TSynInterfacedObject }

function TSynInterfacedObject._AddRef: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := VirtualAddRef;
end;

function TSynInterfacedObject._Release: {$ifdef FPC}longint{$else}integer{$endif};
begin
  result := VirtualRelease;
end;

{$ifdef FPC}
function TSynInterfacedObject.QueryInterface(
  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID;
  out Obj): longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TSynInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
{$endif}
begin
  result := VirtualQueryInterface(IID,Obj);
end;

function TSynInterfacedObject.VirtualQueryInterface(const IID: TGUID; out Obj): HResult;
begin
  result := E_NOINTERFACE;
end;

{$ifdef CPUINTEL}
{$ifndef DELPHI5OROLDER}

{ TSynFPUException }

function TSynFPUException.VirtualAddRef: integer;
begin
  if fRefCount=0 then begin
    {$ifndef CPU64}
    fSaved8087 := Get8087CW;
    Set8087CW(fExpected8087); // set FPU exceptions mask
    {$else}
    fSavedMXCSR := GetMXCSR;
    SetMXCSR(fExpectedMXCSR); // set FPU exceptions mask
    {$endif}
  end;
  inc(fRefCount);
  result := 1; // should never be 0 (mark release of TSynFPUException instance)
end;

function TSynFPUException.VirtualRelease: integer;
begin
  dec(fRefCount);
  if fRefCount=0 then
    {$ifndef CPU64}
    Set8087CW(fSaved8087);
    {$else}
    SetMXCSR(fSavedMXCSR);
    {$endif}
  result := 1; // should never be 0 (mark release of TSynFPUException instance)
end;

threadvar
  GlobalSynFPUExceptionDelphi,
  GlobalSynFPUExceptionLibrary: TSynFPUException;

{$ifndef CPU64}
constructor TSynFPUException.Create(Expected8087Flag: word);
begin // $1372=Delphi $137F=library (mask all exceptions)
  inherited Create;
  fExpected8087 := Expected8087Flag;
end;
{$else}
constructor TSynFPUException.Create(ExpectedMXCSR: word);
begin // $1920=Delphi $1FA0=library (mask all exceptions)
  inherited Create;
  fExpectedMXCSR := ExpectedMXCSR;
end;
{$endif}

class function TSynFPUException.ForLibraryCode: IUnknown;
var obj: TSynFPUException;
begin
  result := GlobalSynFPUExceptionLibrary;
  if result<>nil then
    exit;
  {$ifndef CPU64}
  obj := TSynFPUException.Create($137F);
  {$else}
  obj := TSynFPUException.Create($1FA0);
  {$endif}
  GarbageCollector.Add(obj);
  GlobalSynFPUExceptionLibrary := obj;
  result := obj;
end;

class function TSynFPUException.ForDelphiCode: IUnknown;
var obj: TSynFPUException;
begin
  result := GlobalSynFPUExceptionDelphi;
  if result<>nil then
    exit;
  {$ifndef CPU64}
  obj := TSynFPUException.Create($1372);
  {$else}
  obj := TSynFPUException.Create($1920);
  {$endif}
  GarbageCollector.Add(obj);
  GlobalSynFPUExceptionDelphi := obj;
  result := obj;
end;

{$endif DELPHI5OROLDER}
{$endif CPUINTEL}


{ TAutoFree }

constructor TAutoFree.Create(var localVariable; obj: TObject);
begin
  fObject := obj;
  TObject(localVariable) := obj;
end;

class function TAutoFree.One(var localVariable; obj: TObject): IAutoFree;
begin
  result := Create(localVariable,obj);
end;

class function TAutoFree.Several(const varObjPairs: array of pointer): IAutoFree;
begin
  result := Create(varObjPairs);
end;

constructor TAutoFree.Create(const varObjPairs: array of pointer);
var n,i: integer;
begin
  n := length(varObjPairs);
  if (n=0) or (n and 1=1) then
    exit;
  n := n shr 1;
  if n=0 then
    exit;
  SetLength(fObjectList,n);
  for i := 0 to n-1 do begin
    fObjectList[i] := varObjPairs[i*2+1];
    PPointer(varObjPairs[i*2])^ := fObjectList[i];
  end;
end;

procedure TAutoFree.Another(var localVariable; obj: TObject);
var n: integer;
begin
  n := length(fObjectList);
  SetLength(fObjectList,n+1);
  fObjectList[n] := obj;
  TObject(localVariable) := obj;
end;

destructor TAutoFree.Destroy;
var i: integer;
begin
  if fObjectList<>nil then
    for i := high(fObjectList) downto 0 do // release FILO
      fObjectList[i].Free;
  fObject.Free;
  inherited;
end;


{ TAutoLocker }

constructor TAutoLocker.Create;
begin
  fSafe.Init;
end;

destructor TAutoLocker.Destroy;
begin
  fSafe.Done;
  inherited;
end;

function TAutoLocker.ProtectMethod: IUnknown;
begin
  result := TAutoLock.Create(@fSafe);
end;

procedure TAutoLocker.Enter;
begin
  EnterCriticalSection(fSafe.fSection);
end;

procedure TAutoLocker.Leave;
begin
  LeaveCriticalSection(fSafe.fSection);
end;

function TAutoLocker.Safe: PSynLocker;
begin
  result := @fSafe;
end;

{$ifndef DELPHI5OROLDER} // internal error C3517 under Delphi 5 :(
{$ifndef NOVARIANTS}

{ TLockedDocVariant }

constructor TLockedDocVariant.Create;
begin
  Create(JSON_OPTIONS_FAST);
end;

constructor TLockedDocVariant.Create(FastStorage: boolean);
begin
  Create(JSON_OPTIONS[FastStorage]);
end;

constructor TLockedDocVariant.Create(options: TDocVariantOptions);
begin
  fLock := TAutoLocker.Create;
  fValue.Init(options);
end;

destructor TLockedDocVariant.Destroy;
begin
  inherited;
  fLock.Free;
end;

function TLockedDocVariant.Exists(const Name: RawUTF8; out Value: Variant): boolean;
var i: integer;
begin
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else begin
      Value := fValue.Values[i];
      result := true;
    end;
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.ExistsOrLock(const Name: RawUTF8; out Value: Variant): boolean;
var i: integer;
begin
  result := true;
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else
      Value := fValue.Values[i];
  finally
    if result then
      fLock.Leave;
  end;
end;

procedure TLockedDocVariant.ReplaceAndUnlock(
  const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
begin
  try
    SetValue(Name,Value);
    LocalValue := Value;
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.AddExistingPropOrLock(const Name: RawUTF8;
  var Obj: variant): boolean;
var i: integer;
begin
  result := true;
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else
      _ObjAddProps([Name,fValue.Values[i]],Obj);
  finally
    if result then
      fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddNewPropAndUnlock(const Name: RawUTF8;
  const Value: variant;
  var Obj: variant);
begin
  try
    SetValue(Name,Value);
    _ObjAddProps([Name,Value],Obj);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.AddExistingProp(const Name: RawUTF8;
  var Obj: variant): boolean;
var i: integer;
begin
  result := true;
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then
      result := false else
      _ObjAddProps([Name,fValue.Values[i]],Obj);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddNewProp(const Name: RawUTF8;
  const Value: variant;
  var Obj: variant);
begin
  fLock.Enter;
  try
    SetValue(Name,Value);
    _ObjAddProps([Name,Value],Obj);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.GetValue(const Name: RawUTF8): Variant;
begin
  fLock.Enter;
  try
    fValue.RetrieveValueOrRaiseException(pointer(Name),length(Name),
      dvoNameCaseSensitive in fValue.Options,result,false);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.SetValue(const Name: RawUTF8;
  const Value: Variant);
begin
  fLock.Enter;
  try
    fValue.AddOrUpdateValue(Name,Value);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddItem(const Value: variant);
begin
  fLock.Enter;
  try
    fValue.AddItem(Value);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.Copy: variant;
begin
  VarClear(result);
  fLock.Enter;
  try
    TDocVariantData(result).InitCopy(variant(fValue),JSON_OPTIONS_FAST);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.Clear;
var opt: TDocVariantOptions;
begin
  fLock.Enter;
  try
    opt := fValue.Options;
    fValue.Clear;
    fValue.Init(opt);
  finally
    fLock.Leave;
  end;
end;

function TLockedDocVariant.ToJSON(HumanReadable: boolean): RawUTF8;
var tmp: RawUTF8;
begin
  fLock.Enter;
  try
    VariantSaveJSON(variant(fValue),twJSONEscape,tmp);
  finally
    fLock.Leave;
  end;
  if HumanReadable then
    JSONBufferReformat(pointer(tmp),result) else
    result := tmp;
end;

{$endif NOVARIANTS}
{$endif DELPHI5OROLDER}


function GetDelphiCompilerVersion: RawUTF8;
begin
  result :=
{$ifdef FPC}
  'Free Pascal'
  {$ifdef VER2_6_4}+' 2.6.4'{$endif}
  {$ifdef VER3_0_0}+' 3.0.0'{$endif}
  {$ifdef VER3_0_1}+' 3.0.1'{$endif}
  {$ifdef VER3_0_2}+' 3.0.2'{$endif}
  {$ifdef VER3_1_1}+' 3.1.1'{$endif}
  {$ifdef VER3_2}  +' 3.2'  {$endif}
  {$ifdef VER3_3_1}+' 3.3.1'{$endif}
{$else}
  {$ifdef VER130} 'Delphi 5'{$endif}
  {$ifdef CONDITIONALEXPRESSIONS}  // Delphi 6 or newer
    {$if     defined(KYLIX3)}'Kylix 3'
    {$elseif defined(VER140)}'Delphi 6'
    {$elseif defined(VER150)}'Delphi 7'
    {$elseif defined(VER160)}'Delphi 8'
    {$elseif defined(VER170)}'Delphi 2005'
    {$elseif defined(VER185)}'Delphi 2007'
    {$elseif defined(VER180)}'Delphi 2006'
    {$elseif defined(VER200)}'Delphi 2009'
    {$elseif defined(VER210)}'Delphi 2010'
    {$elseif defined(VER220)}'Delphi XE'
    {$elseif defined(VER230)}'Delphi XE2'
    {$elseif defined(VER240)}'Delphi XE3'
    {$elseif defined(VER250)}'Delphi XE4'
    {$elseif defined(VER260)}'Delphi XE5'
    {$elseif defined(VER265)}'AppMethod 1'
    {$elseif defined(VER270)}'Delphi XE6'
    {$elseif defined(VER280)}'Delphi XE7'
    {$elseif defined(VER290)}'Delphi XE8'
    {$elseif defined(VER300)}'Delphi 10 Seattle'
    {$elseif defined(VER310)}'Delphi 10.1 Berlin'
    {$elseif defined(VER320)}'Delphi 10.2 Tokyo'
    {$elseif defined(VER330)}'Delphi 10.3 Rio'
    {$elseif defined(VER340)}'Delphi 10.4 Next'
    {$ifend}
  {$endif CONDITIONALEXPRESSIONS}
{$endif FPC}
{$ifdef CPU64} +' 64 bit' {$else} +' 32 bit' {$endif}
end;


{ TSynCache }

constructor TSynCache.Create(aMaxCacheRamUsed: cardinal; aCaseSensitive: boolean;
  aTimeoutSeconds: cardinal);
begin
  inherited Create;
  fNameValue.Init(aCaseSensitive);
  fNameValue.fDynArray.Capacity := 200; // some space for future cached entries
  fMaxRamUsed := aMaxCacheRamUsed;
  fFindLastAddedIndex := -1;
  fTimeoutSeconds := aTimeoutSeconds;
end;

procedure TSynCache.ResetIfNeeded;
var tix: cardinal;
begin
  if fRamUsed>fMaxRamUsed then
    Reset;
  if fTimeoutSeconds>0 then begin
    tix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10;
    if fTimeoutTix>tix then
      Reset;
    fTimeoutTix := tix+fTimeoutSeconds;
  end;
end;

procedure TSynCache.Add(const aValue: RawUTF8; aTag: PtrInt);
begin
  if (self=nil) or (fFindLastAddedIndex<0) or (fFindLastKey='') then
    // fFindLastAddedIndex should have been set by a previous call to Find()
    exit;
  ResetIfNeeded;
  inc(fRamUsed,length(aValue));
  if fFindLastAddedIndex<0 then // Reset occurred in ResetIfNeeded
    fNameValue.Add(fFindLastKey,aValue,aTag) else
    with fNameValue.List[fFindLastAddedIndex] do begin // at Find() position
      Name := fFindLastKey;
      Value := aValue;
      Tag := aTag;
      fFindLastAddedIndex := -1;
      fFindLastKey := '';
    end;
end;

function TSynCache.Find(const aKey: RawUTF8; aResultTag: PPtrInt): RawUTF8;
var added: boolean;
begin
  result := '';
  if self=nil then
    exit;
  if aKey='' then
    fFindLastAddedIndex := -1 else begin
    fFindLastAddedIndex := fNameValue.fDynArray.FindHashedForAdding(aKey,added);
    if added then
      // expect a further call to Add()
      fFindLastKey := aKey else
      // match key found
      with fNameValue.List[fFindLastAddedIndex] do begin
        result := Value;
        if aResultTag<>nil then
          aResultTag^ := Tag;
        fFindLastAddedIndex := -1;
      end;
  end;
end;

function TSynCache.AddOrUpdate(const aKey, aValue: RawUTF8; aTag: PtrInt): boolean;
var ndx: integer;
begin
  result := false;
  if self=nil then
    exit; // avoid GPF
  fSafe.Lock;
  try
    ResetIfNeeded;
    ndx := fNameValue.fDynArray.FindHashedForAdding(aKey,result);
    with fNameValue.List[ndx] do begin
      Name := aKey;
      dec(fRamUsed,length(Value));
      Value := aValue;
      inc(fRamUsed,length(Value));
      Tag := aTag;
    end;
  finally
    fSafe.Unlock;
  end;
end;

function TSynCache.Reset: boolean;
begin
  result := false;
  if self=nil then
    exit; // avoid GPF
  fSafe.Lock;
  try
    if Count<>0 then begin
      if fRamUsed<131072 then // no capacity change for small cache content
        fNameValue.Count := 0 else
        with fNameValue.fDynArray{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do begin
          Capacity := 0;   // force free all fNameValue.List[] key/value pairs
          Capacity := 200; // then reserve some space for future cached entries
        end;
      fNameValue.fDynArray.HashInvalidate;
      result := true; // mark something was flushed
    end;
    fFindLastAddedIndex := -1; // fFindLastKey should remain untouched for Add()
    fRamUsed := 0;
    fTimeoutTix := 0;
  finally
    fSafe.Unlock;
  end;
end;

function TSynCache.Count: integer;
begin
  if self=nil then begin
    result := 0;
    exit;
  end;
  fSafe.Lock;
  try
    result := fNameValue.Count;
  finally
    fSafe.Unlock;
  end;
end;


{ TRawUTF8List }

function TRawUTF8List.Add(const aText: RawUTF8): PtrInt;
var capacity: PtrInt;
begin
  if self=nil then
    result := -1 else
    if fObjects=nil then begin
      capacity := length(fList);
      result := fCount;
      if result>=capacity then
        SetLength(fList,NextGrow(capacity));
      fList[result] := aText;
      inc(fCount);
      Changed;
    end else
    result := AddObject(aText,nil);
end;

function TRawUTF8List.AddIfNotExisting(const aText: RawUTF8; wasAdded: PBoolean): PtrInt;
begin
  result := IndexOf(aText);
  if result<0 then begin
    result := Add(aText);
    if wasAdded<>nil then
      wasAdded^ := true;
  end else
    if wasAdded<>nil then
      wasAdded^ := false;
end;

function TRawUTF8List.AddObjectIfNotExisting(const aText: RawUTF8; aObject: TObject;
  wasAdded: PBoolean): PtrInt;
begin
  result := IndexOf(aText);
  if result<0 then begin
    result := AddObject(aText,aObject);
    if wasAdded<>nil then
      wasAdded^ := true;
  end else
    if wasAdded<>nil then
      wasAdded^ := false;
end;

function TRawUTF8List.AddObject(const aText: RawUTF8; aObject: TObject): PtrInt;
var capacity: PtrInt;
begin
  if self=nil then begin
    result := -1;
    exit;
  end;
  capacity := length(fList);
  result := fCount;
  if result>=capacity then begin
    capacity := NextGrow(capacity);
    SetLength(fList,capacity);
    if (fObjects<>nil) or (aObject<>nil) then
      SetLength(fObjects,capacity);
  end else
    if (aObject<>nil) and (fObjects=nil) then
      SetLength(fObjects,capacity); // first time we got aObject<>nil
  fList[result] := aText;
  if aObject<>nil then
    fObjects[result] := aObject;
  inc(fCount);
  Changed;
end;

procedure TRawUTF8List.AddRawUTF8List(List: TRawUTF8List);
var i: PtrInt;
begin
  if List<>nil then begin
    BeginUpdate;
    if List.fObjects=nil then
      for i := 0 to List.fCount-1 do
        Add(List.fList[i]) else
      for i := 0 to List.fCount-1 do
        AddObject(List.fList[i],List.fObjects[i]);
    EndUpdate;
  end;
end;

procedure TRawUTF8List.BeginUpdate;
begin
  inc(fOnChangeLevel);
  if fOnChangeLevel>1 then
    exit;
  fOnChangeHidden := fOnChange;
  fOnChange := OnChangeHidden;
  fOnChangeTrigerred := false;
end;

procedure TRawUTF8List.Changed;
begin
  if (self<>nil) and Assigned(fOnChange) then
    fOnChange(self);
end;

procedure TRawUTF8List.Clear;
begin
  Capacity := 0;
  Changed;
end;

constructor TRawUTF8List.Create(aOwnObjects: boolean);
begin
  fNameValueSep := '=';
  fObjectsOwned := aOwnObjects;
  fCaseSensitive := true;
end;

destructor TRawUTF8List.Destroy;
begin
  Capacity := 0;
  inherited;
end;

procedure TRawUTF8List.Delete(Index: PtrInt);
begin
  if (self=nil) or (PtrUInt(Index)>=PtrUInt(fCount)) then
    exit;
  // release string/object instances
  fList[Index] := '';
  if (fObjects<>nil) and fObjectsOwned then
    FreeAndNil(fObjects[Index]);
  // swap the string/object arrays
  dec(fCount);
  if Index<fCount then begin
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      fList[Index+1],fList[Index],(fCount-Index)*SizeOf(fList[0]));
    PPointer(@fList[fCount])^ := nil; // avoid GPF
    if fObjects<>nil then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(
        fObjects[Index+1],fObjects[Index],(fCount-Index)*SizeOf(fObjects[0]));
      fObjects[fCount] := nil; // avoid GPF if fObjectsOwned is set
    end;
  end;
  Changed;
end;

function TRawUTF8List.Delete(const aText: RawUTF8): PtrInt;
begin
  Result := IndexOf(aText);
  if Result>=0 then
    Delete(Result);
end;

function TRawUTF8List.DeleteFromName(const Name: RawUTF8): PtrInt;
begin
  Result := IndexOfName(Name);
  if Result>=0 then
    Delete(Result);
end;

procedure TRawUTF8List.EndUpdate;
begin
  if fOnChangeLevel<=0 then
    exit;
  dec(fOnChangeLevel);
  if fOnChangeLevel>0 then
    exit; // allows nested BeginUpdate..EndUpdate calls
  fOnChange := fOnChangeHidden;
  if fOnChangeTrigerred and Assigned(fOnChange) then
    fOnChange(self);
  fOnChangeTrigerred := false;
end;

function TRawUTF8List.Get(Index: PtrInt): RawUTF8;
begin
  if (self=nil) or (PtrUInt(Index)>=PtrUInt(fCount)) then
    result := '' else
    result := fList[Index];
end;

function TRawUTF8List.GetCapacity: PtrInt;
begin
  if self=nil then
    result := 0 else
    result := length(fList);
end;

function TRawUTF8List.GetCount: PtrInt;
begin
  if self=nil then
    result := 0 else
    result := fCount;
end;

function TRawUTF8List.GetListPtr: PPUtf8CharArray;
begin
  if self=nil then
    result := nil else
    result := pointer(fList);
end;

function TRawUTF8List.GetObjectPtr: PPointerArray;
begin
  if self=nil then
    result := nil else
    result := pointer(fObjects);
end;

function TRawUTF8List.GetName(Index: PtrInt): RawUTF8;
begin
  result := Get(Index);
  if result='' then
    exit;
  Index := PosExChar(NameValueSep,result);
  if Index=0 then
    result := '' else
    SetLength(result,Index-1);
end;

function TRawUTF8List.GetObject(Index: PtrInt): TObject;
begin
  if (self<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) and (fObjects<>nil) then
    result := fObjects[Index] else
    result := nil;
end;

function TRawUTF8List.GetObjectByName(const Name: RawUTF8): TObject;
var ndx: PtrUInt;
begin
  if (self<>nil) and (fObjects<>nil) then begin
    ndx := IndexOf(Name);
    if ndx<PtrUInt(fCount) then begin
      result := fObjects[ndx];
      exit;
    end else begin
      result := nil;
      exit;
    end;
  end else begin
    result := nil;
    exit;
  end;
end;

function TRawUTF8List.GetText(const Delimiter: RawUTF8): RawUTF8;
var DelimLen, i, Len: PtrInt;
    P: PUTF8Char;
begin
  result := '';
  if (self=nil) or (fCount=0) then
    exit;
  DelimLen := length(Delimiter);
  Len := DelimLen*(fCount-1);
  for i := 0 to fCount-1 do
    inc(Len,length(fList[i]));
  SetLength(result,len);
  P := pointer(result);
  i := 0;
  repeat
    Len := length(fList[i]);
    if Len>0 then begin
      {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(fList[i])^,P^,Len);
      inc(P,Len);
    end;
    inc(i);
    if i>=fCount then
      Break;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(Delimiter)^,P^,DelimLen);
    inc(P,DelimLen);
  until false;
end;

procedure TRawUTF8List.SaveToStream(Dest: TStream; const Delimiter: RawUTF8);
var W: TTextWriter;
    i: integer;
    temp: TTextWriterStackBuffer;
begin
  if (self=nil) or (fCount=0) then
    exit;
  W := TTextWriter.Create(Dest,@temp,SizeOf(temp));
  try
    i := 0;
    repeat
      W.AddString(fList[i]);
      inc(i);
      if i>=fCount then
        Break;
      W.AddString(Delimiter);
    until false;
    W.FlushFinal;
  finally
    W.Free;
  end;
end;

procedure TRawUTF8List.SaveToFile(const FileName: TFileName; const Delimiter: RawUTF8);
var FS: TFileStream;
begin
  FS := TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(FS,Delimiter);
  finally
    FS.Free;
  end;
end;

function TRawUTF8List.GetTextCRLF: RawUTF8;
begin
  result := GetText;
end;

function TRawUTF8List.GetValue(const Name: RawUTF8): RawUTF8;
begin
  Result := GetValueAt(IndexOfName(Name));
end;

function TRawUTF8List.GetValueAt(Index: PtrInt): RawUTF8;
begin
  if (self=nil) or (PtrUInt(Index)>=PtrUInt(fCount)) then
    result := '' else
    result := Get(Index);
  if result='' then
    exit;
  Index := PosExChar(NameValueSep,result);
  if Index=0 then
    result := '' else
    result := copy(result,Index+1,maxInt);
end;

function TRawUTF8List.IndexOf(const aText: RawUTF8): PtrInt;
begin
  if self<>nil then
    if fCaseSensitive then begin
      for result := 0 to fCount-1 do
        if fList[result]=aText then
          exit;
    end else
      for result := 0 to fCount-1 do
        if UTF8IComp(pointer(fList[result]),pointer(aText))=0 then
          exit;
  result := -1;
end;

function TRawUTF8List.IndexOfName(const Name: RawUTF8): PtrInt;
var UpperName: array[byte] of AnsiChar;
begin
  if self<>nil then begin
    PWord(UpperCopy255(UpperName,Name))^ := ord(NameValueSep);
    for result := 0 to fCount-1 do
      if IdemPChar(Pointer(fList[result]),UpperName) then
        exit;
  end;
  result := -1;
end;

function TRawUTF8List.IndexOfObject(aObject: TObject): PtrInt;
begin
  if (self<>nil) and (fObjects<>nil) then
    result := PtrUIntScanIndex(pointer(fObjects),fCount,PtrUInt(aObject)) else
    result := -1;
end;

procedure TRawUTF8List.OnChangeHidden(Sender: TObject);
begin
  if self<>nil then
    fOnChangeTrigerred := true;
end;

procedure TRawUTF8List.Put(Index: PtrInt; const Value: RawUTF8);
begin
  if (self<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) then begin
    fList[Index] := Value;
    Changed;
  end;
end;

procedure TRawUTF8List.PutObject(Index: PtrInt; const Value: TObject);
begin
  if (self<>nil) and (PtrUInt(Index)<PtrUInt(fCount)) then begin
    if fObjects=nil then
      SetLength(fObjects,Length(fList));
    fObjects[Index] := Value;
    Changed;
  end;
end;

procedure TRawUTF8List.SetCapacity(const Value: PtrInt);
var i: integer;
begin
  if self<>nil then begin
    if Value<=0 then begin
      fList := nil;
      if fObjects<>nil then begin
        if fObjectsOwned then
          for i := 0 to fCount-1 do
            fObjects[i].Free;
        fObjects := nil;
      end;
      fCount := 0;
    end else begin
      if Value<fCount then begin
        if (fObjects<>nil) and fObjectsOwned then
          for i := Value to fCount-1 do
            FreeAndNil(fObjects[i]);
        fCount := Value;
      end;
      if Value>length(fList) then begin // increase capacity
        SetLength(fList,Value);
        if pointer(fObjects)<>nil then
          SetLength(fObjects,Value);
      end;
    end;
  end;
end;

procedure TRawUTF8List.SetText(const aText, Delimiter: RawUTF8);
begin
  SetTextPtr(pointer(aText),PUTF8Char(pointer(aText))+length(aText),Delimiter);
end;

procedure TRawUTF8List.LoadFromFile(const FileName: TFileName);
var Map: TMemoryMap;
    P: PUTF8Char;
begin
  if Map.Map(FileName) then
  try
    if Map.Size<>0 then begin
      if TextFileKind(Map)=isUTF8 then begin // ignore UTF-8 BOM
        P := pointer(Map.Buffer+3);
        SetTextPtr(P,P+Map.Size-3,#13#10);
      end else begin
        P := pointer(Map.Buffer);
        SetTextPtr(P,P+Map.Size,#13#10);
      end;
    end;
  finally
    Map.UnMap;
  end;
end;

procedure TRawUTF8List.SetTextPtr(P,PEnd: PUTF8Char; const Delimiter: RawUTF8);
var DelimLen: PtrInt;
    DelimFirst: AnsiChar;
    PBeg, DelimNext: PUTF8Char;
    Line: RawUTF8;
begin
  DelimLen := length(Delimiter);
  BeginUpdate;
  Clear;
  if (P<>nil) and (DelimLen>0) and (P<PEnd) then begin
    DelimFirst := Delimiter[1];
    DelimNext := PUTF8Char(pointer(Delimiter))+1;
    repeat
      PBeg := P;
      while P<PEnd do begin
        if (P^=DelimFirst) and CompareMemSmall(P+1,DelimNext,DelimLen-1) then
          break;
        inc(P);
      end;
      FastSetString(Line,PBeg,P-PBeg);
      AddObject(Line,nil);
      if P>=PEnd then
        break;
      inc(P,DelimLen);
    until P>=PEnd;
  end;
  EndUpdate;
end;

procedure TRawUTF8List.SetTextCRLF(const Value: RawUTF8);
begin
  SetText(Value,#13#10);
end;

procedure TRawUTF8List.SetValue(const Name, Value: RawUTF8);
var i: PtrInt;
begin
  i := IndexOfName(Name);
  if i<0 then
    Add(Name+RawUTF8(NameValueSep)+Value) else
    fList[i] := Name+RawUTF8(NameValueSep)+Value;
end;

procedure TRawUTF8List.SetCaseSensitive(Value: boolean);
begin
  fCaseSensitive := Value;
end;

procedure TRawUTF8List.UpdateValue(const Name: RawUTF8; var Value: RawUTF8;
  ThenDelete: boolean);
var i: PtrInt;
begin
  i := IndexOfName(Name);
  if i>=0 then begin
    Value := GetValueAt(i); // update value
    if ThenDelete then
      Delete(i); // optionally delete
  end;
end;

function TRawUTF8List.PopFirst(out aText: RawUTF8; aObject: PObject=nil): boolean;
begin
  result := fCount>0;
  if not result then
    exit;
  aText := fList[0];
  if aObject<>nil then
    if fObjects<>nil then
      aObject^ := fObjects[0] else
      aObject^ := nil;
  Delete(0);
end;

function TRawUTF8List.PopLast(out aText: RawUTF8; aObject: PObject=nil): boolean;
var ndx: integer;
begin
  result := fCount>0;
  if not result then
    exit;
  ndx := fCount-1;
  aText := fList[ndx];
  if aObject<>nil then
    if fObjects<>nil then
      aObject^ := fObjects[ndx] else
      aObject^ := nil;
  Delete(ndx);
end;


{ TRawUTF8ListLocked }

constructor TRawUTF8ListLocked.Create(aOwnObjects: boolean);
begin
  inherited Create(aOwnObjects);
  fSafe.Init;
end;

destructor TRawUTF8ListLocked.Destroy;
begin
  inherited;
  fSafe.Done;
end;

procedure TRawUTF8ListLocked.SafePush(const aValue: RawUTF8);
begin
  if self=nil then
    exit;
  fSafe.Lock;
  try
    Add(aValue);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListLocked.SafePop(out aValue: RawUTF8): boolean;
begin
  result := false;
  if (self=nil) or (fCount=0) then
    exit;
  fSafe.Lock;
  try
    if fCount=0 then
      exit;
    aValue := fList[0];
    Delete(0);
    result := true;
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8ListLocked.SafeClear;
begin
  if self=nil then
    exit;
  fSafe.Lock;
  try
    Clear;
  finally
    fSafe.UnLock;
  end;
end;


{ TObjectListHashedAbstract}

constructor TObjectListHashedAbstract.Create(aFreeItems: boolean);
begin
  inherited Create;
  fFreeItems := aFreeItems;
  fHash.Init(TypeInfo(TObjectDynArray),fList,@HashPtrUInt,@SortDynArrayPointer,nil,@fCount);
end;

destructor TObjectListHashedAbstract.Destroy;
var i: integer;
begin
  if fFreeItems then
    for i := 0 to fCount-1 do
      List[i].Free;
  inherited;
end;

procedure TObjectListHashedAbstract.Delete(aIndex: integer);
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) then
    exit;
  if fFreeItems then
    FreeAndNil(List[aIndex]);
  fHash.Delete(aIndex);
  fHash.HashInvalidate;
end;

procedure TObjectListHashedAbstract.Delete(aObject: TObject);
begin
  Delete(IndexOf(aObject));
end;



{ TObjectListHashed }

function TObjectListHashed.Add(aObject: TObject; out wasAdded: boolean): integer;
begin
  wasAdded := false;
  if self<>nil then begin
    result := fHash.FindHashedForAdding(aObject,wasAdded);
    if wasAdded then
      fList[result] := aObject;
  end else
    result := -1;
end;

function TObjectListHashed.IndexOf(aObject: TObject): integer;
begin
  if (self<>nil) and (fCount>0) then
    result := fHash.FindHashed(aObject) else
    result := -1;
end;


{ TObjectListPropertyHashed }

constructor TObjectListPropertyHashed.Create(
  aSubPropAccess: TObjectListPropertyHashedAccessProp;
  aHashElement: TDynArrayHashOne; aCompare: TDynArraySortCompare;
  aFreeItems: boolean);
begin
  inherited Create(aFreeItems);
  fSubPropAccess := aSubPropAccess;
  if Assigned(aHashElement) then
    fHash.fHashElement := aHashElement;
  if Assigned(aCompare) then
    fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare := aCompare;
  fHash.EventCompare := IntComp;
  fHash.EventHash := IntHash;
end;

function TObjectListPropertyHashed.IntHash(const Elem): cardinal;
var O: TObject;
begin
  O := fSubPropAccess(TObject(Elem));
  result := fHash.fHashElement(O,fHash.fHasher);
end;

function TObjectListPropertyHashed.IntComp(const A,B): integer;
var O: TObject;
begin
  O := fSubPropAccess(TObject(A));
  result := fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare(O,B);
end;

function TObjectListPropertyHashed.Add(aObject: TObject; out wasAdded: boolean): integer;
begin
  wasAdded := false;
  if self<>nil then begin
    result := fHash.FindHashedForAdding(aObject,wasAdded,
      fHash.fHashElement(aObject,fHash.fHasher));
    if wasAdded then
      fList[result] := aObject;
  end else
    result := -1;
end;

function TObjectListPropertyHashed.IndexOf(aObject: TObject): integer;
begin
  if fCount>0 then begin
    result := fHash.FindHashed(aObject,fHash.fHashElement(aObject,fHash.fHasher));
    if result>=0 then
      exit else // found
      result := -1; // for consistency
  end else
    result := -1;
end;


{ TPointerClassHashed }

constructor TPointerClassHashed.Create(aInfo: pointer);
begin
  fInfo := aInfo;
end;


{ TPointerClassHash }

function PointerClassHashProcess(aObject: TPointerClassHashed): pointer;
begin
  if aObject=nil then // may happen for Rehash after SetCount(n+1)
    result := nil else
    result := aObject.Info;
end;

constructor TPointerClassHash.Create;
begin
  inherited Create(@PointerClassHashProcess);
end;

function TPointerClassHash.TryAdd(aInfo: pointer): PPointerClassHashed;
var wasAdded: boolean;
    i: integer;
begin
  i := inherited Add(aInfo,wasAdded);
  if wasAdded then
    result := @List[i] else
    result := nil;
end;

function TPointerClassHash.Find(aInfo: pointer): TPointerClassHashed;
var i: integer;
begin
  if self<>nil then begin
    i := IndexOf(aInfo);
    if i>=0 then
      result := TPointerClassHashed(List[i]) else
      result := nil;
  end else
    result := nil;
end;


{ TPointerClassHashLocked }

constructor TPointerClassHashLocked.Create;
begin
  inherited Create;
  fSafe.Init;
end;

destructor TPointerClassHashLocked.Destroy;
begin
  fSafe.Done;
  inherited Destroy;
end;

function TPointerClassHashLocked.FindLocked(aInfo: pointer): TPointerClassHashed;
begin
  if self=nil then
    result := nil else begin
    fSafe.Lock;
    try
      result := inherited Find(aInfo);
    finally
      fSafe.UnLock;
    end;
  end;
end;

function TPointerClassHashLocked.TryAddLocked(aInfo: pointer;
  out aNewEntry: PPointerClassHashed): boolean;
var wasAdded: boolean;
    i: integer;
begin
  fSafe.Lock;
  i := inherited Add(aInfo,wasAdded);
  if wasAdded then begin
    aNewEntry := @List[i];
    result := true; // caller should call Unlock
  end else begin
    fSafe.UnLock;
    result := false;
  end;
end;

procedure TPointerClassHashLocked.Unlock;
begin
  fSafe.UnLock;
end;


{ TObjectListLocked }

constructor TObjectListLocked.Create(AOwnsObjects: Boolean=true);
begin
  inherited Create(AOwnsObjects);
  fSafe.Init;
end;

destructor TObjectListLocked.Destroy;
begin
  inherited Destroy;
  fSafe.Done;
end;

function TObjectListLocked.SafeAdd(AObject: TObject): integer;
begin
  Safe.Lock;
  try
    result := Add(AObject);
  finally
    Safe.UnLock;
  end;
end;

function TObjectListLocked.SafeRemove(AObject: TObject): integer;
begin
  Safe.Lock;
  try
    result := Remove(AObject);
  finally
    Safe.UnLock;
  end;
end;

function TObjectListLocked.SafeExists(AObject: TObject): boolean;
begin
  Safe.Lock;
  try
    result := IndexOf(AObject)>=0;
  finally
    Safe.UnLock;
  end;
end;

function TObjectListLocked.SafeCount: integer;
begin
  Safe.Lock;
  try
    result := Count;
  finally
    Safe.UnLock;
  end;
end;

procedure TObjectListLocked.SafeClear;
begin
  Safe.Lock;
  try
    Clear;
  finally
    Safe.UnLock;
  end;
end;


{ TRawUTF8ListHashed }

{$ifdef PUREPASCAL}
function SortDynArrayAnsiStringHashOnly(const A,B): integer;
begin
  if RawByteString(A)=RawByteString(B) then // faster than StrCmp
    result := 0 else
    result := 1; // fake comparison, but fHash only use equality
end;
{$endif}

var
  DYNARRAY_SORTFIRSTFIELDHASHONLY: array[boolean] of TDynArraySortCompare = (
    SortDynArrayAnsiStringI,
    {$ifdef PUREPASCAL}SortDynArrayAnsiStringHashOnly
    {$else}SortDynArrayAnsiString{$endif});

constructor TRawUTF8ListHashed.Create(aOwnObjects: boolean);
begin
  inherited Create(aOwnObjects);
  fHash.Init(TypeInfo(TRawUTF8DynArray),fList,@HashAnsiString,
    DYNARRAY_SORTFIRSTFIELDHASHONLY[true],nil,@fCount);
end;

procedure TRawUTF8ListHashed.Changed;
begin
  fChanged := true;
  inherited;
end;

procedure TRawUTF8ListHashed.SetCaseSensitive(Value: boolean);
begin
  if fCaseSensitive=Value then
    exit;
  inherited;
  fHash.fHashElement := DYNARRAY_HASHFIRSTFIELD[not Value,djRawUTF8];
  fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare :=
    DYNARRAY_SORTFIRSTFIELDHASHONLY[Value];
  if not fChanged then
    fChanged := Count>0; // force re-hash next IndexOf() call
end;

function TRawUTF8ListHashed.IndexOf(const aText: RawUTF8): PtrInt;
begin
  if fChanged then
    fChanged := not fHash.ReHash; // rough, but working implementation
  result := fHash.FindHashed(aText);
end;

function TRawUTF8ListHashed.AddIfNotExisting(const aText: RawUTF8;
  wasAdded: PBoolean): PtrInt;
var added: boolean;
begin
  if fChanged then
    fChanged := not fHash.ReHash; // rough, but working implementation
  result := fHash.FindHashedForAdding(aText,added);
  if added then begin
    fList[result] := aText;
    if (fObjects<>nil) and (length(fObjects)<>length(fList)) then
      SetLength(fObjects,length(fList));
  end;
  if wasAdded<>nil then
    wasAdded^ := added;
end;

function TRawUTF8ListHashed.AddObjectIfNotExisting(
  const aText: RawUTF8; aObject: TObject; wasAdded: PBoolean): PtrInt;
var added: boolean;
begin
  if fChanged then
    fChanged := not fHash.ReHash; // rough, but working implementation
  result := fHash.FindHashedForAdding(aText,added);
  if added then begin
    fList[result] := aText;
    if length(fObjects)<>length(fList) then
      SetLength(fObjects,length(fList));
    fObjects[result] := aObject;
  end;
  if wasAdded<>nil then
    wasAdded^ := added;
end;

function TRawUTF8ListHashed.HashFind(aHashCode: cardinal): integer;
begin
  result := fHash.HashFind(aHashCode,false);
end;

function TRawUTF8ListHashed.ReHash(aForceRehash: boolean): boolean;
begin
  if fChanged or aForceRehash then
    fChanged := not fHash.ReHash(aForceRehash);
  result := not fChanged;
end;


{ TRawUTF8ListHashedLocked }

constructor TRawUTF8ListHashedLocked.Create(aOwnObjects: boolean);
begin
  inherited Create(aOwnObjects);
  fSafe.Init;
end;

destructor TRawUTF8ListHashedLocked.Destroy;
begin
  fSafe.Done;
  inherited;
end;

function TRawUTF8ListHashedLocked.LockedAdd(const aText: RawUTF8): PtrInt;
begin
  fSafe.Lock;
  try
    result := inherited Add(aText);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.IndexOf(const aText: RawUTF8): PtrInt;
begin
  fSafe.Lock;
  try
    result := inherited IndexOf(aText);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.LockedGetObjectByName(const aText: RawUTF8): TObject;
begin
  fSafe.Lock;
  try
    result := inherited GetObjectByName(aText);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.AddIfNotExisting(const aText: RawUTF8;
  wasAdded: PBoolean): PtrInt;
begin
  fSafe.Lock;
  try
    result := inherited AddIfNotExisting(aText,wasAdded);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.AddObjectIfNotExisting(const aText: RawUTF8;
  aObject: TObject; wasAdded: PBoolean): PtrInt;
begin
  fSafe.Lock;
  try
    result := inherited AddObjectIfNotExisting(aText,aObject,wasAdded);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.Delete(const aText: RawUTF8): PtrInt;
begin
  fSafe.Lock;
  try
    result := inherited IndexOf(aText);
    if result>=0 then
      inherited Delete(result);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.DeleteFromName(const Name: RawUTF8): PtrInt;
begin
  fSafe.Lock;
  try
    result := inherited IndexOfName(Name);
    if result>=0 then
      inherited Delete(result);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.PopFirst(out aText: RawUTF8; aObject: PObject=nil): boolean;
begin
  fSafe.Lock;
  try
    result := inherited PopFirst(aText,aObject);
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.PopLast(out aText: RawUTF8; aObject: PObject=nil): boolean;
begin
  fSafe.Lock;
  try
    result := inherited PopLast(aText,aObject);
  finally
    fSafe.UnLock;
  end;
end;

procedure TRawUTF8ListHashedLocked.Clear;
begin
  fSafe.Lock;
  try
    inherited Clear;
  finally
    fSafe.UnLock;
  end;
end;

function TRawUTF8ListHashedLocked.ReHash(aForceRehash: boolean): boolean;
begin
  fSafe.Lock;
  try
    result := inherited Rehash(aForceRehash);
  finally
    fSafe.UnLock;
  end;
end;


{ TRawUTF8MethodList }

function TRawUTF8MethodList.AddEvent(const aName: RawUTF8;
  const aEvent: TMethod): PtrInt;
begin
  result := Add(aName);
  if result>=length(fEvents) then
    SetLength(fEvents,result+256);
  fEvents[result] := aEvent;
end;

procedure TRawUTF8MethodList.Clear;
begin
  inherited Clear;
  fEvents := nil;
end;

procedure TRawUTF8MethodList.Delete(Index: PtrInt);
begin
  inherited Delete(Index);
  if Index<length(fEvents) then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      fEvents[Index+1],fEvents[Index],(length(fEvents)-Index)*SizeOf(TMethod));
end;

function TRawUTF8MethodList.GetEvent(aIndex: PtrInt;
  out aEvent: TMethod): boolean;
begin
  result := aIndex<length(fEvents);
  if result then
    aEvent := fEvents[aIndex];
end;

function TRawUTF8MethodList.GetEventByName(const aText: RawUTF8;
  out aEvent: TMethod): boolean;
var i: integer;
begin
  result := false;
  if self=nil then
    exit;
  i := IndexOf(aText);
  if (i>=0) and (i<length(fEvents)) then begin
    result := true;
    aEvent := fEvents[i];
  end;
end;


{ TSynDictionary }

const
  DIC_KEYCOUNT = 0;
  DIC_KEY = 1;
  DIC_VALUECOUNT = 2;
  DIC_VALUE = 3;
  DIC_TIMECOUNT = 4;
  DIC_TIMESEC = 5;
  DIC_TIMETIX = 6;

function TSynDictionary.KeyFullHash(const Elem): cardinal;
begin
  result := fKeys.fHasher(0,@Elem,fKeys.ElemSize);
end;

function TSynDictionary.KeyFullCompare(const A,B): integer;
var i: integer;
begin
  for i := 0 to fKeys.ElemSize - 1 do begin
    result := TByteArray(A)[i] - TByteArray(B)[i];
    if result<>0 then
      exit;
  end;
  result := 0;
end;

constructor TSynDictionary.Create(aKeyTypeInfo,aValueTypeInfo: pointer;
  aKeyCaseInsensitive: boolean; aTimeoutSeconds: cardinal; aCompressAlgo: TAlgoCompress);
begin
  inherited Create;
  fSafe.Padding[DIC_KEYCOUNT].VType := varInteger;
  fSafe.Padding[DIC_KEY].VType := varUnknown;
  fSafe.Padding[DIC_VALUECOUNT].VType := varInteger;
  fSafe.Padding[DIC_VALUE].VType := varUnknown;
  fSafe.Padding[DIC_TIMECOUNT].VType := varInteger;
  fSafe.Padding[DIC_TIMESEC].VType := varInteger;
  fSafe.Padding[DIC_TIMETIX].VType := varInteger;
  fSafe.PaddingMaxUsedIndex := DIC_TIMETIX;
  fKeys.Init(aKeyTypeInfo,fSafe.Padding[DIC_KEY].VAny,nil,nil,nil,
    @fSafe.Padding[DIC_KEYCOUNT].VInteger,aKeyCaseInsensitive);
  if not Assigned(fKeys.fHashElement) then
    fKeys.fEventHash := KeyFullHash;
  if not Assigned(fKeys.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare) then
    fKeys.fEventCompare := KeyFullCompare;
  fValues.Init(aValueTypeInfo,fSafe.Padding[DIC_VALUE].VAny,
    @fSafe.Padding[DIC_VALUECOUNT].VInteger);
  fTimeouts.Init(TypeInfo(TIntegerDynArray),fTimeOut,@fSafe.Padding[DIC_TIMECOUNT].VInteger);
  if aCompressAlgo=nil then
    aCompressAlgo := AlgoSynLZ;
  fCompressAlgo := aCompressAlgo;
  fSafe.Padding[DIC_TIMESEC].VInteger := aTimeoutSeconds;
end;

function TSynDictionary.ComputeNextTimeOut: cardinal;
begin
  result := fSafe.Padding[DIC_TIMESEC].VInteger;
  if result<>0 then
    result := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+result;
end;

function TSynDictionary.GetCapacity: integer;
begin
  fSafe.Lock;
  result := fKeys.Capacity;
  fSafe.UnLock;
end;

procedure TSynDictionary.SetCapacity(const Value: integer);
begin
  fSafe.Lock;
  fKeys.Capacity := Value;
  fValues.Capacity := Value;
  if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
    fTimeOuts.Capacity := Value;
  fSafe.UnLock;
end;

function TSynDictionary.GetTimeOutSeconds: cardinal;
begin
  result := fSafe.Padding[DIC_TIMESEC].VInteger;
end;

procedure TSynDictionary.SetTimeouts;
var i: PtrInt;
    timeout: cardinal;
begin
  if fSafe.Padding[DIC_TIMESEC].VInteger=0 then
    exit;
  fTimeOuts.SetCount(fSafe.Padding[DIC_KEYCOUNT].VInteger);
  timeout := ComputeNextTimeOut;
  for i := 0 to fSafe.Padding[DIC_TIMECOUNT].VInteger-1 do
    fTimeOut[i] := timeout;
end;

function TSynDictionary.DeleteDeprecated: integer;
var i: PtrInt;
    now: cardinal;
begin
  result := 0;
  if (self=nil) or (fSafe.Padding[DIC_TIMECOUNT].VInteger=0) or // no entry
     (fSafe.Padding[DIC_TIMESEC].VInteger=0) then // nothing in fTimeOut[]
    exit;
  now := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10;
  if fSafe.Padding[DIC_TIMETIX].VInteger=integer(now) then
    exit; // no need to search more often than every second
  fSafe.Lock;
  try
    fSafe.Padding[DIC_TIMETIX].VInteger := now;
    for i := fSafe.Padding[DIC_TIMECOUNT].VInteger-1 downto 0 do
      if (now>fTimeOut[i]) and (fTimeOut[i]<>0) and
         (not Assigned(fOnCanDelete) or
         fOnCanDelete(fKeys.ElemPtr(i)^,fValues.ElemPtr(i)^,i)) then begin
        fKeys.Delete(i);
        fValues.Delete(i);
        fTimeOuts.Delete(i);
        inc(result);
      end;
    if result>0 then
      fKeys.Rehash; // mandatory after fKeys.Delete(i)
  finally
    fSafe.UnLock;
  end;
end;

procedure TSynDictionary.DeleteAll;
begin
  if self=nil then
    exit;
  fSafe.Lock;
  try
    fKeys.Clear;
    fKeys.ReHash; // mandatory to avoid GPF
    fValues.Clear;
    if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
      fTimeOuts.Clear;
  finally
    fSafe.UnLock;
  end;
end;

destructor TSynDictionary.Destroy;
begin
  fKeys.Clear;
  fValues.Clear;
  inherited Destroy;
end;

function TSynDictionary.Add(const aKey, aValue): integer;
var added: boolean;
    tim: cardinal;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashedForAdding(aKey,added);
    if added then begin
      with fKeys{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do
        ElemCopyFrom(aKey,result); // fKey[result] := aKey;
      if fValues.Add(aValue)<>result then
        raise ESynException.CreateUTF8('%.Add fValues.Add',[self]);
      tim := ComputeNextTimeOut;
      if tim>0 then
        fTimeOuts.Add(tim);
    end else
      result := -1;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.AddOrUpdate(const aKey, aValue): integer;
var added: boolean;
    tim: cardinal;
begin
  fSafe.Lock;
  try
    tim := ComputeNextTimeOut;
    result := fKeys.FindHashedForAdding(aKey,added);
    if added then begin
      with fKeys{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do
        ElemCopyFrom(aKey,result); // fKey[result] := aKey
      if fValues.Add(aValue)<>result then
        raise ESynException.CreateUTF8('%.AddOrUpdate fValues.Add',[self]);
      if tim<>0 then
        fTimeOuts.Add(tim);
    end else begin
      fValues.ElemCopyFrom(aValue,result,{ClearBeforeCopy=}true);
      if tim<>0 then
        fTimeOut[result] := tim;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.Clear(const aKey): integer;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashed(aKey);
    if result>=0 then begin
      fValues.ElemClear(fValues.ElemPtr(result)^);
      if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
        fTimeOut[result] := 0;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.Delete(const aKey): integer;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashedAndDelete(aKey);
    if result>=0 then begin
      fValues.Delete(result);
      if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
        fTimeOuts.Delete(result);
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.DeleteAt(aIndex: integer): boolean;
begin
  if cardinal(aIndex)<cardinal(fSafe.Padding[DIC_KEYCOUNT].VInteger) then begin
    fKeys.Delete(aIndex);
    fKeys.ReHash;
    fValues.Delete(aIndex);
    if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
      fTimeOuts.Delete(aIndex);
    result := true;
  end
  else
    result := false;
end;

function TSynDictionary.InArray(const aKey, aArrayValue;
  aAction: TSynDictionaryInArray): boolean;
var nested: TDynArray;
    ndx: integer;
begin
  result := false;
  if (fValues.ElemType=nil) or (PTypeKind(fValues.ElemType)^<>tkDynArray) then
    raise ESynException.CreateUTF8('%.Values: % items are not dynamic arrays',
      [self,fValues.ArrayTypeShort^]);
  fSafe.Lock;
  try
    ndx := fKeys.FindHashed(aKey);
    if ndx<0 then
      exit;
    nested.Init(fValues.ElemType,fValues.ElemPtr(ndx)^);
    case aAction of
    iaFind:
      result := nested.Find(aArrayValue)>=0;
    iaFindAndDelete:
      result := nested.FindAndDelete(aArrayValue)>=0;
    iaFindAndUpdate:
      result := nested.FindAndUpdate(aArrayValue)>=0;
    iaFindAndAddIfNotExisting:
      result := nested.FindAndAddIfNotExisting(aArrayValue)>=0;
    iaAdd:
      result := nested.Add(aArrayValue)>=0;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.FindInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFind);
end;

function TSynDictionary.FindKeyFromValue(const aValue; out aKey;
  aUpdateTimeOut: boolean): boolean;
var ndx: integer;
begin
  fSafe.Lock;
  try
    ndx := fValues.IndexOf(aValue);
    result := ndx>=0;
    if result then begin
      fKeys.ElemCopyAt(ndx,aKey);
      if aUpdateTimeOut then
        SetTimeoutAtIndex(ndx);
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.DeleteInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFindAndDelete);
end;

function TSynDictionary.UpdateInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFindAndUpdate);
end;

function TSynDictionary.AddInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaAdd);
end;

function TSynDictionary.AddOnceInArray(const aKey, aArrayValue): boolean;
begin
  result := InArray(aKey,aArrayValue,iaFindAndAddIfNotExisting);
end;

function TSynDictionary.Find(const aKey; aUpdateTimeOut: boolean): integer;
var tim: cardinal;
begin // caller is expected to call fSafe.Lock/Unlock
  if self=nil then
    result := -1 else
    result := fKeys.FindHashed(aKey);
  if aUpdateTimeOut and (result>=0) then begin
    tim := fSafe.Padding[DIC_TIMESEC].VInteger;
    if tim>0 then // inlined fTimeout[result] := GetTimeout
      fTimeout[result] := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+tim;
  end;
end;

function TSynDictionary.FindValue(const aKey; aUpdateTimeOut: boolean; aIndex: PInteger): pointer;
var ndx: PtrInt;
begin
  ndx := Find(aKey,aUpdateTimeOut);
  if aIndex<>nil then
    aIndex^ := ndx;
  if ndx<0 then
    result := nil else
    result := pointer(PtrUInt(fValues.fValue^)+PtrUInt(ndx)*fValues.ElemSize);
end;

function TSynDictionary.FindValueOrAdd(const aKey; var added: boolean;
  aIndex: PInteger): pointer;
var ndx: integer;
    tim: cardinal;
begin
  tim := fSafe.Padding[DIC_TIMESEC].VInteger; // inlined tim := GetTimeout
  if tim<>0 then
    tim := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+tim;
  ndx := fKeys.FindHashedForAdding(aKey,added);
  if added then begin
    with fKeys{$ifdef UNDIRECTDYNARRAY}.InternalDynArray{$endif} do
      ElemCopyFrom(aKey,ndx); // fKey[i] := aKey
    fValues.SetCount(ndx+1); // reserve new place for associated value
    if tim>0 then
      fTimeOuts.Add(tim);
  end else
    if tim>0 then
      fTimeOut[ndx] := tim;
  if aIndex<>nil then
    aIndex^ := ndx;
  result := fValues.ElemPtr(ndx);
end;

function TSynDictionary.FindAndCopy(const aKey; out aValue; aUpdateTimeOut: boolean): boolean;
var ndx: integer;
begin
  fSafe.Lock;
  try
    ndx := Find(aKey, aUpdateTimeOut);
    if ndx>=0 then begin
      fValues.ElemCopyAt(ndx,aValue);
      result := true;
    end else
      result := false;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.FindAndExtract(const aKey; out aValue): boolean;
var ndx: integer;
begin
  fSafe.Lock;
  try
    ndx := fKeys.FindHashedAndDelete(aKey);
    if ndx>=0 then begin
      fValues.ElemCopyAt(ndx,aValue);
      fValues.Delete(ndx);
      if fSafe.Padding[DIC_TIMESEC].VInteger>0 then
        fTimeOuts.Delete(ndx);
      result := true;
    end else
      result := false;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.Exists(const aKey): boolean;
begin
  fSafe.Lock;
  try
    result := fKeys.FindHashed(aKey)>=0;
  finally
    fSafe.UnLock;
  end;
end;

{$ifndef DELPHI5OROLDER}
procedure TSynDictionary.CopyValues(out Dest; ObjArrayByRef: boolean);
begin
  fSafe.Lock;
  try
    fValues.CopyTo(Dest,ObjArrayByRef);
  finally
    fSafe.UnLock;
  end;
end;
{$endif DELPHI5OROLDER}

function TSynDictionary.ForEach(const OnEach: TSynDictionaryEvent; Opaque: pointer): integer;
var k,v: PAnsiChar;
    i,n,ks,vs: integer;
begin
  result := 0;
  fSafe.Lock;
  try
    n := fSafe.Padding[DIC_KEYCOUNT].VInteger;
    if (n=0) or not Assigned(OnEach) then
      exit;
    k := fKeys.Value^;
    ks := fKeys.ElemSize;
    v := fValues.Value^;
    vs := fValues.ElemSize;
    for i := 0 to n-1 do begin
      inc(result);
      if not OnEach(k^,v^,i,n,Opaque) then
        break;
      inc(k,ks);
      inc(v,vs);
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.ForEach(const OnMatch: TSynDictionaryEvent;
  KeyCompare,ValueCompare: TDynArraySortCompare; const aKey,aValue;
  Opaque: pointer): integer;
var k,v: PAnsiChar;
    i,n,ks,vs: integer;
begin
  fSafe.Lock;
  try
    result := 0;
    if not Assigned(OnMatch) or
       (not Assigned(KeyCompare) and not Assigned(ValueCompare)) then
      exit;
    n := fSafe.Padding[DIC_KEYCOUNT].VInteger;
    k := fKeys.Value^;
    ks := fKeys.ElemSize;
    v := fValues.Value^;
    vs := fValues.ElemSize;
    for i := 0 to n-1 do begin
      if (Assigned(KeyCompare) and (KeyCompare(k^,aKey)=0)) or
         (Assigned(ValueCompare) and (ValueCompare(v^,aValue)=0)) then begin
        inc(result);
        if not OnMatch(k^,v^,i,n,Opaque) then
          break;
      end;
      inc(k,ks);
      inc(v,vs);
    end;
  finally
    fSafe.UnLock;
  end;
end;

procedure TSynDictionary.SetTimeoutAtIndex(aIndex: integer);
var tim: cardinal;
begin
  if cardinal(aIndex) >= cardinal(fSafe.Padding[DIC_KEYCOUNT].VInteger) then
    exit;
  tim := fSafe.Padding[DIC_TIMESEC].VInteger;
  if tim > 0 then
    fTimeOut[aIndex] := cardinal({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10)+tim;
end;

function TSynDictionary.Count: integer;
begin
  {$ifdef NOVARIANTS}
  result := RawCount;
  {$else}
  result := fSafe.LockedInt64[DIC_KEYCOUNT];
  {$endif}
end;

function TSynDictionary.RawCount: integer;
begin
  result := fSafe.Padding[DIC_KEYCOUNT].VInteger;
end;

procedure TSynDictionary.SaveToJSON(W: TTextWriter; EnumSetsAsText: boolean);
var k,v: RawUTF8;
begin
  fSafe.Lock;
  try
    fKeys.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}SaveToJSON(k,EnumSetsAsText);
    fValues.SaveToJSON(v,EnumSetsAsText);
  finally
    fSafe.UnLock;
  end;
  W.AddJSONArraysAsJSONObject(pointer(k),pointer(v));
end;

function TSynDictionary.SaveToJSON(EnumSetsAsText: boolean): RawUTF8;
var W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  W := TTextWriter.CreateOwnedStream(temp);
  try
    SaveToJSON(W,EnumSetsAsText);
    W.SetText(result);
  finally
    W.Free;
  end;
end;

function TSynDictionary.SaveValuesToJSON(EnumSetsAsText: boolean): RawUTF8;
begin
  fSafe.Lock;
  try
    fValues.SaveToJSON(result,EnumSetsAsText);
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.LoadFromJSON(const JSON: RawUTF8;
  EnsureNoKeyCollision: boolean): boolean;
begin
  result := LoadFromJSON(pointer(JSON),EnsureNoKeyCollision);
end;

function TSynDictionary.LoadFromJSON(JSON: PUTF8Char; EnsureNoKeyCollision: boolean): boolean;
var k,v: RawUTF8;
begin
  result := false;
  if not JSONObjectAsJSONArrays(JSON,k,v) then
    exit;
  fSafe.Lock;
  try
    if fKeys.LoadFromJSON(pointer(k))<>nil then
      if fValues.LoadFromJSON(pointer(v))<>nil then
        if fKeys.Count=fValues.Count then begin
          SetTimeouts;
          if EnsureNoKeyCollision then
            // fKeys.Rehash is not enough, since input JSON may be invalid
            result := fKeys.IsHashElementWithoutCollision<0 else begin
            // optimistic approach
            fKeys.Rehash;
            result := true;
          end;
        end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynDictionary.LoadFromBinary(const binary: RawByteString): boolean;
var P: PAnsiChar;
begin
  result := false;
  P := pointer(fCompressAlgo.Decompress(binary));
  if P=nil then
    exit;
  fSafe.Lock;
  try
    P := fKeys.LoadFrom(P);
    if P<>nil then
      P := fValues.LoadFrom(P);
    if (P<>nil) and (fKeys.Count=fValues.Count) then begin
      SetTimeouts;  // set ComputeNextTimeOut for all items
      fKeys.ReHash; // optimistic: input from safe TSynDictionary.SaveToBinary
      result := true;
    end;
  finally
    fSafe.UnLock;
  end;
end;

class function TSynDictionary.OnCanDeleteSynPersistentLock(const aKey, aValue;
  aIndex: integer): boolean;
begin
  result := not TSynPersistentLock(aValue).Safe^.IsLocked;
end;

class function TSynDictionary.OnCanDeleteSynPersistentLocked(const aKey, aValue;
  aIndex: integer): boolean;
begin
  result := not TSynPersistentLock(aValue).Safe.IsLocked;
end;

function TSynDictionary.SaveToBinary(NoCompression: boolean): RawByteString;
var tmp: TSynTempBuffer;
    trigger: integer;
begin
  fSafe.Lock;
  try
    result := '';
    if fSafe.Padding[DIC_KEYCOUNT].VInteger = 0 then
      exit;
    tmp.Init(fKeys.SaveToLength+fValues.SaveToLength);
    if fValues.SaveTo(fKeys.SaveTo(tmp.buf))-tmp.buf=tmp.len then begin
      if NoCompression then
        trigger := maxInt else
        trigger := 128;
      result := fCompressAlgo.Compress(tmp.buf,tmp.len,trigger);
    end;
    tmp.Done;
  finally
    fSafe.UnLock;
  end;
end;


{ TSynQueue }

constructor TSynQueue.Create(aTypeInfo: pointer);
begin
  inherited Create;
  fFirst := -1;
  fLast := -2;
  fValues.Init(aTypeInfo,fValueVar,@fCount);
end;

destructor TSynQueue.Destroy;
begin
  WaitPopFinalize;
  fValues.Clear;
  inherited Destroy;
end;

procedure TSynQueue.Clear;
begin
  fSafe.Lock;
  try
    fValues.Clear;
    fFirst := -1;
    fLast := -2;
  finally
    fSafe.UnLock;
  end;
end;

function TSynQueue.Count: Integer;
begin
  if self=nil then
    result := 0 else begin
    fSafe.Lock;
    try
      if fFirst<0 then
        result := 0 else
        if fFirst<=fLast then
          result := fLast-fFirst+1 else
          result := fCount-fFirst+fLast+1;
    finally
      fSafe.UnLock;
    end;
  end;
end;

function TSynQueue.Capacity: integer;
begin
  if self=nil then
    result := 0 else begin
    fSafe.Lock;
    try
      result := fValues.Capacity;
    finally
      fSafe.UnLock;
    end;
  end;
end;

function TSynQueue.Pending: boolean;
begin // allow some false positive: fSafe.Lock not used here
  result := (self<>nil) and (fFirst>=0);
end;

procedure TSynQueue.Push(const aValue);
begin
  fSafe.Lock;
  try
    if fFirst<0 then begin
      fFirst := 0; // start from the bottom of the void queue
      fLast := 0;
      if fCount=0 then
        fValues.Count := 64;
    end else
      if fFirst<=fLast then begin // stored in-order
        inc(fLast);
        if fLast=fCount then
          InternalGrow;
      end else begin
        inc(fLast);
        if fLast=fFirst then begin // collision -> arrange
          fValues.AddArray(fValueVar,0,fLast); // move 0..fLast to the end
          fLast := fCount;
          InternalGrow;
        end;
      end;
    fValues.ElemCopyFrom(aValue,fLast);
  finally
    fSafe.UnLock;
  end;
end;

procedure TSynQueue.InternalGrow;
var cap: integer;
begin
  cap := fValues.Capacity;
  if fFirst>cap-fCount then // use leading space if worth it
    fLast := 0 else         // append at the end
    if fCount=cap then      // reallocation needed
      fValues.Count := cap+cap shr 3+64 else
      fCount := cap;        // fill trailing memory as much as possible
end;

function TSynQueue.Peek(out aValue): boolean;
begin
  fSafe.Lock;
  try
    result := fFirst>=0;
    if result then
      fValues.ElemCopyAt(fFirst,aValue);
  finally
    fSafe.UnLock;
  end;
end;

function TSynQueue.Pop(out aValue): boolean;
begin
  fSafe.Lock;
  try
    result := fFirst>=0;
    if result then begin
      fValues.ElemMoveTo(fFirst,aValue);
      if fFirst=fLast then begin
        fFirst := -1; // reset whole store (keeping current capacity)
        fLast := -2;
      end else begin
        inc(fFirst);
        if fFirst=fCount then
          fFirst := 0; // will retrieve from leading items
      end;
    end;
  finally
    fSafe.UnLock;
  end;
end;

function TSynQueue.InternalDestroying(incPopCounter: integer): boolean;
begin
  fSafe.Lock;
  try
    result := wpfDestroying in fWaitPopFlags;
    inc(fWaitPopCounter, incPopCounter);
  finally
    fSafe.UnLock;
  end;
end;

function TSynQueue.InternalWaitDone(endtix: Int64; const idle: TThreadMethod): boolean;
begin
  Sleep(1);
  if Assigned(idle) then
    idle; // e.g. Application.ProcessMessages
  result := InternalDestroying(0) or (GetTickCount64>endtix);
end;

function TSynQueue.WaitPop(aTimeoutMS: integer; const aWhenIdle: TThreadMethod;
  out aValue): boolean;
var endtix: Int64;
begin
  result := false;
  if not InternalDestroying(+1) then
    try
      endtix := GetTickCount64+aTimeoutMS;
      repeat
        result := Pop(aValue);
      until result or InternalWaitDone(endtix,aWhenIdle);
    finally
      InternalDestroying(-1);
    end;
end;

function TSynQueue.WaitPeekLocked(aTimeoutMS: integer; const aWhenIdle: TThreadMethod): pointer;
var endtix: Int64;
begin
  result := nil;
  if not InternalDestroying(+1) then
    try
      endtix := GetTickCount64+aTimeoutMS;
      repeat
        fSafe.Lock;
        try
          if fFirst>=0 then
            result := fValues.ElemPtr(fFirst);
        finally
          if result=nil then
            fSafe.UnLock; // caller should always Unlock once done
        end;
      until (result<>nil) or InternalWaitDone(endtix,aWhenIdle);
    finally
      InternalDestroying(-1);
    end;
end;

procedure TSynQueue.WaitPopFinalize;
var endtix: Int64; // never wait forever
begin
  fSafe.Lock;
  try
    include(fWaitPopFlags,wpfDestroying);
    if fWaitPopCounter = 0 then
      exit;
  finally
    fSafe.UnLock;
  end;
  endtix := GetTickCount64 + 100;
  repeat
    Sleep(1); // ensure WaitPos() is actually finished
  until (fWaitPopCounter=0) or (GetTickCount64>endtix);
end;

procedure TSynQueue.Save(out aDynArrayValues; aDynArray: PDynArray);
var n: integer;
    DA: TDynArray;
begin
  DA.Init(fValues.ArrayType,aDynArrayValues,@n);
  fSafe.Lock;
  try
    DA.Capacity := Count; // pre-allocate whole array, and set its length
    if fFirst>=0 then
      if fFirst<=fLast then
        DA.AddArray(fValueVar,fFirst,fLast-fFirst+1) else begin
        DA.AddArray(fValueVar,fFirst,fCount-fFirst);
        DA.AddArray(fValueVar,0,fLast+1);
      end;
  finally
    fSafe.UnLock;
  end;
  if aDynArray<>nil then
    aDynArray^.Init(fValues.ArrayType,aDynArrayValues);
end;


{ TMemoryMap }

function TMemoryMap.Map(aFile: THandle; aCustomSize: PtrUInt; aCustomOffset: Int64): boolean;
var Available: Int64;
begin
  fBuf := nil;
  fBufSize := 0;
  {$ifdef MSWINDOWS}
  fMap := 0;
  {$endif}
  fFileLocal := false;
  fFile := aFile;
  fFileSize := FileSeek64(fFile,0,soFromEnd);
  if fFileSize=0 then begin
    result := true; // handle 0 byte file without error (but no memory map)
    exit;
  end;
  result := false;
  if (fFileSize<=0) {$ifdef CPU32}or (fFileSize>maxInt){$endif} then
    /// maxInt = $7FFFFFFF = 1.999 GB (2GB would induce PtrInt errors)
    exit;
  if aCustomSize=0 then
    fBufSize := fFileSize else begin
    Available := fFileSize-aCustomOffset;
    if Available<0 then
      exit;
    if aCustomSize>Available then
      fBufSize := Available;
      fBufSize := aCustomSize;
  end;
  {$ifdef MSWINDOWS}
  with PInt64Rec(@fFileSize)^ do
    fMap := CreateFileMapping(fFile,nil,PAGE_READONLY,Hi,Lo,nil);
  if fMap=0 then
    raise ESynException.Create('TMemoryMap.Map: CreateFileMapping()=0');
  with PInt64Rec(@aCustomOffset)^ do
    fBuf := MapViewOfFile(fMap,FILE_MAP_READ,Hi,Lo,fBufSize);
  if fBuf=nil then begin
    // Windows failed to find a contiguous VA space -> fall back on direct read
    CloseHandle(fMap);
    fMap := 0;
  {$else}
  if aCustomOffset<>0 then
    if aCustomOffset and (SystemInfo.dwPageSize-1)<>0 then
      raise ESynException.CreateUTF8('fpmmap(aCustomOffset=%) with SystemInfo.dwPageSize=%',
        [aCustomOffset,SystemInfo.dwPageSize]) else
      aCustomOffset := aCustomOffset div SystemInfo.dwPageSize;
  fBuf := {$ifdef KYLIX3}mmap{$else}fpmmap{$endif}(
    nil,fBufSize,PROT_READ,MAP_SHARED,fFile,aCustomOffset);
  if fBuf=MAP_FAILED then begin
    fBuf := nil;
  {$endif}
  end else
    result := true;
end;

procedure TMemoryMap.Map(aBuffer: pointer; aBufferSize: PtrUInt);
begin
  fBuf := aBuffer;
  fFileSize := aBufferSize;
  fBufSize := aBufferSize;
  {$ifdef MSWINDOWS}
  fMap := 0;
  {$endif}
  fFile := 0;
  fFileLocal := false;
end;

function TMemoryMap.Map(const aFileName: TFileName): boolean;
var F: THandle;
begin
  result := false;
  // Memory-mapped file access does not go through the cache manager so
  // using FileOpenSequentialRead() is pointless here
  F := FileOpen(aFileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(F)<0 then
    exit;
  if Map(F)  then
    result := true else
    FileClose(F);
  fFileLocal := result;
end;

procedure TMemoryMap.UnMap;
begin
  {$ifdef MSWINDOWS}
  if fMap<>0 then begin
    UnmapViewOfFile(fBuf);
    CloseHandle(fMap);
    fMap := 0;
  end;
  {$else}
  if (fBuf<>nil) and (fBufSize>0) then
    {$ifdef KYLIX3}munmap{$else}fpmunmap{$endif}(fBuf,fBufSize);
  {$endif}
  fBuf := nil;
  fBufSize := 0;
  if fFile<>0 then begin
    if fFileLocal then
      FileClose(fFile);
    fFile := 0;
  end;
end;


{ TSynMemoryStream }

constructor TSynMemoryStream.Create(const aText: RawByteString);
begin
  inherited Create;
  SetPointer(pointer(aText),length(aText));
end;

constructor TSynMemoryStream.Create(Data: pointer; DataLen: PtrInt);
begin
  inherited Create;
  SetPointer(Data,DataLen);
end;

function TSynMemoryStream.Write(const Buffer; Count: Integer): Longint;
begin
  {$ifdef FPC}
  result := 0; // makes FPC compiler happy
  {$endif}
  raise EStreamError.CreateFmt('Unexpected %s.Write',[ClassNameShort(self)^]);
end;


{ TSynMemoryStreamMapped }

constructor TSynMemoryStreamMapped.Create(const aFileName: TFileName;
  aCustomSize: PtrUInt; aCustomOffset: Int64);
begin
  fFileName := aFileName;
  // Memory-mapped file access does not go through the cache manager so
  // using FileOpenSequentialRead() is pointless here
  fFileStream := TFileStream.Create(aFileName,fmOpenRead or fmShareDenyNone);
  Create(fFileStream.Handle,aCustomSize,aCustomOffset);
end;

constructor TSynMemoryStreamMapped.Create(aFile: THandle;
  aCustomSize: PtrUInt; aCustomOffset: Int64);
begin
  if not fMap.Map(aFile,aCustomSize,aCustomOffset) then
    raise ESynException.CreateUTF8('%.Create(%) mapping error',[self,fFileName]);
  inherited Create(fMap.fBuf,fMap.fBufSize);
end;

destructor TSynMemoryStreamMapped.Destroy;
begin
  fMap.UnMap;
  fFileStream.Free;
  inherited;
end;

function FileSeek64(Handle: THandle; const Offset: Int64; Origin: DWORD): Int64;
{$ifdef MSWINDOWS}
var R64: packed record Lo, Hi: integer; end absolute Result;
begin
  Result := Offset;
  R64.Lo := integer(SetFilePointer(Handle,R64.Lo,@R64.Hi,Origin));
  if (R64.Lo=-1) and (GetLastError<>0) then
    R64.Hi := -1; // so result=-1
end;
{$else}
begin
  {$ifdef FPC}
  result := FPLSeek(Handle,Offset,Origin);
  {$else}
  {$ifdef KYLIX3}
  result := LibC.lseek64(Handle,Offset,Origin);
  {$else}
  // warning: this won't handle file size > 2 GB :(
  result := FileSeek(Handle,Offset,Origin);
  {$endif}
  {$endif}
end;
{$endif}


{ TFileBufferWriter }

constructor TFileBufferWriter.Create(aFile: THandle; BufLen: integer);
begin
  Create(THandleStream.Create(aFile),BufLen);
  fInternalStream := true;
end;

constructor TFileBufferWriter.Create(const aFileName: TFileName; BufLen: integer;
  Append: boolean);
var s: TStream;
begin
  if Append and FileExists(aFileName) then begin
    s := TFileStream.Create(aFileName,fmOpenWrite);
    s.Seek(0,soFromEnd);
  end else
    s := TFileStream.Create(aFileName,fmCreate);
  Create(s,BufLen);
  fInternalStream := true;
end;

constructor TFileBufferWriter.Create(aStream: TStream; BufLen: integer);
begin
  if BufLen>1 shl 22 then
    fBufLen := 1 shl 22 else // 4 MB sounds right enough
  if BufLen<32 then
    fBufLen := 32;
    fBufLen := BufLen;
  fStream := aStream;
  SetLength(fBufInternal,fBufLen);
  fBuffer := pointer(fBufInternal);
end;

constructor TFileBufferWriter.Create(aClass: TStreamClass; BufLen: integer);
begin
  Create(aClass.Create,BufLen);
  fInternalStream := true;
end;

constructor TFileBufferWriter.Create(aStream: TStream; aTempBuf: pointer; aTempLen: integer);
begin
  fBufLen := aTempLen;
  fBuffer := aTempBuf;
  fStream := aStream;
end;

constructor TFileBufferWriter.Create(aClass: TStreamClass; aTempBuf: pointer; aTempLen: integer);
begin
  Create(aClass.Create,aTempBuf,aTempLen);
  fInternalStream := true;
end;

destructor TFileBufferWriter.Destroy;
begin
  if fInternalStream then
    fStream.Free;
  inherited;
end;

function TFileBufferWriter.Flush: Int64;
begin
  if fPos>0 then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  result := fTotalWritten;
  fTotalWritten := 0;
end;

procedure TFileBufferWriter.CancelAll;
begin
  fTotalWritten := 0;
  fPos := 0;
  if fStream.ClassType = TRawByteStringStream then
    TRawByteStringStream(fStream).Size := 0 else
    fStream.Seek(0,soBeginning);
end;

procedure TFileBufferWriter.Write(Data: pointer; DataLen: integer);
begin
  if (DataLen<=0) or (Data=nil) then
    exit;
  inc(fTotalWritten,DataLen);
  if fPos+DataLen>fBufLen then begin
    if fPos>0 then begin
      fStream.WriteBuffer(fBuffer^,fPos);
      fPos := 0;
    end;
    if DataLen>fBufLen then begin
      fStream.WriteBuffer(Data^,DataLen);
      exit;
    end;
  end;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Data^,fBuffer^[fPos],DataLen);
  inc(fPos,DataLen);
end;

procedure TFileBufferWriter.WriteN(Data: Byte; Count: integer);
var len: integer;
begin
  inc(fTotalWritten,Count);
  while Count>0 do begin
    if Count>fBufLen then
      len := fBufLen else
      len := Count;
    if fPos+len>fBufLen then begin
      fStream.WriteBuffer(fBuffer^,fPos);
      fPos := 0;
    end;
    {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(fBuffer^[fPos],len,Data);
    inc(fPos,len);
    dec(Count,len);
  end;
end;

procedure TFileBufferWriter.Write1(Data: byte);
begin
  if fPos+1>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  fBuffer^[fPos] := Data;
  inc(fPos);
  inc(fTotalWritten);
end;

procedure TFileBufferWriter.Write2(Data: word);
begin
  if fPos+2>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  PWord(@fBuffer^[fPos])^ := Data;
  inc(fPos,SizeOf(Word));
  inc(fTotalWritten,SizeOf(Word));
end;

procedure TFileBufferWriter.Write4(Data: integer);
begin
  if fPos+SizeOf(integer)>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  PInteger(@fBuffer^[fPos])^ := Data;
  inc(fPos,SizeOf(integer));
  inc(fTotalWritten,SizeOf(integer));
end;

procedure TFileBufferWriter.Write4BigEndian(Data: integer);
begin
  Write4({$ifdef FPC}SwapEndian{$else}bswap32{$endif}(Data));
end;

procedure TFileBufferWriter.Write8(const Data8Bytes);
begin
  if fPos+SizeOf(Int64)>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  PInt64(@fBuffer^[fPos])^ := Int64(Data8Bytes);
  inc(fPos,SizeOf(Int64));
  inc(fTotalWritten,SizeOf(Int64));
end;

procedure TFileBufferWriter.Write(const Text: RawByteString);
var L: integer;
begin
  L := length(Text);
  if L=0 then
    Write1(0) else begin
    WriteVarUInt32(L);
    Write(pointer(Text),L);
  end;
end;

procedure TFileBufferWriter.WriteShort(const Text: ShortString);
var L: integer;
begin
  L := ord(Text[0]);
  if L<$80 then
    Write(@Text[0],L+1) else begin
    WriteVarUInt32(L);
    Write(@Text[1],L);
  end;
end;

procedure TFileBufferWriter.WriteBinary(const Data: RawByteString);
begin
  Write(pointer(Data),Length(Data));
end;

procedure TFileBufferWriter.WriteDynArray(const DA: TDynArray);
var len: integer;
    tmp: RawByteString;
    P: PAnsiChar;
begin
  len := DA.SaveToLength;
  if (len<=fBufLen) and (fPos+len>fBufLen) then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  if fPos+len>fBufLen then begin
    SetLength(tmp,len);
    P := pointer(tmp);
  end else
    P := @fBuffer^[fPos]; // write directly into the buffer
  if DA.SaveTo(P)-P<>len then
    raise ESynException.CreateUTF8('%.WriteDynArray DA.SaveTo?',[self]);
  if tmp='' then begin
    inc(fPos,len);
    inc(fTotalWritten,len);
  end else
    Write(pointer(tmp),len);
end;

{$ifndef NOVARIANTS}
procedure TFileBufferWriter.Write(const Value: variant);
  procedure CustomType; // same code as VariantSave/VariantSaveLen
  begin
    Write(@TVarData(Value).VType,SizeOf(TVarData(Value).VType));
    Write(VariantSaveJSON(Value));
  end;
var tmp,buf: PAnsiChar;
    len: integer;
begin
  if TVarData(Value).VType>varAny then begin
    CustomType; // faster process without calling VariantSaveLength() for JSON
    exit;
  end;
  tmp := nil;
  len := VariantSaveLength(Value);
  if len=0 then
    raise ESynException.CreateUTF8('%.Write(VType=%) VariantSaveLength=0',
      [self,TVarData(Value).VType]);
  if fPos+len>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
    if len>fBufLen then begin
      GetMem(tmp,len);
      buf := tmp;
    end else
      buf := pointer(fBuffer);
  end else
    buf := @fBuffer^[fPos];
  if VariantSave(Value,buf)=nil then
    raise ESynException.CreateUTF8('%.Write(VType=%) VariantSave=nil',
      [self,TVarData(Value).VType]);
  inc(fTotalWritten,len);
  if tmp=nil then
    inc(fPos,len) else begin
    fStream.WriteBuffer(tmp^,len);
    FreeMem(tmp);
  end;
end;

procedure TFileBufferWriter.WriteDocVariantData(const Value: variant);
begin
  with _Safe(Value)^ do
    if Count=0 then
      Write1(0) else
      Write(ToJSON);
end;
{$endif NOVARIANTS}

procedure TFileBufferWriter.WriteXor(New,Old: PAnsiChar; Len: integer; crc: PCardinal);
var L: integer;
    Dest: PAnsiChar;
begin
  if (New=nil) or (Old=nil) then
    exit;
  inc(fTotalWritten,Len);
  while Len>0 do begin
    Dest := pointer(fBuffer);
    if fPos+Len>fBufLen then begin
      fStream.WriteBuffer(fBuffer^,fPos);
      fPos := 0;
    end else
      inc(Dest,fPos);
    if Len>fBufLen then
      L := fBufLen else
      L := Len;
    XorMemory(pointer(Dest),pointer(New),pointer(Old),L);
    if crc<>nil then
      crc^ := crc32c(crc^,Dest,L);
    inc(Old,L);
    inc(New,L);
    dec(Len,L);
    inc(fPos,L);
  end;
end;

procedure TFileBufferWriter.WriteRawUTF8DynArray(const Values: TRawUTF8DynArray;
  ValuesCount: integer);
var PI: PPtrUIntArray;
    n, i: integer;
    fixedsize, len: PtrUInt;
    P, PEnd: PByte;
    PBeg: PAnsiChar;
begin
  WriteVarUInt32(ValuesCount);
  PI := pointer(Values);
  if ValuesCount=0 then
    exit;
  fixedsize := length(Values[0]);
  if fixedsize>0 then
    for i := 1 to ValuesCount-1 do
      if (PI^[i]=0) or ({$ifdef FPC}PtrUInt(_LStrLenP(pointer(PI^[i]))){$else}
         PCardinal(PI^[i]-SizeOf(integer))^{$endif}<>fixedsize) then begin
        fixedsize := 0;
        break;
      end;
  WriteVarUInt32(fixedsize);
  repeat
    P := @fBuffer^[fPos];
    PEnd := @fBuffer^[fBufLen-8];
    if PtrUInt(P)<PtrUInt(PEnd) then begin
      n := ValuesCount;
      PBeg := PAnsiChar(P); // leave space for chunk size
      inc(P,4);
      if fixedsize=0 then
      for i := 0 to ValuesCount-1 do
        if PI^[i]=0 then begin
          P^ := 0; // store length=0
          inc(P);
          if PtrUInt(P)>=PtrUInt(PEnd) then begin
            n := i+1;
            break; // avoid buffer overflow
          end;
        end else begin
          len := {$ifdef FPC}_LStrLenP(pointer(PI^[i])){$else}PInteger(PI^[i]-SizeOf(integer))^{$endif};
          if PtrUInt(PEnd)-PtrUInt(P)<=len then begin
            n := i;
            break; // avoid buffer overflow
          end;
          P := ToVarUInt32(len,P);
          {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(PI^[i])^,P^,len);
          inc(P,len);
        end else
      // fixed size strings case
      for i := 0 to ValuesCount-1 do begin
        if PtrUInt(PEnd)-PtrUInt(P)<=fixedsize then begin
          n := i;
          break; // avoid buffer overflow
        end;
        {$ifdef FPC}Move{$else}MoveFast{$endif}(pointer(PI^[i])^,P^,fixedsize);
        inc(P,fixedsize);
      end;
      len := PAnsiChar(P)-PBeg; // format: Isize+varUInt32s*strings
      PInteger(PBeg)^ := len-4;
      inc(fTotalWritten,len);
      inc(fPos,len);
      inc(PByte(PI),n*SizeOf(PtrInt));
      dec(ValuesCount,n);
      if ValuesCount=0 then
        break;
    end;
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  until false;
end;

procedure TFileBufferWriter.WriteRawUTF8List(List: TRawUTF8List;
  StoreObjectsAsVarUInt32: Boolean);
var i: integer;
begin
  if List=nil then
    WriteVarUInt32(0) else begin
    WriteRawUTF8DynArray(List.fList,List.Count);
    if List.fObjects=nil then
      StoreObjectsAsVarUInt32 := false; // no Objects[] values
    Write(@StoreObjectsAsVarUInt32,1);
    if StoreObjectsAsVarUInt32 then
      for i := 0 to List.fCount-1 do
        WriteVarUInt32(PtrUInt(List.fObjects[i]));
  end;
end;

procedure TFileBufferWriter.WriteStream(aStream: TCustomMemoryStream;
  aStreamSize: Integer);
begin
  if aStreamSize<0 then
    if aStream=nil then
      aStreamSize := 0 else
      aStreamSize := aStream.Size;
  WriteVarUInt32(aStreamSize);
  if aStreamSize>0 then
    Write(aStream.Memory,aStreamSize);
end;

procedure TFileBufferWriter.WriteVarInt32(Value: PtrInt);
begin
  if Value<=0 then
    // 0->0, -1->2, -2->4..
    Value := (-Value) shl 1 else
    // 1->1, 2->3..
    Value := (Value shl 1)-1;
  WriteVarUInt32(Value);
end;

procedure TFileBufferWriter.WriteVarUInt32(Value: PtrUInt);
var pos: integer;
begin
  if fPos+16>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  pos := fPos;
  fPos := PtrUInt(ToVarUInt32(Value,@fBuffer^[fPos]))-PtrUInt(fBuffer);
  inc(fTotalWritten,PtrUInt(fPos-Pos));
end;

procedure TFileBufferWriter.WriteVarInt64(Value: Int64);
var pos: integer;
begin
  if fPos+48>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  pos := fPos;
  fPos := PtrUInt(ToVarInt64(Value,@fBuffer^[fPos]))-PtrUInt(fBuffer);
  inc(fTotalWritten,PtrUInt(fPos-Pos));
end;

procedure TFileBufferWriter.WriteVarUInt64(Value: QWord);
var pos: integer;
begin
  if fPos+48>fBufLen then begin
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  end;
  pos := fPos;
  fPos := PtrUInt(ToVarUInt64(Value,@fBuffer^[fPos]))-PtrUInt(fBuffer);
  inc(fTotalWritten,PtrUInt(fPos-Pos));
end;

function CleverStoreInteger(p: PInteger; V, VEnd: PAnsiChar; pCount: integer;
  var StoredCount: integer): PAnsiChar;
// Clever = store Values[i+1]-Values[i] (with special diff=1 count)
// format:  Integer: firstValue, then:
//          B:0 W:difference with previous
//          B:1..253 = difference with previous
//          B:254 W:byOne
//          B:255 B:byOne
var i, d, byOne: integer;
begin
  StoredCount := pCount;
  if pCount<=0 then begin
    result := V;
    exit;
  end;
  i := p^;
  PInteger(V)^ := p^;
  inc(V,4);
  dec(pCount);
  inc(p);
  byOne := 0;
  if pCount>0 then
  repeat
    d := p^-i;
    i := p^;
    inc(p);
    if d=1 then begin
      dec(pCount);
      inc(byOne);
      if pCount>0 then continue;
    end else
    if d<0 then begin
      result:= nil;
      exit;
    end;
    if byOne<>0 then begin
      case byOne of
      1: begin V^ := #1; inc(V); end; // B:1..253 = difference with previous
      2: begin PWord(V)^ := $0101; inc(V,2); end; // B:1..253 = difference
      else
      if byOne>255 then begin
        while byOne>65535 do begin
          PInteger(V)^ := $fffffe; inc(V,3); // store as many len=$ffff as necessary
          dec(byOne,$ffff);
        end;
        PInteger(V)^ := byOne shl 8+$fe; inc(V,3); // B:254 W:byOne
      end else begin
        PWord(V)^ := byOne shl 8+$ff; inc(V,2); // B:255 B:byOne
      end;
      end; // case byOne of
      if pCount=0 then break;
      byOne := 0;
    end;
    if (d=0) or (d>253) then begin
      while cardinal(d)>65535 do begin
        PInteger(V)^ := $ffff00; inc(V,3); // store as many len=$ffff as necessary
        dec(cardinal(d),$ffff);
      end;
      dec(pCount);
      PInteger(V)^ := d shl 8; inc(V,3); // B:0 W:difference with previous
      if (V<VEnd) and (pCount>0) then continue else break;
    end else begin
      dec(pCount);
      V^ := AnsiChar(d); inc(V); // B:1..253 = difference with previous
      if (V<VEnd) and (pCount>0) then continue else break;
    end;
    if V>=VEnd then
      break; // avoid GPF
  until false;
  dec(StoredCount,pCount);
  result := V;
end;

procedure TFileBufferWriter.WriteVarUInt32Array(const Values: TIntegerDynArray;
  ValuesCount: integer; DataLayout: TFileBufferWriterKind);
begin
  WriteVarUInt32Values(pointer(Values),ValuesCount,DataLayout);
end;

procedure TFileBufferWriter.WriteVarUInt32Values(Values: PIntegerArray;
  ValuesCount: integer; DataLayout: TFileBufferWriterKind);
var n, i, pos, diff: integer;
    P: PByte;
    PBeg, PEnd: PAnsiChar;
begin
  WriteVarUInt32(ValuesCount);
  if ValuesCount=0 then
    exit;
  fBuffer^[fPos] := ord(DataLayout);
  inc(fPos);
  inc(fTotalWritten);
  if DataLayout in [wkOffsetU, wkOffsetI] then begin
    pos := fPos;
    fPos := PtrUInt(ToVarUInt32(Values^[0],@fBuffer^[fPos]))-PtrUInt(fBuffer);
    diff := Values^[1]-Values^[0];
    inc(PInteger(Values));
    dec(ValuesCount);
    if ValuesCount=0 then begin
      inc(fTotalWritten,PtrUInt(fPos-pos));
      exit;
    end;
    if diff>0 then begin
      for i := 1 to ValuesCount-1 do
        if Values^[i]-Values^[i-1]<>diff then begin
          diff := 0; // not always the same offset
          break;
        end;
    end else
      diff := 0;
    fPos := PtrUInt(ToVarUInt32(diff,@fBuffer^[fPos]))-PtrUInt(fBuffer);
    inc(fTotalWritten,PtrUInt(fPos-pos));
    if diff<>0 then
      exit; // same offset for all items (fixed sized records) -> quit now
  end;
  repeat
    P := @fBuffer^[fPos];
    PEnd := @fBuffer^[fBufLen-32];
    if PtrUInt(P)<PtrUInt(PEnd) then begin
      pos := fPos;
      case DataLayout of
      wkUInt32: begin
        n := (fBufLen-fPos)shr 2;
        if ValuesCount<n then
          n := ValuesCount;
        {$ifdef FPC}Move{$else}MoveFast{$endif}(Values^,P^,n*4);
        inc(P,n*4);
      end;
      wkVarInt32, wkVarUInt32, wkOffsetU, wkOffsetI: begin
        PBeg := PAnsiChar(P); // leave space for chunk size
        inc(P,4);
        n := ValuesCount;
        case DataLayout of
        wkVarInt32:
          for i := 0 to ValuesCount-1 do begin
            P := ToVarInt32(Values^[i],P);
            if PtrUInt(P)>=PtrUInt(PEnd) then begin
              n := i+1;
              break; // avoid buffer overflow
            end;
          end;
        wkVarUInt32:
          for i := 0 to ValuesCount-1 do begin
            P := ToVarUInt32(Values^[i],P);
            if PtrUInt(P)>=PtrUInt(PEnd) then begin
              n := i+1;
              break; // avoid buffer overflow
            end;
          end;
        wkOffsetU:
          for i := 0 to ValuesCount-1 do begin
            P := ToVarUInt32(Values^[i]-Values^[i-1],P);
            if PtrUInt(P)>=PtrUInt(PEnd) then begin
              n := i+1;
              break; // avoid buffer overflow
            end;
          end;
        wkOffsetI:
          for i := 0 to ValuesCount-1 do begin
            P := ToVarInt32(Values^[i]-Values^[i-1],P);
            if PtrUInt(P)>=PtrUInt(PEnd) then begin
              n := i+1;
              break; // avoid buffer overflow
            end;
          end;
        end;
        PInteger(PBeg)^ := PAnsiChar(P)-PBeg-4; // format: Isize+varUInt32s
      end;
      wkSorted: begin
        PBeg := PAnsiChar(P)+4; // leave space for chunk size
        P := PByte(CleverStoreInteger(pointer(Values),PBeg,PEnd,ValuesCount,n));
        if P=nil then
          raise ESynException.CreateUTF8('%.WriteVarUInt32Array: data not sorted',[self]);
        PInteger(PBeg-4)^ := PAnsiChar(P)-PBeg; // format: Isize+cleverStorage
      end;
      end;
      inc(PByte(Values),n*4);
      fPos := PtrUInt(P)-PtrUInt(fBuffer);
      inc(fTotalWritten,PtrUInt(fPos-pos));
      dec(ValuesCount,n);
      if ValuesCount=0 then
        break;
    end;
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  until false;
end;

procedure TFileBufferWriter.WriteVarUInt64DynArray(
  const Values: TInt64DynArray; ValuesCount: integer; Offset: Boolean);
var n, i, pos: integer;
    diff: Int64;
    P, PEnd: PByte;
    PI: PInt64Array;
    PBeg: PAnsiChar;
begin
  WriteVarUInt32(ValuesCount);
  if ValuesCount=0 then
    exit;
  PI := pointer(Values);
  pos := fPos;
  if Offset then begin
    fBuffer^[fPos] := 1;
    fPos := PtrUInt(ToVarUInt64(PI^[0],@fBuffer^[fPos+1]))-PtrUInt(fBuffer);
    diff := PI^[1]-PI^[0];
    inc(PByte(PI),8);
    dec(ValuesCount);
    if ValuesCount=0 then begin
      inc(fTotalWritten,PtrUInt(fPos-pos));
      exit;
    end;
    if (diff>0) and (diff<MaxInt) then begin
      for i := 1 to ValuesCount-1 do
        if PI^[i]-PI^[i-1]<>diff then begin
          diff := 0; // not always the same offset
          break;
        end;
    end else
      diff := 0;
    fPos := PtrUInt(ToVarUInt32(diff,@fBuffer^[fPos]))-PtrUInt(fBuffer);
    if diff<>0 then begin
      inc(fTotalWritten,PtrUInt(fPos-Pos));
      exit; // same offset for all items (fixed sized records) -> quit now
    end;
  end else begin
    fBuffer^[fPos] := 0;
    inc(fPos);
  end;
  inc(fTotalWritten,PtrUInt(fPos-Pos));
  repeat
    P := @fBuffer^[fPos];
    PEnd := @fBuffer^[fBufLen-32];
    if PtrUInt(P)<PtrUInt(PEnd) then begin
      pos := fPos;
      PBeg := PAnsiChar(P); // leave space for chunk size
      inc(P,4);
      n := ValuesCount;
      if Offset then
        for i := 0 to ValuesCount-1 do begin
          P := ToVarUInt64(PI^[i]-PI^[i-1],P); // store diffs
          if PtrUInt(P)>=PtrUInt(PEnd) then begin
            n := i+1;
            break; // avoid buffer overflow
          end;
        end
      else
        for i := 0 to ValuesCount-1 do begin
          P := ToVarUInt64(PI^[i],P);
          if PtrUInt(P)>=PtrUInt(PEnd) then begin
            n := i+1;
            break; // avoid buffer overflow
          end;
        end;
      PInteger(PBeg)^ := PAnsiChar(P)-PBeg-4; // format: Isize+varUInt32/64s
      inc(PByte(PI),n*8);
      fPos := PtrUInt(P)-PtrUInt(fBuffer);
      inc(fTotalWritten,PtrUInt(fPos-Pos));
      dec(ValuesCount,n);
      if ValuesCount=0 then
        break;
    end;
    fStream.WriteBuffer(fBuffer^,fPos);
    fPos := 0;
  until false;
end;

function TFileBufferWriter.FlushAndCompress(nocompression: boolean; algo: TAlgoCompress;
  BufferOffset: integer): RawByteString;
var trig: integer;
begin
  if algo=nil then
    algo := AlgoSynLZ;
  trig := SYNLZTRIG[nocompression];
  if fStream.Position=0 then // direct compression from internal buffer
    result := algo.Compress(PAnsiChar(fBuffer),fPos,trig,false,BufferOffset) else begin
    Flush;
    result := algo.Compress((fStream as TRawByteStringStream).DataString,trig,false,BufferOffset);
  end;
end;

function TFileBufferWriter.WriteDirectStart(maxSize: integer;
  const TooBigMessage: RawUTF8): PByte;
begin
  inc(maxSize,fPos);
  if maxSize>fBufLen then begin
    fTotalWritten := Flush;
    if maxSize>fBufLen then begin
      if maxSize>100 shl 20 then
        raise ESynException.CreateUTF8('%.WriteDirectStart: too big % - '+
          'we allow up to 100 MB block',[self,TooBigMessage]);
      if fBufInternal='' then
        raise ESynException.CreateUTF8('%.WriteDirectStart: no internal buffer', [self]);
      fBufLen := maxSize+1024;
      SetString(fBufInternal,nil,fBufLen);
      fBuffer := pointer(fBufInternal);
    end;
  end;
  result := @fBuffer^[fPos];
end;

procedure TFileBufferWriter.WriteDirectEnd(realSize: integer);
begin
  if fPos+realSize>fBufLen then
    raise ESynException.CreateUTF8(
      '%.WriteDirectEnd: too big %',[self,realSize]);
  inc(fPos,realSize);
  inc(fTotalWritten,realSize);
end;


{ TFileBufferReader }

procedure TFileBufferReader.Close;
begin
  fMap.UnMap;
end;

procedure TFileBufferReader.ErrorInvalidContent;
begin
  raise ESynException.Create('TFileBufferReader: invalid content');
end;

procedure TFileBufferReader.OpenFrom(aBuffer: pointer; aBufferSize: PtrUInt);
begin
  fCurrentPos := 0;
  fMap.Map(aBuffer,aBufferSize);
end;

procedure TFileBufferReader.OpenFrom(const aBuffer: RawByteString);
begin
  OpenFrom(pointer(aBuffer),length(aBuffer));
end;

function TFileBufferReader.OpenFrom(Stream: TStream): boolean;
begin
  result := false;
  if Stream=nil then
    exit;
  if Stream.InheritsFrom(TFileStream) then
    Open(TFileStream(Stream).Handle) else
  if Stream.InheritsFrom(TCustomMemoryStream) then
    with TCustomMemoryStream(Stream) do
      OpenFrom(Memory,Size) else
      exit;
  result := true
end;

procedure TFileBufferReader.Open(aFile: THandle);
begin
  fCurrentPos := 0;
  fMap.Map(aFile)
  // if Windows failed to find a contiguous VA space -> fall back on direct read
end;

function TFileBufferReader.Read(Data: pointer; DataLen: integer): integer;
var len: integer;
begin
  if DataLen>0 then
    if fMap.fBuf<>nil then begin
      // file up to 2 GB: use fast memory map
      len := fMap.fBufSize-fCurrentPos;
      if len>DataLen then
        len := DataLen;
      if Data<>nil then
        {$ifdef FPC}Move{$else}MoveFast{$endif}(fMap.fBuf[fCurrentPos],Data^,len);
      inc(fCurrentPos,len);
      result := len;
    end else
      // file bigger than 2 GB: slower but accurate reading from file
      if Data=nil then begin
        FileSeek(fMap.fFile,soFromCurrent,DataLen);
        result := DataLen;
      end else
        result := FileRead(fMap.fFile,Data^,DataLen) else
      // DataLen=0
      result := 0;
end;

function TFileBufferReader.Read(out Text: RawByteString): integer;
begin
  result := ReadVarUInt32;
  if result=0 then
    exit;
  SetLength(Text,result);
  if Read(pointer(Text),result)<>result then
    ErrorInvalidContent;
end;

function TFileBufferReader.Read(out Text: RawUTF8): integer;
begin
  result := ReadVarUInt32;
  if result=0 then
    exit;
  SetLength(Text,result);
  if Read(pointer(Text),result)<>result then
    ErrorInvalidContent;
end;

function TFileBufferReader.ReadRawUTF8: RawUTF8;
begin
  Read(result);
end;

procedure TFileBufferReader.ReadChunk(out P, PEnd: PByte; var BufTemp: RawByteString);
var len: integer;
begin // read Isize + buffer in P,PEnd
  if (Read(@len,4)<>4) or (len<0) then
    ErrorInvalidContent;
  P := ReadPointer(len,BufTemp);
  if P=nil then
    ErrorInvalidContent;
  PEnd := pointer(PtrUInt(P)+PtrUInt(len));
end;

function TFileBufferReader.CurrentMemory(DataLen: PtrUInt): pointer;
begin
  if (fMap.fBuf=nil) or (fCurrentPos+DataLen>=fMap.fBufSize) then
    result := nil else begin
    result := @fMap.fBuf[fCurrentPos];
    inc(fCurrentPos,DataLen);
  end;
end;

function TFileBufferReader.CurrentPosition: integer;
begin
  if (fMap.fBuf=nil) or (fCurrentPos>=fMap.fBufSize) then
    result := -1 else
    result := fCurrentPos;
end;

function TFileBufferReader.ReadPointer(DataLen: PtrUInt;
  var aTempData: RawByteString): pointer;
begin
  if fMap.fBuf=nil then begin
    // read from file
    if DataLen>PtrUInt(Length(aTempData)) then begin
      aTempData := ''; // so no move() call in SetLength() below
      SetLength(aTempData,DataLen);
    end;
    if PtrUInt(FileRead(fMap.fFile,pointer(aTempData)^,DataLen))<>DataLen then
      result := nil else // invalid content
      result := pointer(aTempData);
  end else
  if DataLen+fCurrentPos>fMap.fBufSize then
    // invalid request
    result := nil else begin
    // get pointer to data from current memory map (no data copy)
    result := @fMap.fBuf[fCurrentPos];
    inc(fCurrentPos,DataLen);
  end;
end;

function TFileBufferReader.ReadStream(DataLen: PtrInt): TCustomMemoryStream;
var FileCurrentPos: Int64;
begin
  if DataLen<0 then
    DataLen := ReadVarUInt32;
  if DataLen<>0 then
    if fMap.fBuf=nil then begin
      FileCurrentPos := FileSeek64(fMap.fFile,0,soFromCurrent);
      if FileCurrentPos+DataLen>fMap.fFileSize then
        // invalid content
        result := nil else begin
        // create a temporary memory map buffer stream
        result := TSynMemoryStreamMapped.Create(fMap.fFile,DataLen,FileCurrentPos);
        FileSeek64(fMap.fFile,DataLen,soFromCurrent);
      end;
    end else
    if PtrUInt(DataLen)+fCurrentPos>fMap.fBufSize then
      // invalid content
      result := nil else begin
      // get pointer to data from current memory map (no data copy)
      result := TSynMemoryStream.Create(@fMap.fBuf[fCurrentPos],DataLen);
      inc(fCurrentPos,DataLen);
    end else
    // DataLen=0 -> invalid content
    result := nil;
end;

function TFileBufferReader.ReadByte: PtrUInt;
begin
  if fMap.fBuf<>nil then
    if fCurrentPos>=fMap.fBufSize then
      // invalid request
      result := 0 else begin
      // read one byte from current memory map
      result := ord(fMap.fBuf[fCurrentPos]);
      inc(fCurrentPos);
    end else begin
    // read from file if >= 2 GB (slow, but works)
    result := 0;
    if FileRead(fMap.fFile,result,1)<>1 then
      result := 0;
  end;
end;

function TFileBufferReader.ReadCardinal: cardinal;
begin
  if fMap.fBuf<>nil then
    if fCurrentPos+3>=fMap.fBufSize then
      // invalid request
      result := 0 else begin
      // read one byte from current memory map
      result := PCardinal(fMap.fBuf+fCurrentPos)^;
      inc(fCurrentPos,4);
    end else begin
      // read from file if >= 2 GB (slow, but works)
      result := 0;
      if FileRead(fMap.fFile,result,4)<>4 then
        result := 0;
    end;
end;

function TFileBufferReader.ReadVarUInt32: PtrUInt;
var c, n: PtrUInt;
begin
  result := ReadByte;
  if result>$7f then begin
    n := 0;
    result := result and $7F;
    repeat
      c := ReadByte;
      inc(n,7);
      if c<=$7f then break;
      result := result or ((c and $7f) shl n);
    until false;
    result := result or (c shl n);
  end;
end;

function TFileBufferReader.ReadVarInt32: PtrInt;
begin
  result := ReadVarUInt32;
  if result and 1<>0 then
    // 1->1, 3->2..
    result := result shr 1+1 else
    // 0->0, 2->-1, 4->-2..
    result := -(result shr 1);
end;

function TFileBufferReader.ReadVarUInt64: QWord;
var c, n: PtrUInt;
begin
  result := ReadByte;
  if result>$7f then begin
    n := 0;
    result := result and $7F;
    repeat
      c := ReadByte;
      inc(n,7);
      if c<=$7f then break;
      result := result or (QWord(c and $7f) shl n);
    until false;
    result := result or (QWord(c) shl n);
  end;
end;

function TFileBufferReader.ReadVarInt64: Int64;
begin
  result := ReadVarUInt64;
  if result<>0 then
    if result and 1<>0 then
      // 1->1, 3->2..
      result := result shr 1+1 else
      // 0->0, 2->-1, 4->-2..
      result := -(result shr 1);
end;

function CleverReadInteger(p, pEnd: PAnsiChar; V: PInteger): PtrUInt;
// Clever = decode Values[i+1]-Values[i] storage (with special diff=1 count)
var i, n: PtrUInt;
begin
  result := PtrUInt(V);
  i := PInteger(p)^; inc(p,4); // Integer: firstValue
  V^ := i; inc(V);
  if PtrUInt(p)<PtrUInt(pEnd) then
  repeat
    case p^ of
      #0: begin // B:0 W:difference with previous
        inc(i,PWord(p+1)^); inc(p,3);
        V^ := i; inc(V);
        if PtrUInt(p)<PtrUInt(pEnd) then continue else break;
      end;
      #254: begin // B:254 W:byOne
        for n := 1 to PWord(p+1)^ do begin
          inc(i);
          V^ := i; inc(V);
        end;
        inc(p,3);
        if PtrUInt(p)<PtrUInt(pEnd) then continue else break;
      end;
      #255: begin // B:255 B:byOne
        for n := 1 to pByte(p+1)^ do begin
          inc(i);
          V^ := i; inc(V);
        end;
        inc(p,2);
        if PtrUInt(p)<PtrUInt(pEnd) then continue else break;
      end else begin // B:1..253 = difference with previous
        inc(i,ord(p^)); inc(p);
        V^ := i; inc(V);
        if PtrUInt(p)<PtrUInt(pEnd) then continue else break;
      end;
    end; // case p^ of
  until false;
  result := (PtrUInt(V)-result) shr 2; // returns count of stored integer
end;

function TFileBufferReader.ReadVarUInt32Array(var Values: TIntegerDynArray): PtrInt;
var count, n, i, diff: integer;
    DataLayout: TFileBufferWriterKind;
    P, PEnd: PByte;
    PI: PInteger;
    PIA: PIntegerArray absolute PI;
    BufTemp: RawByteString;
begin
  result := ReadVarUInt32;
  if result=0 then
    exit;
  DataLayout := TFileBufferWriterKind(ReadByte);
  if DataLayout=wkFakeMarker then begin
    result := -result;
    exit;
  end;
  count := result;
  if count>length(Values) then // only set length is not big enough
    SetLength(Values,count);
  PI := pointer(Values);
  if DataLayout in [wkOffsetU, wkOffsetI] then begin
    PI^ := ReadVarUInt32;
    dec(count);
    if count=0 then
      exit;
    diff := ReadVarUInt32;
    if diff<>0 then begin
      for i := 0 to count-1 do
        PIA^[i+1] := PIA^[i]+diff;
      exit;
    end;
  end;
  if DataLayout=wkUInt32 then
    Read(@Values[0],count*4) else begin
    repeat
      ReadChunk(P,PEnd,BufTemp); // raise ErrorInvalidContent on error
      case DataLayout of
      wkVarInt32:
        while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
          PI^ := FromVarInt32(P);
          dec(count);
          inc(PI);
        end;
      wkVarUInt32:
        while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
          PI^ := FromVarUInt32(P);
          dec(count);
          inc(PI);
        end;
      wkSorted: begin
        n := CleverReadInteger(pointer(P),pointer(PEnd),PI);
        dec(count,n);
        inc(PByte(PI),n*4);
      end;
      wkOffsetU: begin
        while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
          PIA^[1] := PIA^[0]+integer(FromVarUInt32(P));
          dec(count);
          inc(PI);
        end;
        if count<=0 then
          inc(PI); // make sure PI=@Values[result]
      end;
      wkOffsetI: begin
        while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
          PIA^[1] := PIA^[0]+FromVarInt32(P);
          dec(count);
          inc(PI);
        end;
        if count<=0 then
          inc(PI); // make sure PI=@Values[result]
      end;
      else
        ErrorInvalidContent;
      end;
    until count<=0;
    if PI<>@Values[result] then
      ErrorInvalidContent;
  end;
end;

function TFileBufferReader.ReadVarUInt64Array(var Values: TInt64DynArray): PtrInt;
var count, diff, i: integer;
    Offset: boolean;
    P, PEnd: PByte;
    PI: PInt64;
    PIA: PInt64Array absolute PI;
    BufTemp: RawByteString;
label delphi5bug; // circumvent internal error C3517 on Delphi 5
begin
  result := ReadVarUInt32;
  if result=0 then
    exit;
  count := result;
  if count>length(Values) then // only set length is not big enough
    SetLength(Values,count);
  Offset := boolean(ReadByte);
  PI := pointer(Values);
  if Offset then begin
    PI^ := ReadVarUInt64; // read first value
    dec(count);
    diff := ReadVarUInt32;
    if diff=0 then begin
      // read all offsets, and compute (not fixed sized records)
      repeat
        ReadChunk(P,PEnd,BufTemp); // raise ErrorInvalidContent on error
        while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
          PIA^[1] := PIA^[0]+Int64(FromVarUInt64(P));
          dec(count);
          inc(PI);
        end;
      until count<=0;
    end else
      // same offset for all items (fixed sized records)
      for i := 0 to count-1 do
        PIA^[i+1] := PIA^[i]+diff;
    exit;
  end;
delphi5bug:
  ReadChunk(P,PEnd,BufTemp); // raise ErrorInvalidContent on error
  while PtrUInt(P)<PtrUInt(PEnd) do begin
    PI^ := FromVarUInt64(P);
    dec(count);
    inc(PI);
    if count=0 then
      exit;
  end;
  goto delphi5bug;
end;

function TFileBufferReader.ReadRawUTF8List(List: TRawUTF8List): boolean;
var i: integer;
    StoreObjectsAsVarUInt32: Boolean;
begin
  if (fMap.fBuf<>nil) and (List<>nil) then
  with List do begin
    BeginUpdate;
    try
      Capacity := 0; // finalize both fObjects[] and fList[]
      fCount := ReadVarRawUTF8DynArray(List.fList);
      result := true;
      if fCount=0 then
        exit;
      Read(@StoreObjectsAsVarUInt32,1);
      if StoreObjectsAsVarUInt32 then begin
        fObjectsOwned := false; // Int32 here, not instances
        SetLength(fObjects,Capacity);
        for i := 0 to fCount-1 do
          fObjects[i] := TObject(ReadVarUInt32);
      end;
    finally
      EndUpdate;
    end;
  end else
    result := false;
end;

function TFileBufferReader.ReadVarRawUTF8DynArray(var Values: TRawUTF8DynArray): PtrInt;
var count, len, fixedsize: integer;
    P, PEnd: PByte;
    PI: PRawUTF8;
    BufTemp: RawByteString;
begin
  result := ReadVarUInt32;
  if result=0 then
    exit;
  count := result;
  if count>length(Values) then // only set length is not big enough
    SetLength(Values,count);
  PI := pointer(Values);
  fixedsize := ReadVarUInt32;
  repeat
    ReadChunk(P,PEnd,BufTemp); // raise ErrorInvalidContent on error
    if fixedsize=0 then
    while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
      len := FromVarUInt32(P);
      if len>0 then begin
        FastSetString(PI^,P,len);
        inc(P,len);
      end else
        if PI^<>'' then
          PI^ := '';
      dec(count);
      inc(PI);
    end else
    // fixed size strings case
    while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
      FastSetString(PI^,P,fixedsize);
      inc(P,fixedsize);
      dec(count);
      inc(PI);
    end;
  until count<=0;
  if PI<>@Values[result] then
    ErrorInvalidContent;
end;

{$ifndef CPU64}
function TFileBufferReader.Seek(Offset: Int64): boolean;
begin
  if (Offset<0) or (Offset>fMap.fFileSize) then
    result := False else
  if fMap.fBuf=nil then
    result := FileSeek64(fMap.fFile,Offset,soFromBeginning)=Offset else begin
    fCurrentPos := PCardinal(@Offset)^;
    result := true;
  end;
end;
{$endif CPU64}

function TFileBufferReader.Seek(Offset: PtrInt): boolean;
begin
  // we don't need to handle fMap=0 here
  if fMap.fBuf=nil then
    Result := FileSeek(fMap.fFile,Offset,0)=Offset else
  if (fMap.fBuf<>nil) and (PtrUInt(Offset)<PPtrUInt(@fMap.fFileSize)^) then begin
    fCurrentPos := Offset;
    result := true;
  end else
    result := false;
end;



function PropNameValid(P: PUTF8Char): boolean;
begin
  result := false;
  if (P=nil) or not (P^ in ['a'..'z','A'..'Z','_']) then
    exit; // first char must be alphabetical
  inc(P);
  while P^<>#0 do
    if not (ord(P^) in IsIdentifier) then
      exit else // following chars can be alphanumerical
      inc(P);
  result := true;
end;

function PropNamesValid(const Values: array of RawUTF8): boolean;
var i,j: integer;
begin
  result := false;
  for i := 0 to high(Values) do
    for j := 1 to length(Values[i]) do
      if not (ord(Values[i][j]) in IsIdentifier) then
        exit;
  result := true;
end;

function JsonPropNameValid(P: PUTF8Char): boolean;
{$ifdef HASINLINENOTX86}
begin
  if (P<>nil) and (ord(P^) in IsJsonIdentifierFirstChar) then begin
    repeat
      inc(P);
    until not(ord(P^) in IsJsonIdentifier);
    if P^=#0 then begin
      result := true;
      exit;
    end else begin
      result := false;
      exit;
    end;
  end else
    result := false;
end;
{$else}
asm
        test    eax, eax
        jz      @z
        movzx   edx, byte ptr[eax]
        bt      [offset @first], edx
        mov     ecx, offset @chars
        jb      @2
@z:     xor     eax, eax
        ret
@first: dd      0, $03FF0010, $87FFFFFE, $07FFFFFE, 0, 0, 0, 0 // IsJsonIdentifierFirstChar
@chars: dd      0, $03FF4000, $AFFFFFFE, $07FFFFFE, 0, 0, 0, 0 // IsJsonIdentifier
@s:     mov     dl, [eax]
        bt      [ecx], edx
        jnb     @1
@2:     mov     dl, [eax + 1]
        bt      [ecx], edx
        jnb     @1
        mov     dl, [eax + 2]
        bt      [ecx], edx
        jnb     @1
        mov     dl, [eax + 3]
        add     eax, 4
        bt      [ecx], edx
        jb      @s
@1:     test    dl, dl
        setz    al
end;
{$endif HASINLINENOTX86}

function StrCompL(P1,P2: PUTF8Char; L, Default: Integer): PtrInt;
var i: PtrInt;
begin
  i := 0;
  repeat
    result := PtrInt(P1[i])-PtrInt(P2[i]);
    if result=0 then begin
      inc(i);
      if i<L then continue else break;
    end;
    exit;
  until false;
  result := Default;
end;

function StrCompIL(P1,P2: PUTF8Char; L, Default: Integer): PtrInt;
var i: PtrInt;
    tab: {$ifdef CPUX86NOTPIC}TNormTable absolute NormToUpperAnsi7{$else}PNormTable{$endif};
begin
  i := 0;
  {$ifndef CPUX86NOTPIC}tab := @NormToUpperAnsi7;{$endif} // faster on PIC and x86_64
  repeat
    if tab[P1[i]]=tab[P2[i]] then begin
      inc(i);
      if i<L then continue else break;
    end;
    result := PtrInt(P1[i])-PtrInt(P2[i]);
    exit;
  until false;
  result := Default;
end;

function IsRowID(FieldName: PUTF8Char): boolean;
{$ifdef CPU64}
var f: Int64;
begin
  if FieldName<>nil then begin
    f := PInt64(FieldName)^;
    result := (f and $ffdfdf=(ord('I')+ord('D')shl 8)) or (f and $ffdfdfdfdfdf=
      (ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24+Int64(ord('D')) shl 32))
  end
{$else}
begin
  if FieldName<>nil then
    result := (PInteger(FieldName)^ and $ffdfdf=ord('I')+ord('D')shl 8) or
      ((PIntegerArray(FieldName)^[0] and $dfdfdfdf=
        ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24) and
       (PIntegerArray(FieldName)^[1] and $ffdf=ord('D')))
{$endif} else result := false;
end;

function IsRowID(FieldName: PUTF8Char; FieldLen: integer): boolean;
begin
  case FieldLen of
  2: result :=
    PWord(FieldName)^ and $dfdf=ord('I')+ord('D')shl 8;
  5: result :=
    (PInteger(FieldName)^ and $dfdfdfdf=
      ord('R')+ord('O')shl 8+ord('W')shl 16+ord('I')shl 24) and
    (ord(FieldName[4]) and $df=ord('D'));
  else result := false;
  end;
end;

function IsRowIDShort(const FieldName: shortstring): boolean;
begin
  result :=
    (PInteger(@FieldName)^ and $DFDFFF=
      2+ord('I')shl 8+ord('D')shl 16) or
    ((PIntegerArray(@FieldName)^[0] and $dfdfdfff=
      5+ord('R')shl 8+ord('O')shl 16+ord('W')shl 24) and
     (PIntegerArray(@FieldName)^[1] and $dfdf=
       ord('I')+ord('D')shl 8));
end;

function GetNextFieldProp(var P: PUTF8Char; var Prop: RawUTF8): boolean;
var B: PUTF8Char;
begin
  while P^ in [#1..' ',';'] do inc(P);
  B := P;
  while ord(P^) in IsIdentifier do inc(P); // go to end of field name
  FastSetString(Prop,B,P-B);
  while P^ in [#1..' ',';'] do inc(P);
  result := Prop<>'';
end;


type
  TSynLZHead = packed record
    Magic: cardinal;
    CompressedSize: integer;
    HashCompressed: cardinal;
    UnCompressedSize: integer;
    HashUncompressed: cardinal;
  end;
  PSynLZHead = ^TSynLZHead;
  TSynLZTrailer = packed record
    HeaderRelativeOffset: cardinal;
    Magic: cardinal;
  end;
  PSynLZTrailer = ^TSynLZTrailer;

function StreamSynLZComputeLen(P: PAnsiChar; Len, aMagic: cardinal): integer;
begin
  if (P=nil) or (Len<=SizeOf(TSynLZTrailer)) then
    result := 0 else
    with PSynLZTrailer(P+Len-SizeOf(TSynLZTrailer))^ do
      if (Magic=aMagic) and (HeaderRelativeOffset<Len) and
         (PSynLZHead(P+Len-HeaderRelativeOffset)^.Magic=aMagic) then
        // trim existing content
        result := Len-HeaderRelativeOffset else
        result := Len;
end;

function CompressSynLZ(var DataRawByteString; Compress: boolean): AnsiString;
var DataLen, len: integer;
    P: PAnsiChar;
    Data: RawByteString absolute DataRawByteString;
begin
  DataLen := length(Data);
  if DataLen<>0 then // '' is compressed and uncompressed to ''
  if Compress then begin
    len := SynLZcompressdestlen(DataLen)+8;
    SetString(result,nil,len);
    P := pointer(result);
    PCardinal(P)^ := Hash32(pointer(Data),DataLen);
    len := SynLZcompress1(pointer(Data),DataLen,P+8);
    PCardinal(P+4)^ := Hash32(pointer(P+8),len);
    SetString(Data,P,len+8);
  end else begin
    result := '';
    P := pointer(Data);
    if (DataLen<=8) or (Hash32(pointer(P+8),DataLen-8)<>PCardinal(P+4)^) then
      exit;
    len := SynLZdecompressdestlen(P+8);
    SetLength(result,len);
    if (len<>0) and  ((SynLZDecompress1(P+8,DataLen-8,pointer(result))<>len) or
       (Hash32(pointer(result),len)<>PCardinal(P)^)) then begin
      result := '';
      exit;
    end else
      SetString(Data,PAnsiChar(pointer(result)),len);
  end;
  result := 'synlz';
end;

function StreamSynLZ(Source: TCustomMemoryStream; Dest: TStream; Magic: cardinal): integer;
var DataLen: integer;
    S,D: pointer;
    Head: TSynLZHead;
    Trailer: TSynLZTrailer;
    tmp: TSynTempBuffer;
begin
  if Dest=nil then begin
    result := 0;
    exit;
  end;
  if Source<>nil then begin
    S := Source.Memory;
    DataLen := Source.Size;
  end else begin
    S := nil;
    DataLen := 0;
  end;
  tmp.Init(SynLZcompressdestlen(DataLen));
  try
    Head.Magic := Magic;
    Head.UnCompressedSize := DataLen;
    Head.HashUncompressed := Hash32(S,DataLen);
    result := SynLZcompress1(S,DataLen,tmp.buf);
    if result>tmp.len then
      raise ESynException.Create('StreamLZ: SynLZ compression overflow');
    if result>DataLen then begin
      result := DataLen; // compression not worth it
      D := S;
    end else
      D := tmp.buf;
    Head.CompressedSize := result;
    Head.HashCompressed := Hash32(D,result);
    Dest.WriteBuffer(Head,SizeOf(Head));
    Dest.WriteBuffer(D^,Head.CompressedSize);
    Trailer.HeaderRelativeOffset := result+(SizeOf(Head)+SizeOf(Trailer));
    Trailer.Magic := Magic;
    Dest.WriteBuffer(Trailer,SizeOf(Trailer));
    result := Head.CompressedSize+(SizeOf(Head)+SizeOf(Trailer));
  finally
    tmp.Done;
  end;
end;

function StreamSynLZ(Source: TCustomMemoryStream; const DestFile: TFileName;
  Magic: cardinal): integer;
var F: TFileStream;
begin
  F := TFileStream.Create(DestFile,fmCreate);
  try
    result := StreamSynLZ(Source,F,Magic);
  finally
    F.Free;
  end;
end;

const
  /// 128 MB default buffer
  FILESYNLZ_BLOCKSIZE = 128*1024*1024;

function FileSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;
var src,dst: RawByteString;
    S,D: TFileStream;
    Head: TSynLZHead;
    Count: Int64;
begin
  result := false;
  if FileExists(Source) then
  try
    S := FileStreamSequentialRead(Source);
    try
      DeleteFile(Dest);
      D := TFileStream.Create(Dest,fmCreate);
      try
        Head.Magic := Magic;
        Count := S.Size;
        while Count>0 do begin
          if Count>FILESYNLZ_BLOCKSIZE then
            Head.UnCompressedSize := FILESYNLZ_BLOCKSIZE else
            Head.UnCompressedSize := Count;
          if src='' then
            SetString(src,nil,Head.UnCompressedSize);
          if dst='' then
            SetString(dst,nil,SynLZcompressdestlen(Head.UnCompressedSize));
          S.Read(pointer(src)^,Head.UnCompressedSize);
          Head.HashUncompressed := Hash32(pointer(src),Head.UnCompressedSize);
          Head.CompressedSize :=
            SynLZcompress1(pointer(src),Head.UnCompressedSize,pointer(dst));
          Head.HashCompressed := Hash32(pointer(dst),Head.CompressedSize);
          if (D.Write(Head,SizeOf(Head))<>SizeOf(Head)) or
             (D.Write(pointer(dst)^,Head.CompressedSize)<>Head.CompressedSize) then
            exit;
          dec(Count,Head.UnCompressedSize);
        end;
      finally
        D.Free;
      end;
      result := FileSetDateFrom(Dest,S.Handle);
    finally
      S.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function FileUnSynLZ(const Source, Dest: TFileName; Magic: Cardinal): boolean;
var src,dst: RawByteString;
    S,D: TFileStream;
    Count: Int64;
    Head: TSynLZHead;
begin
  result := false;
  if FileExists(Source) then
  try
    S := FileStreamSequentialRead(Source);
    try
      DeleteFile(Dest);
      D := TFileStream.Create(Dest,fmCreate);
      try
        Count := S.Size;
        while Count>0 do begin
          if S.Read(Head,SizeOf(Head))<>SizeOf(Head) then
            exit;
          dec(Count,SizeOf(Head));
          if (Head.Magic<>Magic) or
             (Head.CompressedSize>Count) then
            exit;
          if Head.CompressedSize>length(src) then
            SetString(src,nil,Head.CompressedSize);
          if S.Read(pointer(src)^,Head.CompressedSize)<>Head.CompressedSize then
            exit;
          dec(Count,Head.CompressedSize);
          if (Hash32(pointer(src),Head.CompressedSize)<>Head.HashCompressed) or
             (SynLZdecompressdestlen(pointer(src))<>Head.UnCompressedSize) then
            exit;
          if Head.UnCompressedSize>length(dst) then
            SetString(dst,nil,Head.UnCompressedSize);
          if (SynLZDecompress1(pointer(src),Head.CompressedSize,pointer(dst))<>Head.UnCompressedSize) or
             (Hash32(pointer(dst),Head.UnCompressedSize)<>Head.HashUncompressed) then
            exit;
          if D.Write(pointer(dst)^,Head.UncompressedSize)<>Head.UncompressedSize then
            exit;
        end;
      finally
        D.Free;
      end;
      result := FileSetDateFrom(Dest,S.Handle);
    finally
      S.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function FileIsSynLZ(const Name: TFileName; Magic: Cardinal): boolean;
var S: TFileStream;
    Head: TSynLZHead;
begin
  result := false;
  if FileExists(Name) then
  try
    S := TFileStream.Create(Name,fmOpenRead or fmShareDenyNone);
    try
      if S.Read(Head,SizeOf(Head))=SizeOf(Head) then
        if Head.Magic=Magic then
          result := true; // only check magic, since there may be several chunks
    finally
      S.Free;
    end;
  except
    on Exception do
      result := false;
  end;
end;

function StreamUnSynLZ(const Source: TFileName; Magic: cardinal): TMemoryStream;
var S: TStream;
begin
  try
    S := TSynMemoryStreamMapped.Create(Source);
    try
     result := StreamUnSynLZ(S,Magic);
    finally
      S.Free;
    end;
  except
    on E: Exception do
      result := nil;
  end;
end;

function StreamUnSynLZ(Source: TStream; Magic: cardinal): TMemoryStream;
var S,D: PAnsiChar;
    sourcePosition,resultSize,sourceSize: Int64;
    Head: TSynLZHead;
    Trailer: TSynLZTrailer;
    buf: RawByteString;
    stored: boolean;
begin
  result := nil;
  if Source=nil then
    exit;
  sourceSize := Source.Size;
  {$ifndef CPU64}
  if sourceSize>maxInt then
    exit; // result TMemoryStream should stay in memory!
  {$endif}
  sourcePosition := Source.Position;
  if sourceSize-sourcePosition<SizeOf(head) then
    exit;
  resultSize := 0;
  repeat
    if (Source.Read(Head,SizeOf(Head))<>SizeOf(Head)) or
       (Head.Magic<>Magic) then begin
      // Source not positioned as expected -> try from the end
      Source.Position := sourceSize-SizeOf(Trailer);
      if (Source.Read(Trailer,SizeOf(Trailer))<>SizeOf(Trailer)) or
         (Trailer.Magic<>Magic) then
        exit;
      sourcePosition := sourceSize-Trailer.HeaderRelativeOffset;
      Source.Position := sourcePosition;
      if (Source.Read(Head,SizeOf(Head))<>SizeOf(Head)) or
         (Head.Magic<>Magic) then
        exit;
    end;
    inc(sourcePosition,SizeOf(Head));
    if sourcePosition+Head.CompressedSize>sourceSize then
      exit;
    if Source.InheritsFrom(TCustomMemoryStream) then begin
      S := PAnsiChar(TCustomMemoryStream(Source).Memory)+PtrUInt(sourcePosition);
      Source.Seek(Head.CompressedSize,soFromCurrent);
    end else begin
      if Head.CompressedSize>length(Buf) then
        SetString(Buf,nil,Head.CompressedSize);
      S := pointer(Buf);
      Source.Read(S^,Head.CompressedSize);
    end;
    inc(sourcePosition,Head.CompressedSize);
    if (Source.Read(Trailer,SizeOf(Trailer))<>SizeOf(Trailer)) or
       (Trailer.Magic<>Magic) then
      // trailer not available in old .synlz layout, or in FileSynLZ multiblocks
      Source.Position := sourcePosition else
      sourceSize := 0; // should be monoblock
    // Source stream will now point after all data
    stored := (Head.CompressedSize=Head.UnCompressedSize) and
              (Head.HashCompressed=Head.HashUncompressed);
    if not stored then
      if SynLZdecompressdestlen(S)<>Head.UnCompressedSize then
        exit;
    if Hash32(pointer(S),Head.CompressedSize)<>Head.HashCompressed then
      exit;
    if result=nil then
      result := THeapMemoryStream.Create else begin
      {$ifndef CPU64}
      if resultSize+Head.UnCompressedSize>maxInt then begin
        FreeAndNil(result); // result TMemoryStream should stay in memory!
        break;
      end;
      {$endif CPU64}
    end;
    result.Size := resultSize+Head.UnCompressedSize;
    D := PAnsiChar(result.Memory)+resultSize;
    inc(resultSize,Head.UnCompressedSize);
    if stored then
      {$ifdef FPC}Move{$else}MoveFast{$endif}(S^,D^,Head.CompressedSize) else
    if SynLZDecompress1(S,Head.CompressedSize,D)<>Head.UnCompressedSize then
      FreeAndNil(result) else
    if Hash32(pointer(D),Head.UnCompressedSize)<>Head.HashUncompressed then
      FreeAndNil(result);
  until (result=nil) or (sourcePosition>=sourceSize);
end;


{ TAlgoCompress }

const
  COMPRESS_STORED = #0;
  COMPRESS_SYNLZ = 1;

var
  SynCompressAlgos: TObjectList;

constructor TAlgoCompress.Create;
var existing: TAlgoCompress;
begin
  inherited Create;
  if SynCompressAlgos=nil then
    GarbageCollectorFreeAndNil(SynCompressAlgos,TObjectList.Create(true)) else begin
      existing := Algo(AlgoID);
      if existing<>nil then
        raise ESynException.CreateUTF8('%.Create: AlgoID=% already registered by %',
          [self,AlgoID,existing.ClassType]);
    end;
  SynCompressAlgos.Add(self);
end;

class function TAlgoCompress.Algo(const Comp: RawByteString): TAlgoCompress;
begin
  result := Algo(Pointer(Comp),Length(Comp));
end;

class function TAlgoCompress.Algo(const Comp: TByteDynArray): TAlgoCompress;
begin
  result := Algo(Pointer(Comp),Length(Comp));
end;

class function TAlgoCompress.Algo(Comp: PAnsiChar; CompLen: integer): TAlgoCompress;
begin
  if (Comp<>nil) and (CompLen>9) then
    if ord(Comp[4])<=1 then // inline-friendly Comp[4]<=COMPRESS_SYNLZ
      result := AlgoSynLZ else // COMPRESS_STORED is also handled as SynLZ
      result := Algo(ord(Comp[4])) else
    result := nil;
end;

class function TAlgoCompress.Algo(Comp: PAnsiChar; CompLen: integer; out IsStored: boolean): TAlgoCompress;
begin
  if (Comp<>nil) and (CompLen>9) then begin
    IsStored := Comp[4]=COMPRESS_STORED;
    result := Algo(ord(Comp[4]));
  end else begin
    IsStored := false;
    result := nil;
  end;
end;

class function TAlgoCompress.Algo(AlgoID: byte): TAlgoCompress;
var i: integer;
    ptr: ^TAlgoCompress;
begin
  if AlgoID<=COMPRESS_SYNLZ then // COMPRESS_STORED is handled as SynLZ
    result := AlgoSynLZ else begin
    if SynCompressAlgos<>nil then begin
      ptr := @SynCompressAlgos.List[1]; // ignore List[0] = AlgoSynLZ
      for i := 2 to SynCompressAlgos.Count  do
        if ptr^.AlgoID=AlgoID then begin
          result := ptr^;
          exit;
        end
        else
          inc(ptr);
    end;
    result := nil;
  end;
end;

class function TAlgoCompress.UncompressedSize(const Comp: RawByteString): integer;
begin
  result := Algo(Comp).DecompressHeader(pointer(Comp),length(Comp));
end;

function TAlgoCompress.AlgoName: TShort16;
var s: PShortString;
    i: integer;
begin
  if self=nil then
    result := 'none' else begin
    s := ClassNameShort(self);
    if IdemPChar(@s^[1],'TALGO') then begin
      result[0] := AnsiChar(ord(s^[0])-5);
      inc(PtrUInt(s),5);
    end else
      result[0] := s^[0];
    if result[0]>#16 then
      result[0] := #16;
    for i := 1 to ord(result[0]) do
      result[i] := NormToLower[s^[i]];
  end;
end;

function TAlgoCompress.AlgoHash(Previous: cardinal; Data: pointer; DataLen: integer): cardinal;
begin
  result := crc32c(Previous,Data,DataLen);
end;

function TAlgoCompress.Compress(const Plain: RawByteString; CompressionSizeTrigger: integer;
  CheckMagicForCompressed: boolean; BufferOffset: integer): RawByteString;
begin
  result := Compress(pointer(Plain),Length(Plain),CompressionSizeTrigger,
    CheckMagicForCompressed,BufferOffset);
end;

function TAlgoCompress.Compress(Plain: PAnsiChar; PlainLen: integer; CompressionSizeTrigger: integer;
  CheckMagicForCompressed: boolean; BufferOffset: integer): RawByteString;
var len: integer;
    R: PAnsiChar;
    crc: cardinal;
    tmp: array[0..16383] of AnsiChar;  // big enough to resize Result in-place
begin
  if (self=nil) or (PlainLen=0) or (Plain=nil) then begin
    result := '';
    exit;
  end;
  crc := AlgoHash(0,Plain,PlainLen);
  if (PlainLen<CompressionSizeTrigger) or
     (CheckMagicForCompressed and IsContentCompressed(Plain,PlainLen)) then begin
    SetString(result,nil,PlainLen+BufferOffset+9);
    R := pointer(result);
    inc(R,BufferOffset);
    PCardinal(R)^ := crc;
    R[4] := COMPRESS_STORED;
    PCardinal(R+5)^ := crc;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Plain^,R[9],PlainLen);
  end else begin
    len := CompressDestLen(PlainLen)+BufferOffset;
    if len>SizeOf(tmp) then begin
      SetString(result,nil,len);
      R := pointer(result);
    end else
      R := @tmp;
    inc(R,BufferOffset);
    PCardinal(R)^ := crc;
    len := AlgoCompress(Plain,PlainLen,R+9);
    if len+64>=PlainLen then begin // store if compression was not worth it
      R[4] := COMPRESS_STORED;
      PCardinal(R+5)^ := crc;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Plain^,R[9],PlainLen);
      len := PlainLen;
    end else begin
      R[4] := AnsiChar(AlgoID);
      PCardinal(R+5)^ := AlgoHash(0,R+9,len);
    end;
    if R=@tmp[BufferOffset] then
      SetString(result,tmp,len+BufferOffset+9) else
      SetLength(result,len+BufferOffset+9); // MM may not move the data
  end;
end;

function TAlgoCompress.Compress(Plain, Comp: PAnsiChar; PlainLen, CompLen: integer;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): integer;
var len: integer;
begin
  result := 0;
  if (self=nil) or (PlainLen=0) or (CompLen<PlainLen+9) then
    exit;
  PCardinal(Comp)^ := AlgoHash(0,Plain,PlainLen);
  if (PlainLen>=CompressionSizeTrigger) and
     not(CheckMagicForCompressed and IsContentCompressed(Plain,PlainLen)) then begin
    len := CompressDestLen(PlainLen);
    if CompLen<len then
      exit;
    len := AlgoCompress(Plain,PlainLen,Comp+9);
    if len<PlainLen then begin
      Comp[4] := AnsiChar(AlgoID);
      PCardinal(Comp+5)^ := AlgoHash(0,Comp+9,len);
      result := len+9;
      exit;
    end;
  end;
  Comp[4] := COMPRESS_STORED;
  PCardinal(Comp+5)^ := PCardinal(Comp)^;
  {$ifdef FPC}Move{$else}MoveFast{$endif}(Plain^,Comp[9],PlainLen);
  result := PlainLen+9;
end;

function TAlgoCompress.CompressDestLen(PlainLen: integer): integer;
begin
  if self=nil then
    result := 0 else
    result := AlgoCompressDestLen(PLainLen)+9;
end;

function TAlgoCompress.CompressToBytes(Plain: PAnsiChar; PlainLen: integer;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): TByteDynArray;
var len: integer;
    R: PAnsiChar;
    crc: cardinal;
begin
  if (self=nil) or (PlainLen=0) then
    exit;
  crc := AlgoHash(0,Plain,PlainLen);
  if PlainLen<CompressionSizeTrigger then begin
    SetLength(result,PlainLen+9);
    R := pointer(result);
    PCardinal(R)^ := crc;
    R[4] := COMPRESS_STORED;
    PCardinal(R+5)^ := crc;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Plain^,R[9],PlainLen);
  end else begin
    SetLength(result,CompressDestLen(PlainLen));
    R := pointer(result);
    PCardinal(R)^ := crc;
    len := AlgoCompress(Plain,PlainLen,R+9);
    if len>=PlainLen then begin // store if compression not worth it
      R[4] := COMPRESS_STORED;
      PCardinal(R+5)^ := crc;
      {$ifdef FPC}Move{$else}MoveFast{$endif}(Plain^,R[9],PlainLen);
      len := PlainLen;
    end else begin
      R[4] := AnsiChar(AlgoID);
      PCardinal(R+5)^ := AlgoHash(0,R+9,len);
    end;
    SetLength(result,len+9);
  end;
end;

function TAlgoCompress.CompressToBytes(const Plain: RawByteString;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): TByteDynArray;
begin
  result := CompressToBytes(pointer(Plain),Length(Plain),
    CompressionSizeTrigger,CheckMagicForCompressed);
end;

function TAlgoCompress.Decompress(const Comp: TByteDynArray): RawByteString;
begin
  Decompress(pointer(Comp),length(Comp),result);
end;

procedure TAlgoCompress.Decompress(Comp: PAnsiChar; CompLen: integer;
  out Result: RawByteString; Load: TAlgoCompressLoad; BufferOffset: integer);
var len: integer;
    dec: PAnsiChar;
begin
  len := DecompressHeader(Comp,CompLen,Load);
  if len=0 then
    exit;
  SetString(result,nil,len+BufferOffset);
  dec := pointer(result);
  if not DecompressBody(Comp,dec+BufferOffset,CompLen,len,Load) then
    result := '';
end;

function TAlgoCompress.Decompress(const Comp: RawByteString;
  Load: TAlgoCompressLoad; BufferOffset: integer): RawByteString;
begin
  Decompress(pointer(Comp),length(Comp),result,Load,BufferOffset);
end;

function TAlgoCompress.TryDecompress(const Comp: RawByteString;
  out Dest: RawByteString; Load: TAlgoCompressLoad): boolean;
var len: integer;
begin
  result := Comp='';
  if result then
    exit;
  len := DecompressHeader(pointer(Comp),length(Comp),Load);
  if len=0 then
    exit; // invalid crc32c
  SetString(Dest,nil,len);
  if DecompressBody(pointer(Comp),pointer(Dest),length(Comp),len,Load) then
    result := true else
    Dest := '';
end;

function TAlgoCompress.Decompress(const Comp: RawByteString;
  out PlainLen: integer; var tmp: RawByteString; Load: TAlgoCompressLoad): pointer;
begin
  result := Decompress(pointer(Comp),length(Comp),PlainLen,tmp,Load);
end;

function TAlgoCompress.Decompress(Comp: PAnsiChar; CompLen: integer;
  out PlainLen: integer; var tmp: RawByteString; Load: TAlgoCompressLoad): pointer;
begin
  result := nil;
  PlainLen := DecompressHeader(Comp,CompLen,Load);
  if PlainLen=0 then
    exit;
  if Comp[4]=COMPRESS_STORED then
    result := Comp+9 else begin
    if PlainLen > length(tmp) then
      SetString(tmp,nil,PlainLen);
    if DecompressBody(Comp,pointer(tmp),CompLen,PlainLen,Load) then
      result := pointer(tmp);
  end;
end;

function TAlgoCompress.DecompressPartial(Comp, Partial: PAnsiChar;
  CompLen, PartialLen, PartialLenMax: integer): integer;
var BodyLen: integer;
begin
  result := 0;
  if (self=nil) or (CompLen<=9) or (Comp=nil) or (PartialLenMax<PartialLen) then
    exit;
  if Comp[4]=COMPRESS_STORED then
    if PCardinal(Comp)^=PCardinal(Comp+5)^ then
      BodyLen := CompLen-9 else
      exit
  else if Comp[4]=AnsiChar(AlgoID) then
    BodyLen := AlgoDecompressDestLen(Comp+9) else
    exit;
  if PartialLen>BodyLen then
    PartialLen := BodyLen;
  if Comp[4]=COMPRESS_STORED then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Comp[9],Partial[0],PartialLen) else
    if AlgoDecompressPartial(Comp+9,CompLen-9,Partial,PartialLen,PartialLenMax)<PartialLen then
      exit;
  result := PartialLen;
end;

function TAlgoCompress.DecompressHeader(Comp: PAnsiChar; CompLen: integer;
  Load: TAlgoCompressLoad): integer;
begin
  result := 0;
  if (self=nil) or (CompLen<=9) or (Comp=nil) or
     ((Load<>aclNoCrcFast) and (AlgoHash(0,Comp+9,CompLen-9)<>PCardinal(Comp+5)^)) then
    exit;
  if Comp[4]=COMPRESS_STORED then begin
    if PCardinal(Comp)^=PCardinal(Comp+5)^ then
      result := CompLen-9;
  end else
  if Comp[4]=AnsiChar(AlgoID) then
    result := AlgoDecompressDestLen(Comp+9);
end;

function TAlgoCompress.DecompressBody(Comp, Plain: PAnsiChar;
  CompLen, PlainLen: integer; Load: TAlgoCompressLoad): boolean;
begin
  result := false;
  if (self=nil) or (PlainLen<=0) then
    exit;
  if Comp[4]=COMPRESS_STORED then
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Comp[9],Plain[0],PlainLen) else
  if Comp[4]=AnsiChar(AlgoID) then
    case Load of
    aclNormal:
      if (AlgoDecompress(Comp+9,CompLen-9,Plain)<>PlainLen) or
         (AlgoHash(0,Plain,PlainLen)<>PCardinal(Comp)^) then
        exit;
    aclSafeSlow:
      if (AlgoDecompressPartial(Comp+9,CompLen-9,Plain,PlainLen,PlainLen)<>PlainLen) or
         (AlgoHash(0,Plain,PlainLen)<>PCardinal(Comp)^) then
        exit;
    aclNoCrcFast:
      if (AlgoDecompress(Comp+9,CompLen-9,Plain)<>PlainLen) then
        exit;
    end;
  result := true;
end;


{ TAlgoSynLZ }

function TAlgoSynLZ.AlgoID: byte;
begin
  result := COMPRESS_SYNLZ; // =1
end;

function TAlgoSynLZ.AlgoCompress(Plain: pointer; PlainLen: integer;
  Comp: pointer): integer;
begin
  result := SynLZcompress1(Plain,PlainLen,Comp);
end;

function TAlgoSynLZ.AlgoCompressDestLen(PlainLen: integer): integer;
begin
  result := SynLZcompressdestlen(PlainLen);
end;

function TAlgoSynLZ.AlgoDecompress(Comp: pointer; CompLen: integer;
  Plain: pointer): integer;
begin
  result := SynLZdecompress1(Comp,CompLen,Plain);
end;

function TAlgoSynLZ.AlgoDecompressDestLen(Comp: pointer): integer;
begin
  result := SynLZdecompressdestlen(Comp);
end;

function TAlgoSynLZ.AlgoDecompressPartial(Comp: pointer;
  CompLen: integer; Partial: pointer; PartialLen, PartialLenMax: integer): integer;
begin
  result := SynLZdecompress1partial(Comp,CompLen,Partial,PartialLen);
end;

// deprecated wrapper methods - use SynLZ global variable instead

function SynLZCompress(const Data: RawByteString; CompressionSizeTrigger: integer;
  CheckMagicForCompressed: boolean): RawByteString;
begin
  result := AlgoSynLZ.Compress(pointer(Data),length(Data),CompressionSizeTrigger,
    CheckMagicForCompressed);
end;

procedure SynLZCompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean);
begin
  result := AlgoSynLZ.Compress(P,PLen,CompressionSizeTrigger,CheckMagicForCompressed);
end;

function SynLZCompress(P, Dest: PAnsiChar; PLen, DestLen: integer;
  CompressionSizeTrigger: integer; CheckMagicForCompressed: boolean): integer;
begin
  result := AlgoSynLZ.Compress(P,Dest,PLen,DestLen,CompressionSizeTrigger,CheckMagicForCompressed);
end;

function SynLZDecompress(const Data: RawByteString): RawByteString;
begin
  AlgoSynLZ.Decompress(pointer(Data),Length(Data),result);
end;

function SynLZDecompressHeader(P: PAnsiChar; PLen: integer): integer;
begin
  result := AlgoSynLZ.DecompressHeader(P,PLen);
end;

function SynLZDecompressBody(P,Body: PAnsiChar; PLen,BodyLen: integer;
  SafeDecompression: boolean): boolean;
begin
  result := AlgoSynLZ.DecompressBody(P,Body,PLen,BodyLen,ALGO_SAFE[SafeDecompression]);
end;

function SynLZDecompressPartial(P,Partial: PAnsiChar; PLen,PartialLen: integer): integer;
begin
  result := AlgoSynLZ.DecompressPartial(P,Partial,PLen,PartialLen,PartialLen);
end;

procedure SynLZDecompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  SafeDecompression: boolean);
begin
  AlgoSynLZ.Decompress(P,PLen,Result);
end;

function SynLZDecompress(const Data: RawByteString; out Len: integer;
  var tmp: RawByteString): pointer;
begin
  result := AlgoSynLZ.Decompress(pointer(Data),length(Data),Len,tmp);
end;

function SynLZDecompress(P: PAnsiChar; PLen: integer; out Len: integer;
  var tmp: RawByteString): pointer;
begin
  result := AlgoSynLZ.Decompress(P,PLen,Len,tmp);
end;

function SynLZCompressToBytes(const Data: RawByteString;
  CompressionSizeTrigger: integer): TByteDynArray;
begin
  result := AlgoSynLZ.CompressToBytes(pointer(Data),length(Data),CompressionSizeTrigger);
end;

function SynLZCompressToBytes(P: PAnsiChar; PLen,CompressionSizeTrigger: integer): TByteDynArray;
begin
  result := AlgoSynLZ.CompressToBytes(P,PLen,CompressionSizeTrigger);
end;

function SynLZDecompress(const Data: TByteDynArray): RawByteString;
begin
  AlgoSynLZ.Decompress(pointer(Data),length(Data),result);
end;


{ TAlgoCompressWithNoDestLen }

function TAlgoCompressWithNoDestLen.AlgoCompress(Plain: pointer;
  PlainLen: integer; Comp: pointer): integer;
begin
  Comp := ToVarUInt32(PlainLen,Comp); // deflate don't store PlainLen
  result := RawProcess(Plain,Comp,PlainLen,AlgoCompressDestLen(PlainLen),0,doCompress);
  if result>0 then
    inc(result,ToVarUInt32Length(PlainLen));
end;

function TAlgoCompressWithNoDestLen.AlgoDecompress(Comp: pointer;
  CompLen: integer; Plain: pointer): integer;
var start: PAnsiChar;
begin
  start := Comp;
  result := FromVarUInt32(PByte(Comp));
  if RawProcess(Comp,Plain,CompLen+(Start-Comp),result,0,doUnCompress)<>result then
    result := 0;
end;

function TAlgoCompressWithNoDestLen.AlgoDecompressDestLen(Comp: pointer): integer;
begin
  if Comp=nil then
    result := 0 else
    result := FromVarUInt32(PByte(Comp));
end;

function TAlgoCompressWithNoDestLen.AlgoDecompressPartial(Comp: pointer;
  CompLen: integer; Partial: pointer; PartialLen, PartialLenMax: integer): integer;
var start: PAnsiChar;
begin
  start := Comp;
  result := FromVarUInt32(PByte(Comp));
  if PartialLenMax>result then
    PartialLenMax := result;
  result := RawProcess(Comp,Partial,CompLen+(Start-Comp),PartialLen,PartialLenMax,doUncompressPartial);
end;


{ ESynException }

constructor ESynException.CreateUTF8(const Format: RawUTF8; const Args: array of const);
var msg: string;
begin
  FormatString(Format,Args,msg);
  inherited Create(msg);
end;

constructor ESynException.CreateLastOSError(const Format: RawUTF8; const Args: array of const);
var tmp: RawUTF8;
    error: integer;
begin
  error := GetLastError;
  FormatUTF8(Format,Args,tmp);
  CreateUTF8('OSError % [%] %',[error,SysErrorMessage(error),tmp]);
end;

{$ifndef NOEXCEPTIONINTERCEPT}
function ESynException.CustomLog(WR: TTextWriter;
  const Context: TSynLogExceptionContext): boolean;
begin
  if Assigned(TSynLogExceptionToStrCustom) then
    result := TSynLogExceptionToStrCustom(WR,Context) else
  if Assigned(DefaultSynLogExceptionToStr) then
    result := DefaultSynLogExceptionToStr(WR,Context) else
    result := false;
end;
{$endif}


{ TMemoryMapText }

constructor TMemoryMapText.Create;
begin
end;

constructor TMemoryMapText.Create(aFileContent: PUTF8Char; aFileSize: integer);
begin
  Create;
  fMap.Map(aFileContent,aFileSize);
  LoadFromMap;
end;

constructor TMemoryMapText.Create(const aFileName: TFileName);
begin
  Create;
  fFileName := aFileName;
  if fMap.Map(aFileName) then
    LoadFromMap;
end; // invalid file or unable to memory map its content -> Count := 0

destructor TMemoryMapText.Destroy;
begin
  Freemem(fLines);
  fMap.UnMap;
  inherited;
end;

procedure TMemoryMapText.SaveToStream(Dest: TStream; const Header: RawUTF8);
var i: integer;
    W: TTextWriter;
    temp: TTextWriterStackBuffer;
begin
  i := length(Header);
  if i>0 then
    Dest.WriteBuffer(pointer(Header)^,i);
  if fMap.Size>0 then
    Dest.WriteBuffer(fMap.Buffer^,fMap.Size);
  if fAppendedLinesCount=0 then
    exit;
  W := TTextWriter.Create(Dest,@temp,SizeOf(temp));
  try
    if (fMap.Size>0) and (fMap.Buffer[fMap.Size-1]>=' ') then
      W.Add(#10);
    for i := 0 to fAppendedLinesCount-1 do begin
      W.AddString(fAppendedLines[i]);
      W.Add(#10);
    end;
    W.FlushFinal;
  finally
    W.Free;
  end;
end;

procedure TMemoryMapText.SaveToFile(FileName: TFileName; const Header: RawUTF8);
var FS: TFileStream;
begin
  FS := TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(FS,Header);
  finally
    FS.Free;
  end;
end;

function TMemoryMapText.GetLine(aIndex: integer): RawUTF8;
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) then
    result := '' else
    FastSetString(result,fLines[aIndex],GetLineSize(fLines[aIndex],fMapEnd));
end;

function TMemoryMapText.GetString(aIndex: integer): string;
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) then
    result := '' else
    UTF8DecodeToString(fLines[aIndex],GetLineSize(fLines[aIndex],fMapEnd),result);
end;

function GetLineContains(p,pEnd, up: PUTF8Char): boolean;
var i: PtrInt;
label Fnd;
begin
  if (p<>nil) and (up<>nil) then
  if pEnd=nil then
    repeat
      i := ord(p^);
      if not (AnsiChar(i) in ANSICHARNOT01310) then break;
      inc(p);
      if (NormToUpperAnsi7Byte[i]=ord(up^)) and IdemPChar(p,@up[1]) then begin
        result := true;
        exit;
      end;
    until false
  else
  repeat // fast unrolled search
    if p>=pEnd then break;
    i := ord(p^);
    if i in [10,13] then break;
    if NormToUpperAnsi7Byte[i]=ord(up^) then goto Fnd;
    inc(p);
    if p>=pEnd then break;
    i := ord(p^);
    if i in [10,13] then break;
    if NormToUpperAnsi7Byte[i]=ord(up^) then goto Fnd;
    inc(p);
    if p>=pEnd then break;
    i := ord(p^);
    if i in [10,13] then break;
    if NormToUpperAnsi7Byte[i]=ord(up^) then goto Fnd;
    inc(p);
    if p>=pEnd then break;
    i := ord(p^);
    if i in [10,13] then break;
    if NormToUpperAnsi7Byte[i]<>ord(up^) then begin
      inc(p);
      continue;
    end;
Fnd:i := 0;
    repeat
      inc(i);
      if up[i]=#0 then begin
        result := true; // found
        exit;
      end;
    until NormToUpperAnsi7[p[i]]<>up[i];
    inc(p);
  until false;
  result := false;
end;

function TMemoryMapText.LineContains(const aUpperSearch: RawUTF8;
  aIndex: Integer): Boolean;
begin
  if (self=nil) or (cardinal(aIndex)>=cardinal(fCount)) or (aUpperSearch='') then
    result := false else
    result := GetLineContains(fLines[aIndex],fMapEnd,pointer(aUpperSearch));
end;

function TMemoryMapText.LineSize(aIndex: integer): integer;
begin
  result := GetLineSize(fLines[aIndex],fMapEnd);
end;

function GetLineSizeSmallerThan(P,PEnd: PUTF8Char; aMinimalCount: integer): boolean;
begin
  if P<>nil then
    while (P<PEnd) and not(P^ in [#10,#13]) do
      if aMinimalCount=0 then begin
        result := false;
        exit;
      end else begin
        dec(aMinimalCount);
        inc(P);
      end;
  result := true;
end;

function TMemoryMapText.LineSizeSmallerThan(aIndex, aMinimalCount: integer): boolean;
begin
  result := GetLineSizeSmallerThan(fLines[aIndex],fMapEnd,aMinimalCount);
end;

procedure TMemoryMapText.ProcessOneLine(LineBeg, LineEnd: PUTF8Char);
begin
  if fCount=fLinesMax then begin
    fLinesMax := NextGrow(fLinesMax);
    ReallocMem(fLines,fLinesMax*SizeOf(pointer));
  end;
  fLines[fCount] := LineBeg;
  inc(fCount);
end;

procedure TMemoryMapText.LoadFromMap(AverageLineLength: integer=32);
  procedure ParseLines(P,PEnd: PUTF8Char);
  var PBeg: PUTF8Char;
  begin // generated asm is much better with a local proc
    while P<PEnd do begin
      PBeg := P;
      while (P<PEnd) and (P^<>#13) and (P^<>#10) do
        inc(P);
      ProcessOneLine(PBeg,P);
      if P+1>=PEnd then
        break;
      if P[0]=#13 then
        if P[1]=#10 then
          inc(P,2) else // ignore #13#10
          inc(P) else   // ignore #13
        inc(P);         // ignore #10
    end;
  end;
var P: PUTF8Char;
begin
  fLinesMax := fMap.fFileSize div AverageLineLength+8;
  GetMem(fLines,fLinesMax*SizeOf(pointer));
  P := pointer(fMap.Buffer);
  fMapEnd := P+fMap.Size;
  if TextFileKind(Map)=isUTF8 then
    inc(PByte(P),3); // ignore UTF-8 BOM
  ParseLines(P,fMapEnd);
  if fLinesMax>fCount+16384 then
    Reallocmem(fLines,fCount*SizeOf(pointer)); // size down only if worth it
end;

procedure TMemoryMapText.AddInMemoryLine(const aNewLine: RawUTF8);
var P: PUTF8Char;
begin
  if aNewLine='' then
    exit;
  AddRawUTF8(fAppendedLines,fAppendedLinesCount,aNewLine);
  P := pointer(fAppendedLines[fAppendedLinesCount-1]);
  ProcessOneLine(P,P+StrLen(P));
end;

procedure TMemoryMapText.AddInMemoryLinesClear;
begin
  dec(fCount,fAppendedLinesCount);
  fAppendedLinesCount := 0;
  fAppendedLines := nil;
end;


{ TRawByteStringStream }

constructor TRawByteStringStream.Create(const aString: RawByteString);
begin
  fDataString := aString;
end;

function TRawByteStringStream.Read(var Buffer; Count: Integer): Longint;
begin
  if Count<=0 then
    Result := 0 else begin
    Result := Length(fDataString)-fPosition;
    if Result>Count then
      Result := Count;
    {$ifdef FPC}Move{$else}MoveFast{$endif}(PByteArray(fDataString)[fPosition],Buffer,Result);
    inc(fPosition, Result);
  end;
end;

function TRawByteStringStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: fPosition := Offset;
    soFromCurrent:   fPosition := fPosition+Offset;
    soFromEnd:       fPosition := Length(fDataString)-Offset;
  end;
  if fPosition>Length(fDataString) then
    fPosition := Length(fDataString) else
    if fPosition<0 then
      fPosition := 0;
  result := fPosition;
end;

procedure TRawByteStringStream.SetSize(NewSize: Integer);
begin
  SetLength(fDataString, NewSize);
  if fPosition>NewSize then
    fPosition := NewSize;
end;

function TRawByteStringStream.Write(const Buffer; Count: Integer): Longint;
begin
  if Count<=0 then
    Result := 0 else begin
    Result := Count;
    SetLength(fDataString,fPosition+Result);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(Buffer,PByteArray(fDataString)[fPosition],Result);
    inc(FPosition,Result);
  end;
end;


{ TFakeWriterStream }

function TFakeWriterStream.Read(var Buffer; Count: Longint): Longint;
begin // do nothing
  result := Count;
end;

function TFakeWriterStream.Write(const Buffer; Count: Longint): Longint;
begin // do nothing
  result := Count;
end;

function TFakeWriterStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  result := Offset;
end;


{ TSynNameValue }

procedure TSynNameValue.Add(const aName, aValue: RawUTF8; aTag: PtrInt);
var added: boolean;
    i: Integer;
begin
  i := fDynArray.FindHashedForAdding(aName,added);
  with List[i] do begin
    if added then
      Name := aName;
    Value := aValue;
    Tag := aTag;
  end;
  if Assigned(fOnAdd) then
    fOnAdd(List[i],i);
end;

procedure TSynNameValue.InitFromIniSection(Section: PUTF8Char;
  OnTheFlyConvert: TConvertRawUTF8; OnAdd: TSynNameValueNotify);
var s: RawUTF8;
    i: integer;
begin
  Init(false);
  fOnAdd := OnAdd;
  while (Section<>nil) and (Section^<>'[') do begin
    s := GetNextLine(Section,Section);
    i := PosExChar('=',s);
    if (i>1) and not(s[1] in [';','[']) then
      if Assigned(OnTheFlyConvert) then
        Add(copy(s,1,i-1),OnTheFlyConvert(copy(s,i+1,1000))) else
        Add(copy(s,1,i-1),copy(s,i+1,1000));
  end;
end;

procedure TSynNameValue.InitFromCSV(CSV: PUTF8Char; NameValueSep,ItemSep: AnsiChar);
var n,v: RawUTF8;
begin
  Init(false);
  while CSV<>nil do begin
    GetNextItem(CSV,NameValueSep,n);
    if ItemSep=#10 then
      GetNextItemTrimedCRLF(CSV,v) else
      GetNextItem(CSV,ItemSep,v);
    if n='' then
      break;
    Add(n,v);
  end;
end;

procedure TSynNameValue.InitFromNamesValues(const Names, Values: array of RawUTF8);
var i: integer;
begin
  Init(false);
  if high(Names)<>high(Values) then
    exit;
  fDynArray.SetCapacity(length(Names));
  for i := 0 to high(Names) do
    Add(Names[i],Values[i]);
end;

function TSynNameValue.InitFromJSON(JSON: PUTF8Char; aCaseSensitive: boolean): boolean;
var N,V: PUTF8Char;
    nam,val: RawUTF8;
    Nlen, Vlen, c: integer;
    EndOfObject: AnsiChar;
begin
  result := false;
  Init(aCaseSensitive);
  if JSON=nil then
    exit;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  if JSON^<>'{' then
    exit;
  repeat inc(JSON) until not(JSON^ in [#1..' ']);
  c := JSONObjectPropCount(JSON);
  if c<=0 then
    exit;
  fDynArray.SetCapacity(c);
  repeat
    N := GetJSONPropName(JSON,@Nlen);
    if N=nil then
      exit;
    V := GetJSONFieldOrObjectOrArray(JSON,nil,@EndOfObject,true,true,@Vlen);
    if V=nil then
      exit;
    FastSetString(nam,N,Nlen);
    FastSetString(val,V,Vlen);
    Add(nam,val);
  until EndOfObject='}';
  result := true;
end;

procedure TSynNameValue.Init(aCaseSensitive: boolean);
begin
  // release dynamic arrays memory before FillcharFast()
  List := nil;
  fDynArray.HashInvalidate;
  // initialize hashed storage
  {$ifdef FPC}FillChar{$else}FillCharFast{$endif}(self,SizeOf(self),0);
  fDynArray.InitSpecific(TypeInfo(TSynNameValueItemDynArray),List,
    djRawUTF8,@Count,not aCaseSensitive);
end;

function TSynNameValue.Find(const aName: RawUTF8): integer;
begin
  result := fDynArray.FindHashed(aName);
end;

function TSynNameValue.FindStart(const aUpperName: RawUTF8): integer;
begin
  for result := 0 to Count-1 do
    if IdemPChar(pointer(List[result].Name),pointer(aUpperName)) then
      exit;
  result := -1;
end;

function TSynNameValue.FindByValue(const aValue: RawUTF8): integer;
begin
  for result := 0 to Count-1 do
    if List[result].Value=aValue then
      exit;
  result := -1;
end;

function TSynNameValue.Delete(const aName: RawUTF8): boolean;
var ndx: integer;
begin
  ndx := fDynArray.FindHashed(aName);
  if ndx>=0 then begin
    fDynArray.Delete(ndx);
    fDynArray.ReHash;
    result := true;
  end else
    result := false;
end;

function TSynNameValue.DeleteByValue(const aValue: RawUTF8; Limit: integer): integer;
var ndx: integer;
begin
  result := 0;
  if Limit<1 then
    exit;
  for ndx := Count-1 downto 0 do
    if List[ndx].Value=aValue then begin
      fDynArray.Delete(ndx);
      inc(result);
      if result>=Limit then
        break;
    end;
  if result>0 then
    fDynArray.ReHash;
end;

function TSynNameValue.Value(const aName: RawUTF8; const aDefaultValue: RawUTF8): RawUTF8;
var i: integer;
begin
  if @self=nil then
    i := -1 else
    i := fDynArray.FindHashed(aName);
  if i<0 then
    result := aDefaultValue else
    result := List[i].Value;
end;

function TSynNameValue.ValueInt(const aName: RawUTF8; const aDefaultValue: Int64): Int64;
var i,err: integer;
begin
  i := fDynArray.FindHashed(aName);
  if i<0 then
    result := aDefaultValue else begin
    result := GetInt64(pointer(List[i].Value),err);
    if err<>0 then
      result := aDefaultValue;
  end;
end;

function TSynNameValue.ValueBool(const aName: RawUTF8): Boolean;
begin
  result := Value(aName)='1';
end;

function TSynNameValue.ValueEnum(const aName: RawUTF8; aEnumTypeInfo: pointer;
  out aEnum; aEnumDefault: byte): boolean;
var v: RawUTF8;
    err,i: integer;
begin
  result := false;
  byte(aEnum) := aEnumDefault;
  v := trim(Value(aName,''));
  if v='' then
    exit;
  i := GetInteger(pointer(v),err);
  if (err<>0) or (i<0) then
    i := GetEnumNameValue(aEnumTypeInfo,v,true);
  if i>=0 then begin
    byte(aEnum) := i;
    result := true;
  end;
end;

function TSynNameValue.Initialized: boolean;
begin
  result := fDynArray.Value=@List;
end;

function TSynNameValue.GetBlobData: RawByteString;
begin
  result := fDynArray.SaveTo;
end;

procedure TSynNameValue.SetBlobDataPtr(aValue: pointer);
begin
  fDynArray.LoadFrom(aValue);
  fDynArray.ReHash;
end;

procedure TSynNameValue.SetBlobData(const aValue: RawByteString);
begin
  SetBlobDataPtr(pointer(aValue));
end;

function TSynNameValue.GetStr(const aName: RawUTF8): RawUTF8;
begin
  result := Value(aName,'');
end;

function TSynNameValue.GetInt(const aName: RawUTF8): Int64;
begin
  result := ValueInt(aName,0);
end;

function TSynNameValue.GetBool(const aName: RawUTF8): Boolean;
begin
  result := Value(aName)='1';
end;

function TSynNameValue.AsCSV(const KeySeparator,ValueSeparator,IgnoreKey: RawUTF8): RawUTF8;
var i: integer;
    temp: TTextWriterStackBuffer;
begin
  with TTextWriter.CreateOwnedStream(temp) do
  try
    for i := 0 to Count-1 do
    if (IgnoreKey='') or (List[i].Name<>IgnoreKey) then begin
      AddNoJSONEscapeUTF8(List[i].Name);
      AddNoJSONEscapeUTF8(KeySeparator);
      AddNoJSONEscapeUTF8(List[i].Value);
      AddNoJSONEscapeUTF8(ValueSeparator);
    end;
    SetText(result);
  finally
    Free;
  end;
end;

function TSynNameValue.AsJSON: RawUTF8;
var i: integer;
    temp: TTextWriterStackBuffer;
begin
  with TTextWriter.CreateOwnedStream(temp) do
  try
    Add('{');
    for i := 0 to Count-1 do
    with List[i] do begin
      AddFieldName(pointer(Name),length(Name));
      Add('"');
      AddJSONEscape(pointer(Value),length(Value));
      Add('"',',');
    end;
    CancelLastComma;
    Add('}');
    SetText(result);
  finally
    Free;
  end;
end;

procedure TSynNameValue.AsNameValues(out Names,Values: TRawUTF8DynArray);
var i: integer;
begin
  SetLength(Names,Count);
  SetLength(Values,Count);
  for i := 0 to Count-1 do begin
    Names[i] := List[i].Name;
    Values[i] := List[i].Value;
  end;
end;

{$ifndef NOVARIANTS}
function TSynNameValue.ValueVariantOrNull(const aName: RawUTF8): variant;
var i: integer;
begin
  i := Find(aName);
  if i<0 then
    SetVariantNull(result) else
    RawUTF8ToVariant(List[i].Value,result);
end;

procedure TSynNameValue.AsDocVariant(out DocVariant: variant;
  ExtendedJson,ValueAsString,AllowVarDouble: boolean);
var ndx: integer;
begin
  if Count>0 then
  with TDocVariantData(DocVariant) do begin
    Init(JSON_OPTIONS_NAMEVALUE[ExtendedJson],dvObject);
    VCount := self.Count;
    SetLength(VName,VCount);
    SetLength(VValue,VCount);
    for ndx := 0 to VCount-1 do begin
      VName[ndx] := List[ndx].Name;
      if ValueAsString or not GetNumericVariantFromJSON(pointer(List[ndx].Value),
          TVarData(VValue[ndx]),AllowVarDouble) then
        RawUTF8ToVariant(List[ndx].Value,VValue[ndx]);
    end;
  end else
    TVarData(DocVariant).VType := varNull;
end;

function TSynNameValue.AsDocVariant(ExtendedJson,ValueAsString: boolean): variant;
begin
  AsDocVariant(result,ExtendedJson,ValueAsString);
end;

function TSynNameValue.MergeDocVariant(var DocVariant: variant;
  ValueAsString: boolean; ChangedProps: PVariant; ExtendedJson,AllowVarDouble: Boolean): integer;
var DV: TDocVariantData absolute DocVariant;
    i,ndx: integer;
    v: variant;
    intvalues: TRawUTF8Interning;
begin
  if DV.VType<>DocVariantVType then
    TDocVariant.New(DocVariant,JSON_OPTIONS_NAMEVALUE[ExtendedJson]);
  if ChangedProps<>nil then
    TDocVariant.New(ChangedProps^,DV.Options);
  if dvoInternValues in DV.Options then
    intvalues := DocVariantType.InternValues else
    intvalues := nil;
  result := 0; // returns number of changed values
  for i := 0 to Count-1 do
  if List[i].Name<>'' then begin
    VarClear(v);
    if ValueAsString or not GetNumericVariantFromJSON(pointer(List[i].Value),
        TVarData(v),AllowVarDouble) then
      RawUTF8ToVariant(List[i].Value,v);
    ndx := DV.GetValueIndex(List[i].Name);
    if ndx<0 then
      ndx := DV.InternalAdd(List[i].Name) else
      if SortDynArrayVariantComp(TVarData(v),TVarData(DV.Values[ndx]),false)=0 then
        continue; // value not changed -> skip
    if ChangedProps<>nil then
      PDocVariantData(ChangedProps)^.AddValue(List[i].Name,v);
    SetVariantByValue(v,DV.VValue[ndx]);
    if intvalues<>nil then
      intvalues.UniqueVariant(DV.VValue[ndx]);
    inc(result);
  end;
end;
{$endif NOVARIANTS}


{$ifdef MSWINDOWS}
function IsDebuggerPresent: BOOL; stdcall; external kernel32; // since XP
{$endif}

procedure SetCurrentThreadName(const Format: RawUTF8; const Args: array of const);
begin
  SetThreadName(GetCurrentThreadId,Format,Args);
end;

procedure SetThreadName(ThreadID: TThreadID; const Format: RawUTF8;
  const Args: array of const);
var name: RawUTF8;
begin
  FormatUTF8(Format,Args,name);
  SetThreadNameInternal(ThreadID,name);
end;

procedure SetThreadNameDefault(ThreadID: TThreadID; const Name: RawUTF8);
{$ifdef FPC}
begin
  {$ifdef LINUX}
  if ThreadID<>MainThreadID then // don't change the main process name
    SetUnixThreadName(ThreadID, Name); // call pthread_setname_np()
  {$endif}
{$else}
{$ifndef NOSETTHREADNAME}
var s: RawByteString;
    {$ifndef ISDELPHIXE2}
    {$ifdef MSWINDOWS}
    info: record
      FType: LongWord;     // must be 0x1000
      FName: PAnsiChar;    // pointer to name (in user address space)
      FThreadID: LongWord; // thread ID (-1 indicates caller thread)
      FFlags: LongWord;    // reserved for future use, must be zero
    end;
    {$endif}
    {$endif}
begin
  {$ifdef MSWINDOWS}
  if not IsDebuggerPresent then
    exit;
  {$endif MSWINDOWS}
  s := CurrentAnsiConvert.UTF8ToAnsi(Name);
  {$ifdef ISDELPHIXE2}
  TThread.NameThreadForDebugging(s,ThreadID);
  {$else}
  {$ifdef MSWINDOWS}
  info.FType := $1000;
  info.FName := pointer(s);
  info.FThreadID := ThreadID;
  info.FFlags := 0;
  try
    RaiseException($406D1388,0,SizeOf(info) div SizeOf(LongWord),@info);
  except {ignore} end;
  {$endif MSWINDOWS}
  {$endif ISDELPHIXE2}
{$else}
begin
{$endif NOSETTHREADNAME}
{$endif FPC}
end;


{ MultiEvent* functions }

function MultiEventFind(const EventList; const Event: TMethod): integer;
var Events: TMethodDynArray absolute EventList;
begin
  if Event.Code<>nil then // callback assigned
    for result := 0 to length(Events)-1 do
      if (Events[result].Code=Event.Code) and
         (Events[result].Data=Event.Data) then
        exit;
  result := -1;
end;

function MultiEventAdd(var EventList; const Event: TMethod): boolean;
var Events: TMethodDynArray absolute EventList;
    n: integer;
begin
  result := false;
  n := MultiEventFind(EventList,Event);
  if n>=0 then
    exit; // already registered
  result := true;
  n := length(Events);
  SetLength(Events,n+1);
  Events[n] := Event;
end;

procedure MultiEventRemove(var EventList; const Event: TMethod);
begin
  MultiEventRemove(EventList,MultiEventFind(EventList,Event));
end;

procedure MultiEventRemove(var EventList; Index: Integer);
var Events: TMethodDynArray absolute EventList;
    max: integer;
begin
  max := length(Events);
  if cardinal(index)<cardinal(max) then begin
    dec(max);
    {$ifdef FPC}Move{$else}MoveFast{$endif}(
      Events[index+1],Events[index],(max-index)*SizeOf(Events[index]));
    SetLength(Events,max);
  end;
end;

procedure MultiEventMerge(var DestList; const ToBeAddedList);
var Dest: TMethodDynArray absolute DestList;
    New: TMethodDynArray absolute ToBeAddedList;
    d,n: integer;
begin
  d := length(Dest);
  n := length(New);
  if n=0 then
    exit;
  SetLength(Dest,d+n);
  {$ifdef FPC}Move{$else}MoveFast{$endif}(New[0],Dest[d],n*SizeOf(TMethod));
end;

function EventEquals(const eventA,eventB): boolean;
var A: TMethod absolute eventA;
    B: TMethod absolute eventB;
begin
  result := (A.Code=B.Code) and (A.Data=B.Data);
end;

var
  GarbageCollectorFreeAndNilList: TList;

procedure GarbageCollectorFree;
var i: integer;
begin
  if GarbageCollectorFreeing then
    exit; // when already called before finalization
  GarbageCollectorFreeing := true;
  for i := GarbageCollector.Count-1 downto 0 do // last in, first out
  try
    GarbageCollector.Delete(i); // will call GarbageCollector[i].Free
  except
    on Exception do
      ; // just ignore exceptions in client code destructors
  end;
  for i := GarbageCollectorFreeAndNilList.Count-1 downto 0 do // LIFO
  try
    if PObject(GarbageCollectorFreeAndNilList.List[i])^<>nil then
      FreeAndNil(PObject(GarbageCollectorFreeAndNilList.List[i])^);
  except
    on E: Exception do
      ; // just ignore exceptions in client code destructors
  end;
  FreeAndNil(GarbageCollectorFreeAndNilList);
end;

procedure GarbageCollectorFreeAndNil(var InstanceVariable; Instance: TObject);
begin
  TObject(InstanceVariable) := Instance;
  GarbageCollectorFreeAndNilList.Add(@InstanceVariable);
end;

var
  GlobalCriticalSection: TRTLCriticalSection;

procedure GlobalLock;
begin
  EnterCriticalSection(GlobalCriticalSection);
end;

procedure GlobalUnLock;
begin
  LeaveCriticalSection(GlobalCriticalSection);
end;

{$ifdef CPUINTEL}
procedure TestIntelCpuFeatures;
var regs: TRegisters;
begin
  regs.edx := 0;
  regs.ecx := 0;
  GetCPUID(1,regs);
  PIntegerArray(@CpuFeatures)^[0] := regs.edx;
  PIntegerArray(@CpuFeatures)^[1] := regs.ecx;
  GetCPUID(7,regs);
  PIntegerArray(@CpuFeatures)^[2] := regs.ebx;
  PIntegerArray(@CpuFeatures)^[3] := regs.ecx;
  PByte(@PIntegerArray(@CpuFeatures)^[4])^ := regs.edx;
  {$ifdef DISABLE_SSE42}
  // may be needed on Darwin x64 (as reported by alf)
  Exclude(CpuFeatures, cfSSE42);
  Exclude(CpuFeatures, cfAESNI);
  {$endif}
end;
{$endif CPUINTEL}

procedure InitSynCommonsConversionTables;
var i,n: integer;
    v: byte;
    crc: cardinal;
    tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
{$ifdef OWNNORMTOUPPER}
    d: integer;
const n2u: array[138..255] of byte =
  (83,139,140,141,90,143,144,145,146,147,148,149,150,151,152,153,83,155,140,
   157,90,89,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
   176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,65,65,65,
   65,65,65,198,67,69,69,69,69,73,73,73,73,68,78,79,79,79,79,79,215,79,85,85,
   85,85,89,222,223,65,65,65,65,65,65,198,67,69,69,69,69,73,73,73,73,68,78,79,
   79,79,79,79,247,79,85,85,85,85,89,222,89);
{$endif OWNNORMTOUPPER}
const HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';
      HexCharsLower: array[0..15] of AnsiChar = '0123456789abcdef';
begin
  JSON_CONTENT_TYPE_VAR := JSON_CONTENT_TYPE;
  JSON_CONTENT_TYPE_HEADER_VAR := JSON_CONTENT_TYPE_HEADER;
  NULL_STR_VAR := 'null';
  {$ifdef FPC}
  {$ifdef ISFPC27}
  {$ifndef MSWINDOWS}
  GetACP := GetSystemCodePage;
  {$endif MSWINDOWS}
  SetMultiByteConversionCodePage(CP_UTF8);
  SetMultiByteRTLFileSystemCodePage(CP_UTF8);
  {$endif ISFPC27}
  {$endif FPC}
  {$ifdef KYLIX3}
  // if default locale is set to *.UTF-8, which is the case in most modern
  // linux default configuration, unicode decode will fail in SysUtils.CheckLocale
  setlocale(LC_CTYPE,'en_US'); // force locale for a UTF-8 server
  {$endif}
{$ifndef EXTENDEDTOSTRING_USESTR}
  {$ifdef ISDELPHIXE}
  SettingsUS := TFormatSettings.Create($0409);
  {$else}
  GetLocaleFormatSettings($0409,SettingsUS);
  {$endif}
  SettingsUS.DecimalSeparator := '.'; // value may have been overriden :(
{$endif}
  for i := 0 to 255 do
    NormToNormByte[i] := i;
  NormToUpperAnsi7Byte := NormToNormByte;
  for i := ord('a') to ord('z') do
    dec(NormToUpperAnsi7Byte[i],32);
  {$ifdef OWNNORMTOUPPER}
  // initialize custom NormToUpper[] and NormToLower[] arrays
  MoveFast(NormToUpperAnsi7,NormToUpper,138);
  MoveFast(n2u,NormToUpperByte[138],SizeOf(n2u));
  for i := 0 to 255 do begin
    d := NormToUpperByte[i];
    if d in [ord('A')..ord('Z')] then
      inc(d,32);
    NormToLowerByte[i] := d;
  end;
  {$endif OWNNORMTOUPPER}
  // code below is 55 bytes long, therefore shorter than a const array
  FillcharFast(ConvertHexToBin[0],SizeOf(ConvertHexToBin),255); // all to 255
  v := 0;
  for i := ord('0') to ord('9') do begin
    ConvertHexToBin[i] := v;
    inc(v);
  end;
  for i := ord('A') to ord('F') do begin
    ConvertHexToBin[i] := v;
    ConvertHexToBin[i+(ord('a')-ord('A'))] := v;
    inc(v);
  end;
  for i := 0 to 255 do begin
    TwoDigitsHex[i][1] := HexChars[i shr 4];
    TwoDigitsHex[i][2] := HexChars[i and $f];
  end;
  for i := 0 to 255 do begin
    TwoDigitsHexLower[i][1] := HexCharsLower[i shr 4];
    TwoDigitsHexLower[i][2] := HexCharsLower[i and $f];
  end;
  FillcharFast(ConvertBase64ToBin,256,255); // invalid value set to -1
  for i := 0 to high(b64enc) do
    ConvertBase64ToBin[b64enc[i]] := i;
  ConvertBase64ToBin['='] := -2; // special value for '='
  for i := 0 to high(b64urienc) do
    ConvertBase64uriToBin[b64urienc[i]] := i;
  for i := high(Baudot2Char) downto 0 do
    if Baudot2Char[i]<#128 then
      Char2Baudot[Baudot2Char[i]] := i;
  for i := ord('a') to ord('z') do
    Char2Baudot[AnsiChar(i-32)] := Char2Baudot[AnsiChar(i)]; // A-Z -> a-z
  for i := 0 to 127 do
    if i in JSON_ESCAPE then
      JSON_ESCAPE_BYTE[i] := true;
  // initialize our internaly used TSynAnsiConvert engines
  TSynAnsiConvert.Engine(0);
  // initialize tables for crc32cfast() and SymmetricEncrypt/FillRandom
  for i := 0 to 255 do begin
    crc := i;
    for n := 1 to 8 do
      if (crc and 1)<>0 then // polynom is not the same as with zlib's crc32()
        crc := (crc shr 1) xor $82f63b78 else
        crc := crc shr 1;
    crc32ctab[0,i] := crc;
  end;
  for i := 0 to 255 do begin
    crc := crc32ctab[0,i];
    for n := 1 to high(crc32ctab) do begin
      crc := (crc shr 8) xor crc32ctab[0,ToByte(crc)];
      crc32ctab[n,i] := crc;
    end;
  end;
  for i := 0 to high(SmallUInt32UTF8) do begin
    P := StrUInt32(@tmp[15],i);
    FastSetString(SmallUInt32UTF8[i],P,@tmp[15]-P);
  end;
  UpperCopy255Buf := @UpperCopy255BufPas;
  DefaultHasher := @xxHash32; // faster than crc32cfast for small content
  {$ifndef ABSOLUTEPASCAL}
  {$ifdef CPUINTEL}
  {$ifdef FPC} // done in InitRedirectCode for Delphi
  {$ifdef CPUX86}
  if cfSSE2 in CpuFeatures then
  {$endif}
    StrLen := @StrLenSSE2;
  {$endif FPC}
  if cfSSE42 in CpuFeatures then begin
    crc32c := @crc32csse42; // seems safe on all targets
    crc32cby4 := @crc32cby4sse42;
    crcblock := @crcblockSSE42;
    {$ifdef FORCE_STRSSE42} // disabled by default: may trigger random GPF
    strspn := @strspnSSE42;
    strcspn := @strcspnSSE42;
    {$ifdef CPU64}
    {$ifdef FPC} // done in InitRedirectCode for Delphi
    {$ifdef HASAESNI}
    StrLen := @StrLenSSE42;
    StrComp := @StrCompSSE42;
    {$endif HASAESNI}
    {$endif FPC}
    {$endif CPU64}
    {$ifndef PUREPASCAL}
    {$ifndef DELPHI5OROLDER}
    UpperCopy255Buf := @UpperCopy255BufSSE42;
    {$endif DELPHI5OROLDER}
    {$endif PUREPASCAL}
    {$ifndef PUREPASCAL}
    StrComp := @StrCompSSE42;
    DYNARRAY_SORTFIRSTFIELD[false,djRawUTF8] := @SortDynArrayAnsiStringSSE42;
    DYNARRAY_SORTFIRSTFIELD[false,djWinAnsi] := @SortDynArrayAnsiStringSSE42;
    {$ifndef UNICODE}
    DYNARRAY_SORTFIRSTFIELD[false,djString] := @SortDynArrayAnsiStringSSE42;
    {$endif}
    DYNARRAY_SORTFIRSTFIELDHASHONLY[true] := @SortDynArrayAnsiStringSSE42;
    {$endif PUREPASCAL}
    {$endif FORCE_STRSSE42}
    DefaultHasher := crc32c;
  end;
  {$endif CPUINTEL}
  {$endif ABSOLUTEPASCAL}
  InterningHasher := DefaultHasher;
  KINDTYPE_INFO[djRawUTF8] := TypeInfo(RawUTF8); // for TDynArray.LoadKnownType
  KINDTYPE_INFO[djWinAnsi] := TypeInfo(WinAnsiString);
  KINDTYPE_INFO[djString] := TypeInfo(String);
  KINDTYPE_INFO[djRawByteString] := TypeInfo(RawByteString);
  KINDTYPE_INFO[djWideString] := TypeInfo(WideString);
  KINDTYPE_INFO[djSynUnicode] := TypeInfo(SynUnicode);
  {$ifndef NOVARIANTS}KINDTYPE_INFO[djVariant] := TypeInfo(variant);{$endif}
  GarbageCollectorFreeAndNil(GlobalCustomJSONSerializerFromTextSimpleType,
    TSynDictionary.Create(TypeInfo(TRawUTF8DynArray),
      TypeInfo(TJSONSerializerFromTextSimpleDynArray),true));
  JSONSerializerFromTextSimpleTypeAdd(
    'TGUID',{$ifdef ISDELPHI2010}TypeInfo(TGUID){$else}nil{$endif},0,0);
end;

initialization
  // initialization of global variables
  GarbageCollectorFreeAndNilList := TList.Create;
  GarbageCollectorFreeAndNil(GarbageCollector,TObjectList.Create);
  InitializeCriticalSection(GlobalCriticalSection);
  {$ifndef MSWINDOWS} // should be set ASAP (RetrieveSystemInfo is too late)
  SystemInfo.dwPageSize := getpagesize; // use libc for this value
  if SystemInfo.dwPageSize = 0 then
    SystemInfo.dwPageSize := 4096;
  {$endif MSWINDOWS}
  {$ifdef CPUINTEL}
  TestIntelCpuFeatures;
  {$endif}
  {$ifdef PUREPASCAL}
  {$ifndef HASINLINE}
  PosEx := @PosExPas;
  {$endif}
  {$endif}
  crc32c := @crc32cfast; // now to circumvent Internal Error C11715 for Delphi 5
  crc32cBy4 := @crc32cBy4fast;
  MoveFast := @System.Move;
  {$ifdef FPC}
  FillCharFast := @System.FillChar; // FPC cross-platform RTL is optimized enough
  {$ifdef Linux}
  stdoutIsTTY := IsATTY(StdOutputHandle)=1;
  {$endif}
  {$else}
  {$ifdef CPUARM}
  FillCharFast := @System.FillChar;
  {$else}
  Pointer(@FillCharFast) := SystemFillCharAddress;
  {$ifndef USEPACKAGES}
  InitRedirectCode;
  {$endif USEPACKAGES}
  {$endif CPUARM}
  {$endif FPC}
  InitSynCommonsConversionTables;
  RetrieveSystemInfo;
  SetExecutableVersion(0,0,0,0);
  AlgoSynLZ := TAlgoSynLZ.Create;
  TTextWriter.RegisterCustomJSONSerializerFromText([
    TypeInfo(TFindFilesDynArray),
     'Name:string Attr:Integer Size:Int64 Timestamp:TDateTime']);
  // some type definition assertions
  {$ifndef NOVARIANTS}
  Assert(SizeOf(TDocVariantData)=SizeOf(TVarData));
  DocVariantType := TDocVariant(SynRegisterCustomVariantType(TDocVariant));
  DocVariantVType := DocVariantType.VarType;
  {$endif NOVARIANTS}
  {$ifndef FPC}{$warnings OFF}{$endif}
  Assert((MAX_SQLFIELDS>=64)and(MAX_SQLFIELDS<=256));
  {$ifndef FPC}{$warnings ON}{$endif}
  Assert(SizeOf(THash128Rec)=SizeOf(THash128));
  Assert(SizeOf(THash256Rec)=SizeOf(THash256));
  Assert(SizeOf(TBlock128)=SizeOf(THash128));
  assert(SizeOf(TSynSystemTime)=SizeOf(TSystemTime));
  assert(SizeOf(TSynSystemTime)=SizeOf(THash128));
  Assert(SizeOf(TOperatingSystemVersion)=SizeOf(integer));
  {$ifdef MSWINDOWS}
  {$ifndef CPU64}
  Assert(SizeOf(TFileTime)=SizeOf(Int64)); // see e.g. FileTimeToInt64
  {$endif}
  {$endif}

finalization
  GarbageCollectorFree;
  DeleteCriticalSection(GlobalCriticalSection);
  //writeln('TDynArrayHashedCollisionCount=',TDynArrayHashedCollisionCount); readln;
end.