/// 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) 2015 Arnaud Bouchez
      Synopse Informatique - http://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) 2015
  the Initial Developer. All Rights Reserved.

  Contributor(s):
   - Aleksandr (sha)
   - Alfred Glaenzer (alf)
   - BigStar
   - RalfS
   - Sanyin
   - Pavel (mpv)
   - Wloochacz

  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.7
  - first public release, corresponding to SQLite3 Framework 1.7

  Version 1.8
  - includes Unitary Testing class and functions
  - bug fixed in WinAnsiBufferToUtf8() and all WinAnsi to UTF-8 encoding
    functions (issue identified thanks to new _UTF8 testing function)
  - bug fixed in val() under Delphi 2009/2010 for some values (issue identified
    thanks to new NumericalConversion testing function)
  - bug fixed in AnsiICompW() - used in SynPdf unit
  - ambiguous SameText() function rewritten as SameTextU() with UTF-8 decoding
  - TTextWriter class moved from SQLite3Commons to SynCommons
  - new JSONEncode and JSONDecode functions to directly encode or decode any
    content to/from a valid UTF-8 JSON object content
  - enhanced URLEncode() and URLDecode() functions
  - new ExtendedToStr/ExtendedToString functions
  - new tests added (mostly relative to the new functions or classes)

  Version 1.9
  - now compiles under CrossKylix, and tested under Linux
  - new JSONEncodeArray procedures, to create JSON array content from
    supplied Delphi arrays (handle RawUTF8 text, double or integer arrays)
  - new AddCSV methods in TTextWriter handling Delphi arrays to be added
    as Comma-Separated-Values (handle RawUTF8 text, double or integer arrays)
  - new definition of PtrInt/PtrUInt, to match NativeInt/NativeUInt types,
    available since Delphi 2007 - some code rewrite in order to avoid any
    implicit conversion from/to integer/cardinal

  Version 1.9.2
  - new StringReplaceChars function

  Version 1.10
  - code modifications to compile with Delphi 6 compiler (Delphi 5 failed due
    to some obscure compiler bugs in SynCrypto.pas)

  Version 1.11
  - fix some obscure Delphi 2009 bug according to NativeUInt :(
  - source code modified to be 7 bit Ansi (so will work with all encodings)
  - a lot of code refactoring for our internal fork of ZeosLib
    (e.g. ISO 8601 date time extracted from SQLite3Commons, QuotedStr..)
  - new TRawUTF8List class, which is able to emulate a TStringList with our
    native UTF-8 string type (cross-compiler, from Delphi 6 up to XE)
  - new TRawUTF8Stream class, to typecast a RawUTF8 into a TStream
  - new IsWow64 and SystemInfo global variables

  Version 1.12
  - fixed issue "JSON floats decimal separator depends on language settings"
  - new UTF8ToWideChar() overloaded function, with MaxDestChars parameter
  - new FillIncreasing() procedure
  - now handle our 32/64-bit variable-length integer encoding, via new
    FromVarUInt32/64 and ToVarUInt32/64 functions
  - new TFileBufferReader and TFileBufferWriter objects, implementing very fast
    read/write access to huge files, with new 32/64-bit variable-length integer
    encoding and optimized storage of IDs or Offsets (used in TSynBigTable)
  - new function UnQuoteSQLString()
  - another review of Pos() calls in the code (now use our fast PosEx)
  - TSynMemoryStream now replaces TRawUTF8Stream class, with constructors using
    either an AnsiString, either a memory buffer
  - new TSynTable, TSynTableFieldProperties and TSynTableStatement classes
    to handle a generic database table storing field values using our SBF
    compact binary format (more compact than BSON, similar to Protocol Buffers)
  - new WinAnsiToUnicodeString and Ansi7ToString functions
  - new TTextWriter.AddBinToHex method
  - new CompareOperator() functions and associated TCompareOperator type
  - new IntToThousandString() function (used for TSynTests e.g.)
  - new CreateInternalWindow() for creating a Windows Message handler in any object

  Version 1.13
  - unit now compiles and works with Delphi 5 compiler
  - new low-level RTTI functions for handling record types: RecordEquals,
    RecordSave, RecordSaveLength, RecordLoad, RecordClear and RecordCopy
  - new TDynArray object, which is a wrapper around any dynamic array: you can
    now access to the dynamic array using TList-like properties and methods,
    e.g. Count, Add, Insert, Delete, Clear, IndexOf, Find, Sort and some
    new methods like LoadFromStream, SaveToStream, LoadFrom and SaveTo which
    allow fast binary serialization of any dynamic array, even containing
    strings or records; a CreateOrderedIndex method is also available to
    create individual index according to the dynamic array content; and any
    dynamic array can be serialized as UTF-8 JSON via TTextWriter.AddDynArrayJSON
    and TDynArray.LoadFromJSON methods
  - introducing direct content filtering and validation using
    TSynFilterOrValidate dedicated classes, for both TSQLRecord and SynBigTable
  - filtering is handled via some TSynFilter classes - TSynFilterUpperCase,
    TSynFilterUpperCaseU, TSynFilterLowerCase, TSynFilterLowerCaseU and
    TSynFilterTrim e.g.
  - validation is handled via some TSynValidate classes - TSynValidateRest,
    TSynValidateIPAddress, TSynValidateEmail, TSynValidatePattern,
    TSynValidatePatternI, TSynValidateText, TSynValidatePassWord e.g.
  - dedicated TSynTableFieldProperties.Validate method for validation (e.g. a
    TSynValidateTableUniqueField instance is created if tfoUnique is in Options)
  - dedicated TSynTableFieldProperties.Filter method for filtering (using
    common TSynFilter classes, working at UTF-8 Text content)
  - faster implementation of Move() for Delphi versions with no FastCode inside
  - new ConvertCaseUTF8(), UpperCaseU(), LowerCaseU(), Int64ToUInt32(),
    GetCardinalDef(), IsValidEmail, IsValidIP4Address(), PatchCodePtrUInt(),
    GetCaptionFromClass(), GetDisplayNameFromClass(), DateTimeToIso8601Text()
    StrUInt32(), StringBufferToUtf8(), IsZero(), AddPrefixToCSV(), IntToString(),
    RawUTF8DynArrayEquals(), FromVarString(), GetBitCSV(), SetBitCSV()
    procedures or functions (with associated tests)
  - new grep-like IsMatch() function for basic pattern matching
  - new BinToBase64, Base64ToBin and IsBase64 *fast* conversion functions
    (with optimized assembler version, using CPU pipelining and lookup table)
  - introducing the GarbageCollector TObjectList for handling a global garbage
    collector for instances which must live during the whole executable process
    (used e.g. to avoid a memory leak for "class var" or such variables)
  - new TSynLog class to handle enhanced logging to any application, with
    exception handling (+stack trace) and customer-side performance profiling
  - new TSynMapFile class to retrieve debugging information from .map file (and
    able to save and read smaller .mab files) - used by TSynLog if available
  - new TSynTestsLogged test suit class, with automated test case logging
  - Windows version detection enhanced, now retrieving TWindowsVersion enumerate
  - great performance improvement in TSynTableFieldProperties for update process
  - added TMemoryMap and TSynMemoryStreamMapped to handle memory-mapped files
  - added TMemoryMapText class to fast handle big UTF-8 text files (like logs)
  - now TTextWriter can have a custom internal buffer size (default 4096 bytes)
  - now TFileBufferWriter and TFileVersion are regular classes, not an
    object/record any more (this was incoherent since Delphi 2010)
  - new TFileBufferReader.OpenFrom(Stream) and ReadRawUTF8 methods
  - now TSynCache will use faster TDynArrayHashed for its content hashing
  - new Escape: TTextWriterKind optional parameter for TTextWriter.Add()
  - new SynLZ related compression functions: FileSynLZ/FileUnSynLZ and
    StreamSynLZ/StreamUnSynLZ
  - source can now be parsed per all Delphi IDE pre-parser (dual declaration as
    record or object because of Delphi 2010 and up was not understood)
  - fixed issue in TSynTable.Data() method: ID was not set as expected
  - fixed issue in TSynTableFieldProperties: wrong constraint evaluation and
    index refresh at records update
  - fixed issue in ToVarUInt32Length/ToVarUInt32LengthWithData

  Version 1.14
  - fix issues with Curr64ToStr() and Curr64ToPChar() with negative amounts,
    with some speed enhancements and new associated tests
  - fixed issue in produced JSON stream using '=' instead of ':'
  - new DoubleToStr(), StrCurr64(), UnicodeBufferToString(),
    RawUnicodeToString(), FillChar(), UpperCopy255W(), GetCaptionFromEnum(),
    SortDynArrayUnicodeString(), SortDynArrayUnicodeStringI() functions

  Version 1.15
  - unit now tested with Delphi XE2 (32 Bit)
  - TSynLog now writes the elapsed time (in us) for Enter/Leave events, and
    will flush the log content to disk on any exception (for safety)
  - new sllTrace and sllWarning levels for TSynLog class
  - new TSynLog.DefaultExtension property (set to '.log' by default)
  - new TSynLogFile.LogProc[] property for customer-side method profiling,
    with LogProcSort method available for sorting the resulting array, and
    LogProcMerged property to merge the location name timing
  - new TSynMapFile.FindLocation method for high-level .map symbol access
  - TSynMapFile now handles huge .map file (bigger default in-memory buffer)
  - fix potential GPF issue in code using ConvertHexToBin[]
  - new TSynLog.EventCount method
  - new TMemoryMapText.LineContains method for fast case-insensitive search
  - TSynTests now writes the elapsed time in each test in the final report
  - faster late binding process for our variants custom types (i.e.
    TSynTableVariantType and TSQLDBRowVariantType): you can call
    SynRegisterCustomVariantType() function to register any other custom
    variant type, and enhance GetProperty/SetProperty process speed
  - includes our optimized RecordCopy procedure in replacement to the slower
    default System.@CopyRecord internal RTL function
  - our optimized Move() and FillChar() will replace the default System RTL
    function, for Delphi versions prior to 2007 (which didn't contain those)
  - new AnsiCharToUTF8(), StringToWinAnsi(), WideStringToWinAnsi(),
    WideStringToUTF8(), CSVOfValue(), IdemPCharArray(), FindUnicode(),
    UpperCaseUnicode(), LowerCaseUnicode() and Split() functions
  - faster GetInt64() function
  - Iso8601ToSecondsPUTF8Char() now returns 0 in case of unexpected format
  - fixed issue in StrCurr64() low-level conversion routine
  - fixed issue in Utf8DecodeToRawUnicodeUI() function
  - new TSynTableFieldProperties.OrderedIndexRefresh method, to allow access
    on OrderedIndex[] even if the index needs to be refreshed
  - new TDynArrayHashed.AddAndMakeUniqueName() method and Hash[] property
  - new TRawByteStringStream class (a TStream using a RawByteString as internal
    storage), especially useful since Delphi 2009
  - new TSynNameValue object, to efficiently handle Name/Value RawUTF8 pairs
    (using hashing for Name search)
  - TTextWriter.CreateOwnedStream now create an internal TRawByteStringStream
    instance for faster process and direct retrieval in the Text method
  - JSONEncode*() global functions will use an internal TRawByteStringStream
    instead of a supplied TMemoryStream
  - new FormatUTF8() overloaded function, handling both '%' and '?' parameters
    (inserting '?' as inlined :(...): parameters, with proper string quote) -
    with associated regression tests

  Version 1.16
  - introducing new TSynAnsiConvert and TSynAnsiFixedWidth classes, able to
    process Unicode to/from Ansi conversion in all possible code pages, with
    generic access methods and optimized handling of fixed width encodings
  - added dedicated Exception classes (ESynException, ETableDataException)
  - TSynLog allows read sharing of the .log created file
  - TSynLog now stores the executable build time, and library name (if any) -
    this is a small change of the .log format as expected by the LogViewer tool
    (so you should upgrade your LogViewer.exe to its latest version)
  - TSynLog and TSynMapFile now handle libraries (.dll/.ocx/.bpl) .map/.mab
    debugging information (only .exe was previously handled)
  - TSynCache now handles an optional Tag: PtrInt value parameter (used e.g.
    to store the row counts of a SQL result cache in mORMot)
  - TSynCache now uses the generic TSynNameValue object from its internal
    hashed list implementation (avoid duplicated code)
  - TMemoryMapText class (and therefore TSynLogFile) is now able to map/open
    an existing file: it will allow e.g. the SynLogViewer to browse a .log file
    which is actually still opened and working by the main application
  - faster RawUnicodeToUtf8() and UTF8ToWideChar() functions, thanks to very
    clever speed-up proposals by Sha (also included in TSynAnsi* classes)
  - JSONDecode() overloaded functions now accept parameter names without case
    sensibility (and a new HandleValuesAsObjectOrArray parameter)
  - new JSONDecode() overloaded function, to properly handle unserialization
    of a JSON object within a buffer (used e.g. for TDynArrayJSONCustomReader)
  - JSON functions now handle '0' as number according to http://json.org specs
  - new TTextWriter.AddJSONEscape() overloaded function, to be used to directly
    serialize some name/value pairs as a JSON object content (used e.g. for
    TDynArrayJSONCustomWriter callbacks)
  - new FileSize(), RoundTo2Digits() and RawByteStringArrayConcat() functions
  - new TPrecisionTimer Pause and Resume methods
  - new TSynTestCase.CheckFailed method (most of the time, Check is sufficient)
  - new TSynLogFamily.IncludeComputerNameInFileName property
  - new TTextWriter.WrRecord method for direct adding of a Base-64 record content
  - new TTextWriter.AddNoJSONEscapeString method
  - new TRawUTF8ListHashed class, with extend TRawUTF8List by using an internal
    hash table to optimized IndexOf() method call (including case sensitivity)
  - new ToVarInt64() and FromVarInt64() functions to encode and decode
    variable-length signed Int64 values (with the corresponding new tftVarInt64
    kind of variable-length column in TSynTableFieldType enumeration)
  - new GotoNextJSONObjectOrArray() and RawUTF8ArrayToQuotedCSV() functions
  - new ReadStringFromStream() and WriteStringToStream() functions
  - fixed some compilation warnings with Delphi XE and XE2
  - fixed issue in TDynArrayHashed if you do not use the external Count
  - fixed potential GPF in TDynArrayHashed.ReHash after TDynArray.Clear call
  - fixed issue in TSynTableFieldProperties.SaveTo about saving wrong indexes
  - fixed issue TSynTableStatement when only one column was retrieved
  - fixed rounding issue in ExtendedToString() and all corresponding wrappers
    like DoubleToStr*, Add(Double...)
  - fixed issue in Hash32() implementation (potential GPF when reading ahead
    by DWORD - get rid of unnecessary asm optimization)
  - fixed issues in function IsJSONString() which returned TRUE for '-' or '+',
    or false positives in some border-line cases (due to wrong uppercase guess):
    now this function is split into IsString() and IsStringJSON() functions
    to explicitely handle null/false/true constant recognition
  - fixed potential false positives of null/false/true in function GetJSONField
  - get rid of wrong "Decimal" parameter in float to text conversion
  - TFileBufferWriter.Create now accepts up to 4 MB internal buffer size
  - increased TDynArrayHashed number of void entries (for speed)
  - modified TDynArray.SaveToStream/LoadFromStream to read or save the data
    from the current stream position
  - fixed GPF in TDynArray.SaveTo in case of invalid internal record layout
  - modified StreamUnSynLZ() so that Source stream will point after all read data
  - TDynArray.SaveToStream() method can now save to any TStream class
  - added TTextWriter.RegisterCustomJSONSerializer() method to allow JSON
    serialization of any dynamic array content (used by TDynArray.LoadFromJSON
    and TTextWriter.AddDynArrayJSON) and record content (used by RecordLoadJSON
    and TTextWriter.AddRecordJSON)
  - added USEPACKAGES conditional to help compiling the unit within packages
  - added optional DOPATCHTRTL to patch the RTL (e.g. RecordCopy, RecordClear
    TObject.CleanupInstance low-level functions) only if needed (not patched
    by default, for compatibility reasons) - you may want to use our Enhanced
    RTL patchs instead for a whole better response
  - new function BinToBase64URI()
  - circumvent some bugs of Delphi XE2 background compiler (main compiler is OK)
  - add premilinary Windows 8 operating system detection (as wEight/wEightServer)

  Version 1.17
  - check of QueryPerformanceFrequency failure, and rollback to low-resolution timer
  - handle properly old .synlz layout (reading compatibility was broken)
  - added TObjectListHashed class, which behaves like TList/TObjectList, but
    will use hashing for (much) faster IndexOf() method, and associated
    TObjectListPropertyHashed class, which allows hashing of a sub-property
    of an object (including some changes made to TDynArray/TDynArrayHashed)
  - new TTextWriter.AddDateTime() overloaded method able to quote the output
  - new TTextWriter.AddFloatStr() method handling partial floating-point text
  - both TTextWriter.AddDateTime() overloaded methods will store '' when value
    is 0, or a pure ISO-8601 date or time if the value is defined as such,
    just as expected by http://www.sqlite.org/lang_datefunc.html - it will also
    reduce average generated JSON/text content size
  - fixed issue about BLOB unproperly serialized into JSON (e.g. now uses null)
  - fixed ticket [e5ad3684b2] about some .map files parsing in TSynMapFile
  - TSynLog stack tracing uses low-level RtlCaptureStackBackTrace() API on CPU64  
  - changed the non expanded JSON format to use lowercase first column names:
    {"fieldCount":1,"values":["col1"... instead of {"FieldCount":1,"Values":[..
  - new SetInt64() procedure for direct assignment of the result
  - TSynTableStatement class now accepts '_' in table and column identifiers
  - fixed implementation issue in function FindNextUTF8WordBegin()
  - fixed false negative issue in TSynSoundEx.UTF8 and TSynSoundEx.Ansi
  - fixed wrong UTF-8 encoding of U+FFF0 used for JSON_BASE64_MAGIC
  - added an optional parameter to StrToCurr64() function, able to return
    a true Int64 value if no decimal is supplied within the input text buffer
  - enhanced TSynAnsiFixedWidth.UnicodeBufferToAnsi average process speed
  - TSynCache.Reset now returns a boolean stating if something was flushed
  - new SynUnicodeToUtf8(), ShortStringToUTF8(), StringToSynUnicode(),
    SynUnicodeToString() functions
  - new StrToCurrency() wrapper function
  - new IdemPropName() overloaded function with two PUTF8Char arguments
  - new UTF8UpperCopy() and UTF8UpperCopy255() optimized functions
  - new GotoNextNotSpace() and GotoEndOfQuotedString() functions
  - new TMemoryMap.Map() method expecting a file name as parameter
  - new TRawUTF8List.LoadFromFile method
  - new DateToSQL(), DateTimeToSQL() and Iso8601ToSQL() functions, returning
    a string with a JSON_SQLDATE_MAGIC prefix and proper UTF-8/ISO-8601 encoding
    to be inlined as ? bound parameter in any SQL query (allow binding of
    date/time parameters as request by some external database engine
    which does not accept ISO-8601 text in this case)
  - added TDynArray.Equals() method to compare two arrays efficiently
  - added TDynArray and TDynArrayHashed InitSpecific() method able to specify
    how (hashing and) comparison should be processed for a given record
    (includes also some TDynArray/TDynArrayHashed refactoring and optimization)
  - new TObjectHash abstract class to use hashing to find an object
  - TTextWriter.AddJSONEscape() method speed up
  - moved logging threadvars and associated structures into hidden internal
    declaration, for better work with packages (avoid W1032 warning)
  - now JSON parser will handle #1..' ' chars as whitespace (not only ' ')
  - now JSON parser will allow whitespace inserted between any pair of tokens,
    even after true/false/null, as expected by the specification
  - fixed potential Integer Overflow error in Iso8601ToDateTimePUTF8Char*()
  - added PatchCode() and RedirectCodeRestore() procedures, and some code
    refactoring about process in-memory code patching
  - internal FillChar() will now use faster SSE2 instructions on supported CPUs

  Version 1.18
  - BREAKING CHANGE: SynLog.pas and SynTests.pas were extracted from SynCommons
  - BREAKING CHANGE of TTextWriter.WriteObject() method: serialization is now
    defined with a new TTextWriterWriteObjectOptions set
  - BREAKING CHANGE rename of Iso8601 low-level structure as TTimeLogBits, to use
    explicitly the TTimeLog type and name for all Int64 bit-oriented functions -
    now "Iso8601" naming will be only for standard ISO-8601 text, not Int64 value
  - BREAKING CHANGE: TTextWriter.Add(Format) won't handle the alternate $ % tags
    any more, unless you define the OLDTEXTWRITERFORMAT conditional
  - BREAKING CHANGE: TTextWriter.AddDouble() and AddSingle() dedicated methods
    replacing ambiquituous Add(), which was not appropriate for single values
  - BREAKING CHANGE: FormatUTF8() and TTextWriter.Add(Format) PUTF8Char type for
    constant text parameter has been changed into RawUTF8, to let the compiler
    handle any Unicode content as expected
  - RawByteString is now defined as "= type AnsiString" under non Unicode Delphi
    so that it would be recognized with its own encoding (pseudo code page 65535)
  - Delphi XE4/XE5/XE6/XE7/XE8 compatibility (Win32/Win64 target platform only
    for the SynCommons and mORMot* units, but see SynCrossPlatform* units for
    clients on all other targets, including OSX and the NextGen compilers)
  - unit fixed and tested with Delphi XE2 (and up) 64-bit compiler under Windows
  - now all variants created within our units will create string instances of
    kind varString and type RawUTF8 - prior to Delphi 2009, ensure you call
    UTF8ToString(aVariant) if you want to use the value with the VCL
  - introducing TDocVariant for variant-based process of any hierarchy
    of objects and/or arrays, with late binding optimized access and JSON
    serialization/unserialization (will also be used for BSON documents storage)
  - UTF-8 process will now handle UTF-16 surrogates - see ticket [4a0382367d] -
    UnicodeCharToUTF8/NextUTF8Char are renamed WideCharToUTF8/NextUTF8UCS4 and
    new UTF16CharToUTF8/UCS4ToUTF8 functions have been introduced
  - added TextColor() and TextBackground() functions - will initialize internal
    console process after any manual AllocConsole call
  - added ConsoleWaitForEnterKey function, able to handle Synchronize() calls
  - StrLen() function will now use faster SSE2 instructions on supported CPUs
  - introduced StrLenPas() function, to be used when buffer is protected
  - included Windows-1258 code page to be recognized as a fixed-width charset
  - TSynAnsiFixedWidth.Create(CODEPAGE_US) will now use a hard-coded table, 
    since some Russian system do tweak the registry to force 1252 page maps 1251
  - introducing TSynAnsiUTF8/TSynAnsiUTF16 to handle CP_UTF8/CP_UTF16 codepages
  - added UTF8AnsiConvert instance, and let TSynAnsiConvert.Engine(0) return
    the main CurrentAnsiConvert instance
  - StrComp/StrIComp/StrLen() functions will now expect blank pointers, to
    circumvent type mismatchs when passing PAnsiChar or PUTF8Char buffers
  - get rid of 12 maximum count of supplied argument in FormatUTF8()
  - FormatUTF8() and VarRecToUTF8() will append the class name of any TObject
  - added JSONFormat optional parameter to FormatUTF8() to produce valid JSON
    content from a given set of values identified by ? - used e.g. by _JsonFmt()
  - added ESynException.CreateUTF8() constructor, more powerful than the
    default Exception.CreateFmt(): this CreateUTF8 method is now used everywhere
  - added QuotedStrJSON() and NextNotSpaceCharIs() functions
  - refactored GetMimeContentType() implementation - see also [fca72ba0ce]
  - added MultiPartFormDataDecode() to decode multipart/form-data POST requests 
  - included x64 asm of FillChar() and Move() for Win64 - Delphi RTL will be
    patched at startup, unless the NOX64PATCHRTL conditional is defined
  - FastCode-based x86 asm Move() procedure will handle source=dest
  - faster x86/x64 asm versions of StrUInt32() StrInt32() StrInt64() functions
  - new StrUInt64(), UniqueRawUTF8(), FastNewRawUTF8() and SetRawUTF8() functions
  - recognize 8.1 and upcoming "Threshold" 9 in TWindowsVersion
  - added TypeInfo, ElemSize, ElemType read-only properties to TDynArray
  - added DynArrayLoad() and DynArraySave() helper functions
  - introducing TObjectDynArrayWrapper class and IObjectDynArray interface
  - introducing T*ObjArray dynamic array storage via ObjArrayAdd/ObjArrayFind/
    ObjArrayDelete/ObjArraySort and ObjArrayClear functions
  - added TPersistentWithCustomCreate, TInterfacedObjectWithCustomCreate and
    TSynPersistent abstract classes, allowing to define virtual constructors for
    TPersistent kind of objects (used e.g. with internal JSON serialization,
    for interface-based services, or for DDD objects)
  - introducing TSynAuthentication class for simple generic authentication
  - introducing TSynConnectionDefinition class used e.g. for JSON-defined
    runtime instantiation of a TSQLDBConnectionProperties or TSQLRest instance
  - added TDynArrayHashed.HashElement property
  - new TDynArrayHashed.AddUniqueName() method
  - introduced TSingleDynArray, recognized as such in JSON serialization
  - fixed "single" floating-point values JSON serialization
  - added WordScanIndex() and swap32() functions
  - speed improvement of IdemPropNameU() function, with new overload function
  - now FileSize() function won't raise any exception if the file does not exist
    and will return any size > 2 GB as expected
  - faster PosEx() function in pure pascal mode (based on Avatar Zondertau work)
  - added StringDynArrayToRawUTF8DynArray() and StringListToRawUTF8DynArray()
  - added CSVToRawUTF8DynArray() overloaded functions
  - added GetLastCSVItem() function and dedicated HashPointer() function
  - added DirectoryDelete() and EnsureDirectoryExists() function
  - added GetNextItemInteger(), GetNextItemCardinalStrict() and UpperCaseCopy()
  - added GetEnumNameValue() function 
  - added JSONEncodeArrayOfConst() function
  - JSONEncode() and TTextWriter.AddJSONEscape() with NameValuePairs parameters
    will now handle nested arrays or objects specified with '['..']' or '{'..'}'
    and nil parameter as null JSON value
  - new TTextWriter.AddJSON() method and JSONEncode() overloaded function able
    to recognize (extended) JSON content, including MongoDB shell extensions
  - added IsHTMLContentTypeTextual() function, and modified ExistsIniNameValue()
  - added ShortStringToAnsi7String() and UpperCopyWin255() functions
  - added IsEqualGUID, GUIDToText, GUIDToRawUTF8 and GUIDToString functions
  - added TextToGUID, RawUTF8ToGUID and StringToGUID functions
  - added TDynArray.ElemPtr() low-level method
  - let TDynArray.LoadFrom() accept Win32/Win64 cross platform binary content
  - new TDynArray.CopyFrom() method and associated procedure DynArrayCopy()
  - TDynArray will now recognize TVariantDynArray or variant fields 
  - code refactoring of TTextWriter to simplify flushing mechanism, and
    allow internal buffer auto-grow if it was found out to be too small (see
    FlushToStream / FlushFinal methods and FlushToStreamNoAutoResize property)
  - fixed ticket [5bd9df5979] about TTextWriter.CancelAll issue
  - added optional internal buffer size for TTextWriter.CreateOwnedStream()
  - added new constructor TTextWriter.CreateOwnedFileStream()
  - added TTextWriter.LastChar and TTextWriter.AddStrings() methods
  - added TTextWriter.ForceContent method
  - added faster TTextWriter.SetText() method in conjuction to Text function
  - added TTextWriter.Add(const guid: TGUID) overloaded method
  - TTextWriter.Add(Format..) will now ignore any character afer |, i.e. |$ = $
  - added TTextWriter.AddQuotedStr() and AddStringCopy() methods
  - added TTextWriter.AddVoidRecordJSON() method
  - added TTextWriter.AddJSONEscapeAnsiString() method
  - added TTextWriter.AddAnyAnsiString() method and AnyAnsiToUTF8() function
  - added TTextWriter.EndOfLineCRLF property
  - for Delphi 2010 and up, RecordSaveJSON/RecordLoadJSON will use enhanced RTTI
  - before Delphi 2010, you can specify the record layout as text to
    TTextWriter.RegisterCustomJSONSerializerFromText() for JSON serialization
  - added TTextWriter.RegisterCustomJSONSerializerSetOptions() for [da22968223]
  - added TTextWriter.AddDynArrayJSON() overloaded method and new functions
    DynArrayLoadJSON() and DynArraySaveJSON() to be used e.g. for custom
    record JSON serialization, using TDynArrayJSONCustomReader/Writer
    callbacks and/or RegisterCustomJSONSerializerFromText(), or enhanced RTTI
  - added TTextWriter.AddDynArrayJSONAsString method, and moved
    TTextWriter.WriteObjectAsString from TJSONSerializer
  - added TTextWriter.UnRegisterCustomJSONSerializer() method
  - added TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType() method
  - added TTextWriter.AddTypedJSON() and AddCRAndIdent methods
  - added TTextWriter.SetDefaultJSONClass to force TJSONSerializer use
  - added TJSONWriter.EndJSONObject() method, for writing an optional
    ',"rowCount":' field in non expanded mode - used for all JSON creation
  - added TTextWriter.EchoAdd() and EchoRemove() methods
  - added QuickSortIndexedPUTF8Char() and FastFindIndexedPUTF8Char()
  - added overloaded QuickSortInteger() for synchronous sort of two arrays
  - added GetNextItem64() Int64Scan() Int64ScanExists() QuickSortInt64()
    FastFindInt64Sorted() AddInt64() CSVToInt64DynArray() Int64DynArrayToCSV()
    and VariantToInt64() functions (used during TID=Int64 introduction in ORM)
  - added RawUnicodeToUtf8() and UTF8ToSynUnicode() overloaded procedures
  - added UrlDecodeNextValue() and UrlDecodeNextNameValue() functions
  - added Utf8DecodeToRawUnicodeUI() overloaded function returning text as var
  - added UrlEncodeJsonObject() and new overloaded JSONDecode() function
  - added TRawUTF8DynArrayFrom(const Values: array of RawUTF8) function
  - added overloaded function FindRawUTF8() using array of RawUTF8 parameter
  - added TPropNameList record/object to maintain a stack-based list of names
  - speeed enhancement for TRawUTF8List.Add()
  - new TRawUTF8List.SaveToStream and SaveToFile methods
  - added optional aOwnObjects parameter to TRawUTF8List.Create() constructor
  - new TRawUTF8List.GetObjectByName() method
  - refactoring of CaseSensitive property for TRawUTF8List / TRawUTF8ListHashed
  - added TRawUTF8List.CaseSensitive property as requested by [806332d296]
  - added TRawUTF8MethodList class (based on TRawUTF8ListHashed)
  - added TRawUTF8ListHashedLocked class (based on TRawUTF8ListHashed)
  - added TAutoLocker/IAutoLocker and TLockedDocVariant/ILockedDocVariant types
  - added TAutoFree class, for automatic local variable lifetime management
  - added JSON_CONTENT_TYPE_HEADER and XML_CONTENT_TYPE[_HEADER] constants
  - new DateToSQL() overloaded function with direct Year/Month/Day parameters
  - added Base64MagicDecode(), Base64MagicCheckAndDecode() and SQLToDateTime()
  - added IsEqual(const A,B: TSQLFieldBits): boolean function
  - enhanced FPC/Lazarus Win32/Win64 compilation
  - TDynArrayHashed is now a record with Delphi 2009+, due to a bug in latest
    version of Delphi compiler when using TDynArrayHashed = object(TDynArray)
  - fixed [7658da5529] unexpected hash collision in TDynArrayHashed
  - fixed unexpected GPF in TSynCache.Find() e.g. when cache is disabled
  - handle variant serialization in/from JSON using new VariantLoadJSON(),
    VariantSaveJSON(), VariantSaveJSONLength() functions and corresponding
    TTextWriter.AddVariantJSON() method
  - handle variant serialization in/from our binary custom format, using new
    VariantLoad(), VariantSaveLength() and VariantSave() functions
  - added VariantToUTF8() overloaded functions for fast conversion
  - added VariantToInteger()/VariantToIntegerDef()/VariantToInt64() functions
    for direct process of numerical variants (e.g. array indexes)
  - new RawUTF8ToVariant() and VarRecToVariant() functions
  - new RawByteStringToVariant() and VariantToRawByteString() functions
  - added VariantDynArrayToJSON/JSONToVariantDynArray/ValuesToVariantDynArray()
  - added VariantDynArrayClear() function (faster e.g. for array of TDocVariant)
  - added VariantToInlineValue() and VarRecToInlineValue() functions
  - added VarRecAsChar() and overloaded Int32ToUTF8() Int64ToStr() Curr64ToStr()
    ExtendedToStr() PointerToHex() UInt32ToUtf8() procedures
  - handle binary serialization of variant via FromVarVariant() procedure and
    TFileBufferWriter.Write() method
  - added ToVarString(), FromVarInt64Value() and FromVarBlob() functions
  - added TFileBufferWriter.WriteVarInt64 and TFileBufferReader.ReadVarInt64
  - added TFileBufferWriter.Write1/Write4/Write8 methods and Tag property
  - new overloaded TFileBufferWriter.Create() constructor able to use a TStream
    class to replace CreateInRawByteStringStream and CreateInMemoryStream methods
  - now TFileBufferReader.Read() allows forward reading when Data=nil
  - added RecordSaveJSON() function which follows TTextWriter.AddRecordJSON() format
  - added TSynNameValue.InitFromIniSection() method and optional default value
    parameter to TSynNameValue.Value()
  - added TSynNameValue.Delete() and SetBlobDataPtr() methods
  - added TSynNameValue.OnAfterAdd callback event
  - added TObjectListLocked class
  - expose all internal Hash*() functions (following TDynArrayHashOne prototype)
    in interface section of the unit
  - added crc32c() function using either optimized unrolled version, or SSE 4.2
    instruction: crc32cfast() is 1.7 GB/s, crc32csse42() is 3.7 GB/s
  - added fnv32() function, slower than kr32, but with less collisions
  - added SynLZCompress/SynLZDecompress functions, using crc32c() for hashing
  - added SymmetricEncrypt() function
  - added GetAllBits() function
  - changed GetBitCSV/SetBitCSV CSV format to use 'first-last,' pattern to
    regroup set bits (reduce storage size e.g. for TSQLAccessRights) - format
    is still compatible with old layout, but will more optimized and readable
  - TSynTableStatement.Create() SQL statement parser will handle optional
    LIMIT [OFFSET] clause (in new Limit/Offset integer properties),
    ORDER BY ... [DESC/ASC] clause (in new OrderByField/OrderByDesc properties),
    GROUP BY ... clause (in GroupByField property), "LIKE", "IN(...)" and
    "IS [NOT] NULL" operators and custom functions in the WHERE clause
  - TSynTableStatement.Where[] is now an array to allow complex WHERE clause
  - TSynTableStatement.Select[] is now an array to allow aggregate functions,
    (e.g. Count,Max or Distinct), column aliases, or simple +/- computation
  - introducing TSQLFieldIndex and TSQLFieldIndexDynArray types and associated
    functions so that TSynTableStatement would store the SELECT column order
  - SQLParamContent() / ExtractInlineParameters() functions moved from mORMot.pas
    (now properly handles SQL null and more than MAX_SQLFIELDS parameters)
  - introducing TSQLParamType / TSQLParamTypeDynArray generic parameters
  - added RemoveCommentsFromJSON() procedure - from MPV proposal
  - added GarbageCollectorFreeAndNil() procedure to handle global variables
    proper finalization to nil - avoid error [8e3073c8c7] and [8546b4af1d] e.g.
    when used as design package in Delphi IDE (for all globals and class VMTs)
  - made GarbageCollectorFree public - may be usefull e.g. with packages
  - added GlobalLock/GlobalUnlock functions, used e.g. for ticket [ea4e8bd544] 
  - fixed rouding issue e.g. for ExtendedToString(double(22.99999999999997))
  - fixed potential GPF in TRawUTF8List.SetTextPtr() - ticket [d947b36cf9]
  - fixed potential GPF in function UrlDecodeNeedParameters()
  - fixed ticket [c8a8c71b12] allowing decoding of URI computed by browsers,
    even if they do not follow the RFC 3986 specifications
  - fixed potential GPF in serveral functions, when working with WideString
    (WideString aka OleStr do store their length in bytes, not WideChars)
  - fixed TDynArray.AddArray() method when Count parameter is not specified
  - fixed ticket [ad55566b10] about JSON string escape parsing
  - fixed ticket [cce54e98ca], [388c2768b6] and [355249a9d1] about overflow in
    TTextWriter.AddJSONEscapeW()
  - fixed ticket [a75c0c6759] about TTextWriter.AddNoJSONEscapeW()
  - added TTextWriter.AddHtmlEscape() and TTextWriter.AddXmlEscape() methods
  - new TTextWriter.AddHtmlEscapeWiki() method, supporting wiki-like syntax
  - TTextWriter.AddJSONEscape/AddJSONEscapeW methods speed up
  - fixed ticket [01408fd389] in TRawUTF8List.GetText()
  - fixed ticket [e3ae1005dc] about potential GPF in TRawUTF8List.Delete()
  - fixed ticket [1c940a4437] to avoid negative value in TPrecisionTimer.PerSec,
    in case of incorrect Start/Stop methods sequence
  - implement ticket [e3f9742865] for enhanced JSON in soWriteHumanReadable mode
  - added TPrecisionTimer.ProfileCurrentMethod() and TimeInMicroSec property
    for feature request [1abca090ee]
  - added TLocalPrecisionTimer/ILocalPrecisionTimer to alllocate a local timer
    instance on the stack
  - fixed ticket [815facfe57] in UTF8ILComp()
  - fixed UTF8ToWideChar() functions to always append a WideChar(0) to the end
    of the destination buffer, even if returned length is 0
  - added AnyTextFileToString, AnyTextFileToSynUnicode and AnyTextFileToRawUTF8
  - declared PByteArray, PWordArray, PPointerArray here - see [d6b38a96e6]
  - fixed IdemPChar() in pure pascal to behave like the asm version (i.e.
    if up parameter is nil, will return TRUE)
  - added IdemPCharWithoutWhiteSpace() function
  - confusing-named RoundTo2Digits() function renamed into Trunc2ToDigit()
  - added simple, non banker rounding SimpleRoundTo2Digits() function
  - fixed potential comparison error in TSynTableFieldProperties.SortCompare()
    when sorting UTF8 Field with tfoCaseInsensitive in Options
  - speedup of QuotedStr() function and TDynArrayHashed hashing process
  - added GotoEndOfJSONString() function
  - added GetJSONPropName() and GotoNextJSONPropName() functions, able to
    understand MongoDB extended syntax
  - added JSONArrayCount() and JSONObjectPropCount() functions
  - several speedup in GetJSONField() and JSON parsing: it will now expect true,
    false or null to be in lowercase only (as in json.org specifications)
  - fixed function GetJSONField() to properly decode JSON number with exponent
  - added function GetJSONFieldOrObjectOrArray() in unit's interface section  
  - function GotoNextJSONField() renamed GotoNextJSONItem(), and fixed to
    handle nested JSON array or objects in addition to string/numbers
  - added GotoEndJSONItem() and GetJSONItemAsRawJSON() functions
  - added function JSONRetrieveIDField() for fast retrieval of a "ID":.. value
  - added function JSONRetrieveStringField() for retrieval of a string field
    name or value from JSON buffer
  - added PtrUIntScanIndex() and UnixTimeToDateTime/DateTimeToUnixTime()
    UnixMSTimeToDateTime/DateTimeToUnixMSTime functions
  - fixed ticket [aff1352239] to identify 9999-12-31 dates as valid
  - added Iso8601ToTimePUTF8Char[Var]() and IntervalTextToDateTime[Var]() functions
  - added DateTimeToIso8601ExpandedPChar() and Iso8601CheckAndDecode() functions
  - added TTimeLogBits.FromUTCTime method and NowUTC / TimeLogNowUTC functions
  - added TTimeLogBits.FromUnixTime/FromUnixMSTime/ToUnixTime/ToUnixMSTime
  - added TTimeLogBits.Year/Month/Day/Hour/Minute/Second functions
  - added GetTickCount64() function, native since Vista, emulated e.g. for XP
  - introducing InterlockedIncrement/IntelrlockedDecrement compatibility functions
  - fixed TTextWriter.RegisterCustomJSONSerializer() method when unregistering
  - fixed TTextWriter.AddFloatStr() method when processing '-.5' input
  - fixed potential random GPF in TTextWriter after Flush - see [577ad95cfd0]
  - added TTextWriter.Add(const Values: array of const) method
  - added JSONToXML() JSONBufferToXML() and TTextWriter.JSONBufferToXML()
    for direct and fast conversion of any JSON into the corresponding <XML>
  - added JSONReformat() JSONBufferReformat() JSONReformatToFile()
    JSONBufferReformatToFile() and TTextWriter.AddJSONReformat()
    for fast conversion into more readable, compact or extended layout 
  - fixed potential GPF issue in TMemoryMapText.LoadFromMap()
  - added TMemoryMapText.AddInMemoryLine method to allow runtime appending of
    new lines of text - used e.g. by TSynLogFile for life update of remote logs
  - added TMemoryMapText.SaveToFile() and TMemoryMapText.SaveToStream() methods
  - allow file size of 0 byte in TMemoryMap.Map()
  - introduced TSynInvokeableVariantType.Clear() and Copy() default methods
  - added TSynInvokeableVariantType.CopyByValue() virtual method
  - added TSynInvokeableVariantType.IsOfType() method
  - TSynInvokeableVariantType.SetProperty() will now convert any varOleStr into
    a RawUTF8/varString, and dereference any simple varByRef transmitted values
    so that we could safely use late-binding with any kind of value
  - internal DispInvoke() function speed-up by caching the latest accessed type
  - enabled DispInvoke() function for Delphi XE2 and up (it will also fix the
    regression issue in the new RTL which let the field names be uppercased)   
  - several TSynTableFieldProperties speed up, when working with variants
  - removed several compilation hints when assertions are set to off
  - UnCamelCase() functions will now handle capital words and numbers at the
    beginning, middle or end of the text - implements request [d0c8210fae]
  - added TSynBackgroundThreadAbstract class for generic background process, and
    callback-driven TSynBackgroundThreadEvent / TSynBackgroundThreadProcedure /
    TSynBackgroundThreadMethod inherited classes
  - added SetThreadName/SetCurrentThreadName functions for request [6acfd0a3d3]
  - added TSynFPUException class to allow per-method customization of the FPU
    exception mapping: to be used e.g. when mixing code between external
    libraries and Delphi code
  - added new TSynValidateNonVoidText and TSynFilterTruncate classes
  - added new TSynCriticalSection class, avoiding CPU cache performance issue
  - added Utf8TruncateToUnicodeLength() and Utf8TruncateToLength() functions
  - added MaxAlphaCount, MaxDigitCount, MaxPunctCount, MaxLowerCount and
    MaxUpperCount properties to TSynValidateText class
  - if DOPATCHTRTL is defined, will enable asm-optimized RecordClear and
    _InitializeRecord functions in replacement to the slower RTL version, and
    patch TObject.CleanupInstance before Delphi 2009 (since TMonitor.Destroy
    is sadly private to System.pas)
  - introducing TSQLVar to define database-oriented values
    used by SynDB, mORMot, mORMotDB and mORMotSQLite3 units (instead of former
    confusing TVarData record, which is now dedicated to variant mapping)
  - moved TSQLDBFieldType from SynDB to SynCommons, and used by TSQLVar and all
    database-related process (i.e. in mORMot and SynDB units)
  - SYNOPSE_FRAMEWORK_VERSION constant will now include a per-commit increasing
    number (generated by SourceCodeRep tool), to specify the exact source state
    and a more complete SYNOPSE_FRAMEWORK_FULLVERSION constant has been added

*)


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

interface

uses
{$ifdef MSWINDOWS}
  Windows,
  Messages,
{$endif}
{$ifdef KYLIX3}
  Types,
  LibC,
  SynKylix,
{$endif}
  Classes,
{$ifndef LVCL}
  SyncObjs, // for TEvent and TCriticalSection
  Contnrs,  // for TObjectList
{$ifdef HASINLINE}
  Types,
{$endif}
{$endif}
{$ifndef NOVARIANTS}
  Variants,
{$endif}
  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 LVCL}+'_LVCL'{$else}
    {$ifdef ENHANCEDRTL}+' ERTL'{$endif}{$endif}
    {$ifdef DOPATCHTRTL}+' PRTL'{$endif}
    {$ifdef INCLUDE_FTS3}+' FTS3'{$endif};

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

{$ifndef MSWINDOWS}
  /// estimate the system code page is WinAnsi
  GetACP = CODEPAGE_US;
  /// internal Code Page for UTF-8 Unicode encoding
  CP_UTF8 = 65001;
{$endif}

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

type
  PBoolean = ^Boolean;

{$else FPC}

type
  /// a CPU-dependent unsigned integer type cast of a pointer / register
  // - used for 64 bits compatibility, native under Free Pascal Compiler
{$ifdef ISDELPHI2009}
  PtrUInt = cardinal; { see http://synopse.info/forum/viewtopic.php?id=136 }
{$else}
  PtrUInt = {$ifdef UNICODE}NativeUInt{$else}cardinal{$endif};
{$endif}
  /// a CPU-dependent unsigned integer type cast of a pointer of pointer
  // - used for 64 bits compatibility, native under Free Pascal Compiler
  PPtrUInt = ^PtrUInt;

  /// a CPU-dependent signed integer type cast of a pointer / register
  // - used for 64 bits compatibility, native under Free Pascal Compiler
  PtrInt = {$ifdef UNICODE}NativeInt{$else}integer{$endif};
  /// a CPU-dependent signed integer type cast of a pointer of pointer
  // - used for 64 bits compatibility, native under Free Pascal Compiler
  PPtrInt = ^PtrInt;

  /// unsigned Int64 doesn't exist under older Delphi, but is defined in FPC
  QWord = {$ifdef HASINLINE}UInt64{$else}Int64{$endif};

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

{$endif FPC}

{$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  = '\';

type
  PPointer = ^Pointer;
  PPAnsiChar = ^PAnsiChar;
  PInteger = ^Integer;
  PCardinal = ^Cardinal;
  PWord = ^Word;
  PByte = ^Byte;
  PBoolean = ^Boolean;
  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
  /// a pointer to a PtrUInt array
  TPtrUIntArray = array[0..MaxInt div SizeOf(PtrUInt)-1] of PtrUInt;
  PPtrUIntArray = ^TPtrUIntArray;

  /// a dynamic array of PtrUInt values
  TPtrUIntDynArray = array of PtrUInt;

{$ifndef NOVARIANTS}
  /// a pointer to a variant array
  TVariantArray = array[0..MaxInt div SizeOf(Variant)-1] of Variant;
  PVariantArray = ^TVariantArray;

  /// a dynamic array of variant values
  TVariantDynArray = array of variant;
{$endif}

  {/ 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 }
{$ifdef UNICODE} 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 UNICODE} 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 UNICODE} WinAnsiString = type AnsiString(1252); // WinAnsi Codepage
{$else}          WinAnsiString = type AnsiString; {$endif}

{$ifndef UNICODE}
  /// 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 pointer to a PAnsiChar array
  TPAnsiCharArray = array[0..MaxInt div SizeOf(PAnsiChar)-1] of PAnsiChar;
  PPAnsiCharArray = ^TPAnsiCharArray;

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

  /// a pointer to a RawUTF8 array
  TRawUTF8Array = array[0..MaxInt div SizeOf(RawUTF8)-1] of RawUTF8;
  PRawUTF8Array = ^TRawUTF8Array;

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

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

  /// a dynamic array of WinAnsi encoded strings
  TWinAnsiDynArray = array of WinAnsiString;
  PWinAnsiDynArray = ^TWinAnsiDynArray;

  /// a dynamic array of RawByteString
  TRawByteStringDynArray = array of RawByteString;

  /// a dynamic array of generic VCL strings
  TStringDynArray = array of string;
  PStringDynArray = ^TStringDynArray;

  /// a dynamic array of TDateTime values
  TDateTimeDynArray = array of TDateTime;
  PDateTimeDynArray = ^TDateTimeDynArray;

  {$ifndef DELPHI5OROLDER}
  /// a dynamic array of interface values
  TInterfaceDynArray = array of IInterface;
  PInterfaceDynArray = ^TInterfaceDynArray;
  {$endif}

  /// a dynamic array of WideString values
  TWideStringDynArray = array of WideString;
  PWideStringDynArray = ^TWideStringDynArray;

  /// a dynamic array of SynUnicode values
  TSynUnicodeDynArray = array of SynUnicode;
  PSynUnicodeDynArray = ^TSynUnicodeDynArray;

  PIntegerDynArray = ^TIntegerDynArray;
  TIntegerDynArray = array of integer;
  PCardinalDynArray = ^TCardinalDynArray;
  TCardinalDynArray = array of cardinal;
  PSingleDynArray = ^TSingleDynArray;
  TSingleDynArray = array of Single;
  PInt64DynArray = ^TInt64DynArray;
  TInt64DynArray = array of Int64;
  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;
  TMethodDynArray = array of TMethod;
  PMethodDynArray = ^TMethodDynArray;
  TObjectListDynArray = array of TObjectList;
  PObjectListDynArray = ^TObjectListDynArray;
  TFileNameDynArray = array of TFileName;
  PFileNameDynArray = ^TFileNameDynArray;

  PByteArray = ^TByteArray;
  TByteArray = array[0..MaxInt-1] of Byte; // redefine here with {$R-}

  TWordArray  = array[0..MaxInt div SizeOf(word)-1] of word;
  PWordArray = ^TWordArray;

  TIntegerArray = array[0..MaxInt div SizeOf(Integer)-1] of Integer;
  PIntegerArray = ^TIntegerArray;

  TCardinalArray = array[0..MaxInt div SizeOf(cardinal)-1] of cardinal;
  PCardinalArray = ^TCardinalArray;

  TInt64Array = array[0..MaxInt div SizeOf(Int64)-1] of Int64;
  PInt64Array = ^TInt64Array;

  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;

  TRawByteStringArray = array[0..MaxInt div SizeOf(RawByteString)-1] of RawByteString;
  PRawByteStringArray = ^TRawByteStringArray;

  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;
  {$ifndef DELPHI5OROLDER}
  PIInterface = ^IInterface;
  {$endif}

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

  TStreamClass = class of TStream;
  PObject = ^TObject;

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

type
  /// 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}
  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
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): 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
    // - a #0 char is appended at the end (and result will point to it)
    // - this default implementation will use the Operating System APIs
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char; overload; virtual;
    /// convert any Ansi Text into an 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;
    /// 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
    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;
    /// 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;
      {$ifdef HASINLINE}inline;{$endif}
    /// 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;
  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
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): 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
    // - a #0 char is appended at the end (and result will point to it)
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): 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
    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)
  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
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): 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
    // - a #0 char is appended at the end (and result will point to it)
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): 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 UTF-8 encoded buffer into a PAnsiChar UTF-8 buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    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
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8ToAnsi(const UTF8: RawUTF8): RawByteString; override;
    /// convert any Ansi Text into an UTF-8 encoded String
    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
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): 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
    // - a #0 char is appended at the end (and result will point to it)
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): 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
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar; override;
  end;


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, as defined in the corresponding RFC
  HEADER_CONTENT_TYPE = 'Content-Type: ';

  /// HTTP header, as defined in the corresponding RFC, in upper case
  HEADER_CONTENT_TYPE_UPPER = 'CONTENT-TYPE: ';

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

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

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;

  
/// faster equivalence to SetString() function for a RawUTF8
// - will reallocate the content in-place if the string refcount is 1
// - to be used instead of SetString() for "var" RawUTF8 parameters
// - for RawUTF8 function result, SetString is still faster:
// ! SynCommons.UInt32ToUtf8(Value: cardinal): RawUTF8; SetRawUTF8 245.64ms
// ! SynCommons.UInt32ToUtf8(Value: cardinal): RawUTF8; SetString  136.39ms
procedure SetRawUTF8(var Dest: RawUTF8; text: pointer; len: integer);

/// faster equivalence to SetString(s,nil,len) function for a RawUTF8
// - won't allocate the content if the string refcount is 1 and len matches
procedure FastNewRawUTF8(var s: RawUTF8; len: integer);

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

/// 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;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an UTF-8 encoded text into a WideChar array
// - faster than System.UTF8ToUnicode
// - sourceBytes can by 0, therefore length is computed from zero terminated source
// - enough place must be available in dest
// - a WideChar(#0) is added at the end (if something is written)
// - returns the BYTE count written in dest, excluding the ending WideChar(#0)
function UTF8ToWideChar(dest: pWideChar; source: PUTF8Char; sourceBytes: PtrInt=0): PtrInt; overload;

/// convert an UTF-8 encoded text into a WideChar array
// - 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
// - a WideChar(#0) is added at the end (if something is written)
// - returns the BYTE COUNT (not WideChar count) written in dest, excluding the
// ending WideChar(#0)
function UTF8ToWideChar(dest: pWideChar; source: PUTF8Char; MaxDestChars, sourceBytes: PtrInt): 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;

/// 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
// UTF-8 Unicode characters 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; maxUTF8: cardinal): boolean;

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

/// convert a RawUnicode PWideChar into a UTF-8 string
procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer; var result: RawUTF8); overload;

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

/// convert a RawUnicode PWideChar into a UTF-8 buffer
// - replace system.UnicodeToUtf8 implementation, which is rather slow
// since Delphi 2009+
function RawUnicodeToUtf8(Dest: PUTF8Char; DestLen: PtrInt; Source: PWideChar; SourceLen: PtrInt): 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;

{$endif}

{$ifdef UNICODE}

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

/// convert any generic VCL Text into an UTF-8 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 StringToUTF8(const Text: string): 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}

{$ifndef NOVARIANTS}

/// 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
// - wasString is set if the V value was a text
// - custom variant types will be stored as JSON
procedure VariantToUTF8(const V: Variant; var result: RawUTF8;
  var wasString: boolean); overload;

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

/// faster alternative to Finalize(aVariantDynArray)
// - for instance, an array of TDocVariant will be optimized for speed
procedure VariantDynArrayClear(var Value: TVariantDynArray);

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

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

/// 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 UNICODE}inline;{$endif}

/// convert any UTF-8 encoded String into a generic WideString Text
procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString); overload;
  {$ifdef UNICODE}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;

/// 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 UNICODE}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 inlined in the resulting string
// according to each Args[] supplied item
// - resulting string has no length limit and uses fast concatenation
// - note that cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
// - any supplied TObject instance will be written as their class name
function FormatUTF8(const Format: RawUTF8; const Args: array of const): RawUTF8; overload;

/// 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 cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
// - 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;

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

/// 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 or vtInt64
// - returns FALSE if the argument is not an integer 
function VarRecToInt64(const V: TVarRec; out value: Int64): 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 cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
// - 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}

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

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
function bswap32(a: cardinal): cardinal;

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


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

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

{$ifndef PUREPASCAL}
{$ifndef LVCL} { don't define these functions twice }

{$ifndef FPC}  { these asm function use some low-level system.pas calls }
/// use our fast asm RawUTF8 version of Trim()
function Trim(const S: RawUTF8): RawUTF8;

/// use our fast asm version of CompareMem()
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
{$endif FPC}

{$endif LVCL}
{$endif PUREPASCAL}

{$endif ENHANCEDRTL}

{$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): RawByteString; 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
// - only useful if our Enhanced Runtime (or LVCL) library is not installed
function Int32ToUtf8(Value: integer): RawByteString; 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 : integer; 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}

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

/// optimized conversion of a cardinal into RawUTF8
procedure UInt32ToUtf8(Value: cardinal; 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;

const
  /// best possible precision when rendering a "single" kind of float
  // - can be used as parameter for ExtendedToString/ExtendedToStr
  SINGLE_PRECISION = 8;
  /// best possible precision when rendering a "double" kind of float
  // - can be used as parameter for ExtendedToString/ExtendedToStr
  DOUBLE_PRECISION = 15;

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}

/// convert a floating-point value to its numerical text equivalency
// - returns the count of chars stored into S (S[0] is not set)
function ExtendedToString(var S: ShortString; Value: TSynExtended; Precision: integer): integer;

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

/// fast retrieve the position of a given character
function PosChar(Str: PUTF8Char; Chr: AnsiChar): 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): Integer;

/// 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 : integer): RawUTF8;
  !var tmp: array[0..15] of AnsiChar;
  !    P: PAnsiChar;
  !begin
  !  P := StrInt32(@tmp[15],Value);
  !  SetString(result,P,@tmp[15]-P);
  !end;
 - not to be called directly: use IntToStr() 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^) }
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 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;
  {$ifdef HASINLINE}inline;{$endif}

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

/// 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 over the buffer
// - to be used instead of StrLen() on a memory protected buffer
function StrLenPas(S: pointer): PtrInt;

{$ifdef FPC}
/// FPC will use its internal optimized implementation
function StrLen(S: pointer): sizeint; external name 'FPC_PCHAR_LENGTH';
{$else}
/// our fast version of StrLen(), to be used with PUTF8Char/PAnsiChar
// - this version will use fast SSE2 instructions (if available), on both Win32
// and Win64 platforms: please note that in this case, it may read up to 15 bytes
// before or beyond the string; this is rarely a problem but it can in principle
// generate a protection violation (e.g. when used over mapped files) - in this
// case, you can use the slightly slower StrLenPas() function instead
var StrLen: function(S: pointer): PtrInt = StrLenPas;
{$endif}

/// 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;
  TNormTableByte = packed array[byte] of byte;

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;

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

/// get the signed 32 bits 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 bits 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 bits integer value stored in P^
// - we use the PtrUInt result type, even if expected to be 32 bits, to use
// native CPU register size (don't want any 32 bits overflow here)
function GetCardinal(P: PUTF8Char): PtrUInt;

/// get the unsigned 32 bits 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 bits integer value stored as Unicode string in P^
function GetCardinalW(P: PWideChar): PtrUInt;

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

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

/// get the 64 bits 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;

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

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

/// 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 := UrlEncodeFull(['select','*','where','ID=12','offset',23,'object',aObject]);
// - parameters can be either textual, integer or extended, or any TObject
// (standard UrlEncode() will only handle
// - 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; Upper: PAnsiChar; 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; Upper: PAnsiChar;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; Upper: PAnsiChar;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; Upper: PAnsiChar;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; Upper: PAnsiChar; 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; Upper: PAnsiChar; 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;


/// returns TRUE if the given text buffer contains A..Z,0..9 characters
// - use it with property names values (i.e. only including A..Z,0..9 chars)
// - i.e. can be tested via IdemPropName*() functions
// - first char must be alphabetical or '_', following chars can be
// alphanumerical or '_'
function PropNameValid(P: PUTF8Char): boolean;

/// case unsensitive test of P1 and P2 content
// - 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 unsensitive test of P1 and P2 content
// - use it with property names values (i.e. only including A..Z,0..9 chars)
// - this version expect P2 to be a PAnsiChar with a specified length
function IdemPropName(const P1: shortstring; P2: PUTF8Char; P2Len: integer): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

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

/// case unsensitive test of P1 and P2 content
// - use it with property names values (i.e. only including A..Z,0..9 chars)
// - this version expect P1 and P2 to be a PAnsiChar with specified lengths
function IdemPropNameU(const P1: RawUTF8; P2: PUTF8Char; P2Len: integer): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// case unsensitive test of P1 and P2 content
// - use it with property names values (i.e. only including A..Z,0..9 chars)
function IdemPropNameU(const P1,P2: RawUTF8): boolean; overload;

/// 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 - 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
function IdemPCharArray(p: PUTF8Char; const upArray: array of PAnsiChar): integer;

/// 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 expect p^ to point to an Unicode char array
function IdemPCharW(p: pWideChar; up: PUTF8Char): boolean;

/// 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): 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
function GetHighUTF8UCS4(var U: PUTF8Char): cardinal;

/// 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): cardinal;
  {$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;

const
  /// used e.g. by inlined function GetLineContains()
  ANSICHARNOT01310: set of AnsiChar = [#1..#9,#11,#12,#14..#255];

/// 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 dest^ with 7 bits upper case conversion
// - returns final dest pointer
// - will copy up to 255 AnsiChar (expect the dest buffer to be array[byte] of
// AnsiChar)
function UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;

/// copy source into dest^ with WinAnsi 8 bits upper case conversion
// - 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
// - 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
// - 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 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 convert 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}

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

/// fast conversion of the supplied text into lowercase
// - this will only convert 'A'..'Z' into 'a'..'z' (no NormToLower use), and
// will therefore by correct with true UTF-8 content
function LowerCase(const S: RawUTF8): 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 an UnicodeString
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;

{$ifdef FPC}
/// our fast RawUTF8 version of Trim(), for FPC only
function Trim(const S: RawUTF8): RawUTF8;
{$endif}

{$ifdef PUREPASCAL}

/// our fast RawUTF8 version of Trim(), for Unicode only compiler
// - this Trim() is seldom used, but this RawUTF8 specific version is needed
// by Delphi 2009+, to avoid two unnecessary conversions into UnicodeString
function Trim(const S: RawUTF8): RawUTF8;

{$ifndef 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
function Pos(const substr, str: RawUTF8): Integer; overload; inline;
{$endif UNICODE}

{$endif PUREPASCAL}

{$endif UNICODE}

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

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

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

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

{/ format a text content with 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 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 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);

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

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

/// 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' statement also returns true, since doesn't change the data content
function isSelect(P: PUTF8Char): 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;

/// return line begin from source array of chars, and go to next line
// - next will contain the beginning of next line, or nil if source if ended
function GetNextLineBegin(source: PUTF8Char; out next: PUTF8Char): PUTF8Char;
  {$ifdef HASINLINE}inline;{$endif}

/// compute the line length from source array of chars
// - end counting at either #0, #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, nil if no more
function GetNextItem(var P: PUTF8Char; Sep: AnsiChar= ','): 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
procedure GetNextItemShortString(var P: PUTF8Char; out Dest: ShortString; Sep: AnsiChar= ',');

/// return next CSV string as unsigned integer from P, 0 if no more
function GetNextItemCardinal(var P: PUTF8Char; Sep: AnsiChar= ','): PtrUInt;

/// return next CSV string as signed integer from P, 0 if no more
function GetNextItemInteger(var P: PUTF8Char; Sep: AnsiChar= ','): PtrInt;

/// return next CSV string as 64 bit signed integer from P, 0 if no more
function GetNextItemInt64(var P: PUTF8Char; Sep: AnsiChar= ','): Int64;

/// 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 expect 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
function GetNextItemDouble(var P: PUTF8Char; Sep: AnsiChar= ','): double;

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

/// 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=','); 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;

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

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

/// 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
  TPropNameList = {$ifndef UNICODE}object{$else}record{$endif}
    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;

/// 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 expect 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']);
function ExistsIniNameValue(P: PUTF8Char; const UpperName: RawUTF8;
  const UpperValues: array of RawUTF8): 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): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// read a File content into a String
// - content can be binary or text
// - returns '' if file was not found or any read error occured
// - uses RawByteString for byte storage, thatever the codepage is
function StringFromFile(const FileName: TFileName): RawByteString;

/// create a File from a string content
// - uses RawByteString for byte storage, thatever the codepage is
function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean=false): 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 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
procedure WriteStringToStream(S: TStream; const Text: RawUTF8);

/// get the file date and time
// - returns 0 if file doesn't exist
function FileAgeToDateTime(const FileName: TFileName): TDateTime;

/// get the file size
// - returns 0 if file doesn't exist
function FileSize(const FileName: TFileName): Int64;

/// 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
// - 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='*.*';
  DeleteOnlyFilesNotDirectory: Boolean=false): Boolean;

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

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

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

{$endif DELPHI5OROLDER}

/// extract file name, without its extension
function GetFileNameWithoutExt(const FileName: TFileName): 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 searching 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 }
  TSynSoundEx = {$ifndef UNICODE}object{$else}record{$endif}
  private
    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;
    /// 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;

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


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

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

/// UnCamelCase and translate the enumeration item
function GetCaptionFromEnum(aTypeInfo: pointer; aIndex: integer): string;

/// 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
// - 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
// - can be used as such:
// !  Call.OutHead := HEADER_CONTENT_TYPE+
// !   GetMimeContentType(pointer(Call.OutBody),Length(Call.OutBody),aFileName);
function GetMimeContentType(Content: Pointer; Len: integer;
   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 zip/gz/gif/wma/png/jpeg markers
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;

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;

/// 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 (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;

/// 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)
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 (so will work with any PAnsiChar)
// - returns -1 if the specified Value was not found
function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): 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 (so will work with any PAnsiChar)
// - returns -1 if the specified Value was not found
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
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 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;

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

/// 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 64 bit Integer array, low values first
procedure QuickSortInt64(ID: PInt64Array; L, R: PtrInt); overload;

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

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

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

/// fast binary search of a 64 bit 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;

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

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

/// 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 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
// - 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)
// - true if Value was added successfully in Values[], in this case
// length(Values) will be increased
function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; NoDuplicates: boolean=false): boolean; overload;

/// add a 64 bit integer value at the end of a dynamic array of integers
procedure AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: Int64);

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

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

/// find the maximum integer in Values[]
function MaxInteger(const Values: TIntegerDynArray; ValuesCount: integer;
  MaxStart: integer=-1): 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, Count: integer);

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

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

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

/// 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: array of Int64; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''): RawUTF8;


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 :(
  TSortedWordArray = {$ifndef UNICODE}object{$else}record{$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;

/// 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
function FromVarUInt32(var Source: PByte): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// 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; {$ifdef HASINLINE}inline;{$endif}

/// 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 text buffer
function FromVarString(var Source: PByte): RawUTF8;

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. SortDynArrayByte,
  // SortDynArrayWord, SortDynArrayInteger, SortDynArrayCardinal,
  // SordDynArraySingle, SortDynArrayInt64,
  // 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;

  /// 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)
  // - djByte .. djTimeLog match numerical JSON values
  // - djDateTime .. djSynUnicode 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,
    djByte, djWord, djInteger, djCardinal, djSingle,
    djInt64, djDouble, djCurrency,
    djTimeLog, djDateTime, djRawUTF8, djWinAnsi, djString,
    djWideString, djSynUnicode,
    {$ifndef NOVARIANTS}djVariant,{$endif}
    djCustom);

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

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
  {$ifdef UNICODE}
  { due to a bug in Delphi 2009+, we need to fake inheritance of record,
    since TDynArrayHashed = object(TDynArray) fails to initialize 
    http://blog.synopse.info/post/2011/01/29/record-and-object-issue-in-Delphi-2010 }
  {$define UNDIRECTDYNARRAY}
  {$endif}

  /// 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;
    fElemSize: PtrUInt;
    fElemType: pointer;
    fCompare: TDynArraySortCompare;
    fCountP: PInteger;
    fSorted: boolean;
    fKnownType: TDynArrayKind;
    fKnownSize: integer;
    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): integer;
    function GetArrayTypeName: RawUTF8;
    function IsObjArray: boolean; {$ifdef HASINLINE}inline;{$endif}
    /// will set fKnownType and fKnownOffset/fKnownSize fields
    function ToKnownType(exactType: boolean=false): TDynArrayKind;
    /// 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 would 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..djSynUnicode 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}
    /// 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
    // will be a bit slower than e.g. with a TList: the list is reallocated
    // every time a record is added - but in practice, with FastMM4 or
    // SynScaleMM, there is no big speed penalty - for even better speed, you
    // can also specify an external count variable in Init(...,@Count) method
    function Add(const Elem): integer;
    /// add an element to the dynamic array
    // - this version add a void element to the array, and returns its index
    function New: integer;
    /// add elements from a given dynamic array
    // - the supplied source DynArray MUST be of the same exact type as the
    // current used for this TDynArray
    // - 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 AddArray(const DynArray; aStartIndex: integer=0; aCount: integer=-1);
    /// 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: Integer; const Elem);
    /// delete the whole dynamic array content
    // - this method will recognize T*ObjArray types and free all instances 
    procedure Clear;
    /// 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: Integer);
    /// 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)
    function ElemPtr(aIndex: integer): pointer;
    /// 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): integer;
    /// 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 binary search
    // - if the array is not sorted, it will use slower 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): integer; 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 binary search
    // - if an indexed lookup is not supplied (i.e aIndex=nil),
    // this function will use slower but accurate 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): integer; 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 binary search
    // - if the array is not sorted, it will use slower 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 binary search
    // - if the array is not sorted, it will use slower 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(var 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 binary search
    // - if the array is not sorted, it will use slower 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 binary search
    // - if the array is not sorted, it will use slower 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;
    /// will reverse all array elements, in place
    procedure Reverse;
    /// sort the dynamic array elements using a lookup array of indexes
    // - it won't change the dynamic array content: only create or update
    // the given integer lookup array, using the specified comparison function
    // - 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);
    /// 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
    // - 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
    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
    // - this method will raise an ESynException for T*ObjArray types
    function SaveTo(Dest: PAnsiChar): PAnsiChar; overload;
    /// compute the number of bytes needed to save a dynamic array content
    // - this method will raise an ESynException for T*ObjArray types
    function SaveToLength: integer;
    /// save the dynamic array content into a RawByteString
    // - this method will raise an ESynException for T*ObjArray types
    function SaveTo: RawByteString; overload;
    /// load the dynamic array content from a memory buffer
    // - return nil if the Source buffer is incorrect (invalid type or internal
    // checksum e.g.)
    // - in case of success, return the memory buffer pointer just after the
    // read content
    // - this method will raise an ESynException for T*ObjArray types
    // - return a pointer at the end of the data read from Source, nil on error
    function LoadFrom(Source: PAnsiChar): 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: RawUTF8;
    /// load the dynamic array content from an UTF-8 encoded JSON buffer
    // - expect the format as saved by TTextWriter.AddDynArrayJSON method, i.e.
    // handling 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
    function LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil): PUTF8Char;
    ///  select a sub-section (slice) of a dynamic array content
    procedure Slice(var Dest; aCount: Cardinal; aFirstIndex: cardinal=0);
    {$ifndef DELPHI5OROLDER}
    /// compare the content of the two arrays, returning TRUE if both match
    // - this method compares first using any supplied Compare property,
    // then by content using the RTTI element description of the whole record
    // - warning: this method won't compare T*ObjArray kind of arrays
    function Equals(const B: TDynArray): boolean;
    /// set all content of one dynamic array to the current array
    // - both must be of the same exact type
    procedure Copy(const Source: TDynArray);
    /// set all content of one dynamic array to the current array
    // - both must be of the same exact type
    procedure CopyFrom(const Source; MaxElem: integer);
    {$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);
    /// save an array element into a serialized buffer
    // - 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 Find(i+10) e.g.)
    function ElemSave(const Elem): RawByteString;
    /// load an array element as saved by the ElemSave method
    // - 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.)
    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
    // and caller MUST call ElemLoadClear() method to finalize its content
    function ElemLoad(Source: PAnsiChar): RawByteString; overload;
    /// release memory allocated by ElemLoad(): RawByteString
    procedure ElemLoadClear(var ElemLoaded: RawByteString);
    /// 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;

    /// retrieve or set the number of elements of the dynamic array
    // - same as length(DynArray) or SetLenght(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,
    // 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 use binary search in
    // an usorted 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
    property ArrayTypeName: RawUTF8 read GetArrayTypeName;
    /// the internal in-memory size of one element, as retrieved from RTTI
    property ElemSize: PtrUInt read fElemSize;
    /// the internal type information of one element, as retrieved from RTTI
    property ElemType: pointer read fElemType;
  end;

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

  /// 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
  TOnDynArrayHashOne = 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;

  /// 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
    procedure SetCount(aCount: Integer);        inline;
    procedure SetCapacity(aCapacity: Integer);  inline;
    function GetCapacity: Integer;              inline;
  public
    InternalDynArray: TDynArray;
    function Count: Integer;            inline;
    function fValue: PPointer;          inline;
    function ElemSize: PtrUInt;         inline;
    function ElemType: Pointer;         inline;
    function KnownType: TDynArrayKind;  inline;
    procedure Clear;                    inline;
    // warning: you shall call ReHash() after manual Add/Delete
    function Add(const Elem): integer;  inline;
    procedure Delete(aIndex: Integer);  inline;
    function SaveTo: RawByteString;     inline;
    function LoadFrom(Source: PAnsiChar): PAnsiChar;  inline;
    function Find(const Elem): integer; inline;
    property Capacity: integer read GetCapacity write SetCapacity;
  private
  {$else}
  TDynArrayHashed = object(TDynArray)
  protected
  {$endif}
    fHashElement: TDynArrayHashOne;
    fHasher: THasher;
    fHashs: TSynHashDynArray;
    fEventCompare: TEventDynArraySortCompare;
    function HashOneFromTypeInfo(const Elem): cardinal;
      {$ifdef HASINLINE}inline;{$endif}
    function HashFind(aHashCode: cardinal; const Elem): integer;
    procedure HashAdd(const Elem; aHashCode: Cardinal; var result: integer);
    function GetHashFromIndex(aIndex: Integer): Cardinal;
    procedure HashInit;
  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, using TDynArrayKind  kind of first field
    // - djNone and djCustom are too vague, and would 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..djSynUnicode 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
    procedure ReHash(aHasher: TOnDynArrayHashOne=nil);
    /// 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
    function FindHashed(const Elem): 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 Elem): 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 for filling 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 HashOneFromTypeInfo(Elem)
    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(var 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(var Elem): integer;
    /// retrieve the hash value of a given item, from its index
    property Hash[aIndex: Integer]: 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;
  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;
  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;
    /// 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;
  public
    /// initialize the wrapper with a one-dimension dynamic array of TObject
    constructor Create(var aValue);
    /// 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
    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;
    /// 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
  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;
    /// 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 is added
    // - return FALSE if this item is already existing (i.e. insert error)
    // - return TRUE if has been added to the internal hash table
    // - the index of the latest added item should be Count-1
    function JustAdded: 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;
  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
  TSynPersistent = class(TObject)
  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-}

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

  
  /// 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 :(
  TSynNameValue = {$ifndef UNICODE}object{$else}record{$endif}
    fDynArray: TDynArrayHashed;
    fOnAdd: TSynNameValueNotify;
    function GetBlobData: RawByteString;
    procedure SetBlobData(const aValue: RawByteString);
  public
    /// the internal Name/Value storage
    List: TSynNameValueItemDynArray;
    /// the number of Name/Value pairs
    Count: integer;
    /// initialize the storage
    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);
    /// search for a Name, return the index in List
    function Find(const aName: RawUTF8): integer;
    /// search for a Name, and delete it in the List if it exists
    function Delete(const aName: RawUTF8): boolean;
    /// search for a Name, return the associated Value
    function Value(const aName: RawUTF8; const aDefaultValue: RawUTF8=''): RawUTF8;
    /// 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;
  end;

/// 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 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): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// 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, and
// return the index of the item in the dynamic array
function ObjArrayAddOnce(var aObjArray; aItem: TObject): integer;

/// 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(var aObjArray; aItem: TObject): 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: integer); 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): integer; 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);

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


/// helper to retrieve the text of an enumerate item
// - you'd better use RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetEnumName(aTypeInfo: pointer; aIndex: integer): PShortString;

/// 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 (this function won't trim the lowercase
// 'a'..'z' chars on the left side of the text)
// - you'd better use RTTI related classes of mORMot.pas unit, e.g. TEnumType
function GetEnumNameValue(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: integer): Integer;

/// compute the record size from its low-level RTTI
function RecordTypeInfoSize(aRecordTypeInfo: pointer): integer;

/// retrieve the type name from its low-level RTTI
procedure TypeInfoToName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8=''); overload;

/// retrieve the type name from its low-level RTTI
function TypeInfoToName(aTypeInfo: pointer): RawUTF8; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the item type information of a dynamic array low-level RTTI 
function TypeInfoToRecordInfo(aDynArrayTypeInfo: pointer;
  aDataSize: PInteger=nil): pointer;

/// compare two TGUID values
// - this version is faster than the one supplied by SysUtils
function IsEqualGUID(const guid1, guid2: TGUID): Boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// 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 {})
function GUIDToRawUTF8(const 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(const guid: TGUID): string;

type
  TGUIDShortString = string[38];

/// 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(const guid: TGUID): TGUIDShortString;

/// 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): 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
// - 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 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
// - 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;

/// save a record content into a Base-64 encoded RawByteString content
// - will use RecordSave() format, with a left-sided binary CRC
function RecordSaveBase64(const Rec; TypeInfo: pointer; UriCompatible: boolean=false): RawByteString;

/// 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)
function RecordSaveLength(const Rec; TypeInfo: pointer): 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
function RecordSaveJSON(const Rec; TypeInfo: pointer): RawUTF8;

/// 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
function RecordLoad(var Rec; Source: PAnsiChar; TypeInfo: pointer): PAnsiChar;

/// 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
// - warning: the JSON buffer will be modified in-place during process - use
// a temporary copy if you need to access it later
function RecordLoadJSON(var Rec; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char;

/// copy a record content from source to Dest
// - this unit includes a fast optimized asm version for x86
procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);

/// clear a record content
// - this unit includes a fast optimized asm version for x86
procedure RecordClear(var Dest; TypeInfo: pointer);

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

/// 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.Load()
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 array field
// - just a function helper around TDynArray.Load()
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
// - 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()
function DynArraySaveJSON(var Value; TypeInfo: pointer): RawUTF8; overload;

/// serialize a dynamic array content, supplied as raw binary, 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 DynArraySaveJSON(TypeInfo: pointer; const BlobValue: RawByteString): RawUTF8;
  overload;

/// 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): RawUTF8;


/// compare two "array of byte" elements
function SortDynArrayByte(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 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 AnsiString" elements, with no case sensitivity
function SortDynArrayAnsiStringI(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;

{$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;
{$endif}


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

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

/// 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 value - simply return the value ignore Hasher() parameter
function HashInteger(const Elem; Hasher: THasher): cardinal;

/// hash one Cardinal value - simply return the value ignore Hasher() parameter
function HashCardinal(const Elem; Hasher: THasher): cardinal;

/// hash one Int64 value with the suppplied Hasher() function
function HashInt64(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;


const
  /// 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, SortDynArrayByte, SortDynArrayWord, SortDynArrayInteger,
    SortDynArrayCardinal, SortDynArraySingle,
    SortDynArrayInt64, SortDynArrayDouble,
    SortDynArrayInt64, SortDynArrayInt64, SortDynArrayDouble,
    SortDynArrayAnsiString, SortDynArrayAnsiString, SortDynArrayString,
    SortDynArrayUnicodeString, SortDynArrayUnicodeString,
    {$ifndef NOVARIANTS}SortDynArrayVariant,{$endif} nil),
    (nil, SortDynArrayByte, SortDynArrayWord, SortDynArrayInteger,
    SortDynArrayCardinal, SortDynArraySingle,
    SortDynArrayInt64, SortDynArrayDouble,
    SortDynArrayInt64, SortDynArrayInt64, SortDynArrayDouble,
    SortDynArrayAnsiStringI, SortDynArrayAnsiStringI, SortDynArrayStringI,
    SortDynArrayUnicodeStringI, SortDynArrayUnicodeStringI,
    {$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, HashWord, HashInteger,
    HashCardinal, HashCardinal, HashInt64, HashInt64,
    HashInt64, HashInt64, HashInt64,
    HashAnsiString, HashAnsiString,
    {$ifdef UNICODE}HashUnicodeString{$else}HashAnsiString{$endif},
    HashWideString, HashSynUnicode,
    {$ifndef NOVARIANTS}HashVariant,{$endif} nil),
    (nil, HashByte, HashWord, HashInteger,
    HashCardinal, HashCardinal, HashInt64, HashInt64,
    HashInt64, HashInt64, HashInt64,
    HashAnsiStringI, HashAnsiStringI,
    {$ifdef UNICODE}HashUnicodeStringI{$else}HashAnsiStringI{$endif},
    HashWideStringI, HashSynUnicodeI,
    {$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): 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
// - a bit faster than SimpleDynArrayLoadFrom(Source,TypeInfo(TIntegerDynArray),Count)
function IntegerDynArrayLoadFrom(Source: PAnsiChar; var Count: integer): 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;

var
  /// mORMot.pas will registry here its T*ObjArray serialization process
  DynArrayIsObjArray: function(aDynArrayTypeInfo: Pointer): boolean;

  
{ ****************** 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)
  // - default is 64, but can be set to any value (64, 128, 192 and 256 optimized)
  // - 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 Delphi compiler restriction, 256 is the maximum value
  MAX_SQLFIELDS = 64;

  /// 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
  /// handled field/parameter/column types for abstract database access
  // - this will map JSON-compatible low-level database-level access types, not
  // high-level Delphi types as TSQLFieldType defined in mORMot.pas
  // - it does not map either all potential types as defined in DB.pas (which
  // are there for compatibility with old RDBMS, and are not abstract enough)
  // - those types can be mapped to standard SQLite3 generic types, i.e.
  // NULL, INTEGER, REAL, TEXT, BLOB (with the addition of a ftCurrency and
  // ftDate type, for better support of most DB engines)
  // see @http://www.sqlite.org/datatype3.html
  // - the only string type handled here uses UTF-8 encoding (implemented
  // using our RawUTF8 type), for cross-Delphi true Unicode process
  TSQLDBFieldType =
    (ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob);

  /// set of field/parameter/column types for abstract database access
  TSQLDBFieldTypes = set of TSQLDBFieldType;

  /// array of field/parameter/column types for abstract database access
  TSQLDBFieldTypeDynArray = array of TSQLDBFieldType;

  /// array of field/parameter/column types for abstract database access
  // - this array as a fixed size, ready to handle up to MAX_SQLFIELDS items
  TSQLDBFieldTypeArray = array[0..MAX_SQLFIELDS-1] of TSQLDBFieldType;

  /// memory structure used for database values storage
  // - used mainly by SynDB, mORMot, mORMotDB and mORMotSQLite3 units
  // - defines only TSQLDBFieldType data types (similar to those handled by
  // SQLite3, with the addition of ftCurrency and ftDate)
  // - cleaner/lighter dedicated type than TValue or variant/TVarData, strong
  // enough to be marshalled as JSON content
  // - variable-length data (e.g. UTF-8 text or binary BLOB) are never stored
  // within this record, but VText/VBlob will point to an external (temporary)
  // memory buffer
  // - date/time is stored as ISO-8601 text, and currency as double
  TSQLVar = record
    case VType: TSQLDBFieldType of
    ftInt64: (
      VInt64: Int64);
    ftDouble: (
      VDouble: double);
    ftDate: (
      VDateTime: TDateTime);
    ftCurrency: (
      VCurrency: Currency);
    ftUTF8: (
      VText: PUTF8Char);
    ftBlob: (
      VBlob: pointer;
      VBlobLen: Integer)
  end;

  /// dynamic array of database values storage
  TSQLVarDynArray = array of TSQLVar;

  /// used to store bit set for all available fields in a Table
  // - with current MAX_SQLFIELDS value, 256 bits uses 64 bytes of memory
  // - see also IsZero() and IsEqual() functions
  // - you can also use ALL_FIELDS as defined in mORMot.pas
  TSQLFieldBits = set of 0..MAX_SQLFIELDS-1;

  /// used to store a field index in a Table
  // - note that -1 is commonly used for the ID/RowID field so the values should
  // be signed
  // - even if ShortInt (-128..127) may have been enough, we define a 16 bit
  // safe unsigned integer to let the source compile with Delphi 5 
  TSQLFieldIndex = SmallInt; // -32768..32767

  /// used to store field indexes in a Table
  // - same as TSQLFieldBits, but allowing to store the proper order
  TSQLFieldIndexDynArray = array of TSQLFieldIndex;

  /// points to a bit set used for all available fields in a Table
  PSQLFieldBits = ^TSQLFieldBits;

  /// generic parameter types, as recognized by SQLParamContent() and
  // ExtractInlineParameters() functions
  TSQLParamType = (sptUnknown, sptInteger, sptFloat, sptText, sptBlob, sptDateTime);

  /// array of parameter types, as recognized by SQLParamContent() and
  // ExtractInlineParameters() functions
  TSQLParamTypeDynArray = array of TSQLParamType;

  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
  // - note that this list is expected to be sorted by alphabetic order
  // following the TEXT type recognized at parsing
  // - the last item should be ptCustom, for non simple types
  TJSONCustomParserRTTIType = (
    ptArray, ptBoolean, ptByte, ptCardinal, ptCurrency, ptDouble,
    ptInt64, ptInteger, ptRawByteString, ptRawJSON, ptRawUTF8, ptRecord,
    ptSingle, ptString, ptSynUnicode, ptDateTime, ptGUID, ptID, ptTimeLog,
    {$ifndef NOVARIANTS}ptVariant, {$endif}
    ptWideString, ptWord, ptCustom);

  /// how TJSONCustomParser would serialize/unserialize JSON content
  TJSONCustomParserSerializationOption = (
    soReadIgnoreUnknownFields, soWriteHumanReadable,
    soCustomVariantCopiedByReference);

  /// 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
  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);
  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;
    /// unserialize some JSON content into its binary internal representation
    function ReadOneLevel(var P: PUTF8Char; var Data: PByte;
      Options: TJSONCustomParserSerializationOptions): boolean; virtual;
    /// serialize a binary internal representation into JSON content
    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
    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, ktGUID, ktFixedArray, ktStaticArray, ktDynamicArray
    {$ifndef FPC}, ktSet{$endif});

  /// 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);
    /// released used memory
    destructor Destroy; override;
    /// method to write the instance as JSON
    procedure CustomWriter(const aWriter: TTextWriter; const aValue); override;
    /// abstract 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 RTTI name
    constructor Create(const aPropertyName, aCustomTypeName: RawUTF8); overload; override; }
    /// 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;

{/// implement a reference to a unregistered record type
  // - i.e. ptCustom kind of property, not handled by the
  // TTextWriter.RegisterCustomJSONSerializer*() internal list
  TJSONCustomParserCustomRecord = class(TJSONCustomParserCustom)
  protected
    fCustomRecord: TJSONRecordAbstract;
  public
    /// initialize the instance from the given RTTI name
    constructor Create(const aPropertyName, aCustomTypeName: RawUTF8); overload; override;
    /// 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;}

  /// 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 set the option with the instance returned by
    // TTextWriter.RegisterCustomJSONSerializerFromText() method
    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
  // - 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
  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);

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


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

  /// 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
  // - 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
  TTextWriterWriteObjectOption = (
    woHumanReadable, woDontStoreDefault, woFullExpand,
    woStoreClassName, woStorePointer,
    woHumanReadableFullSetsAsStar, woHumanReadableEnumSetAsComment,
    woEnumSetsAsText, woDateTimeWithMagic);
  /// 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;

  /// class of our simple writer to a Stream, specialized for the TEXT format
  TTextWriterClass = class of TTextWriter;

  /// 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
  TTextWriterJSONFormat = (jsonCompact, jsonHumanReadable, jsonUnquotedPropName);

  /// 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: cardinal;
    fStreamIsOwned, fFlushToStreamNoAutoResize: boolean;
    fTotalFileSize: cardinal;
    // internal temporary buffer
    fTempBufSize: Integer;
    fTempBuf: PUTF8Char;
    fHumanReadableLevel: integer;
    fEndOfLineCRLF: boolean;
    fEchoBuf: RawUTF8;
    fEchoStart: integer;
    fEchos: array of TOnTextWriterEcho;
    /// used by WriteObjectAsString/AddDynArrayJSONAsString methods
    fInternalJSONWriter: TTextWriter;
    function GetLength: cardinal;
    procedure SetStream(aStream: TStream);
    function EchoFlush: integer;
  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); 
    /// 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)
    constructor CreateOwnedStream(aBufSize: integer=4096);
    /// 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 will call it to use the TJSONSerializer instead, which
    // is able to serialize any class as JSON
    class procedure SetDefaultJSONClass(aClass: TTextWriterClass);

    /// 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);
    /// 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;
    /// 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 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 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;
    /// append a TTimeLog value, expanded as Iso-8601 encoded text
    procedure AddTimeLog(Value: PInt64);
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    procedure AddDateTime(Value: PDateTime; FirstChar: AnsiChar='T'; QuoteChar: AnsiChar=#0); overload;
    /// append a TDateTime value, expanded as Iso-8601 encoded text
    procedure AddDateTime(const Value: TDateTime); overload;
    /// append an Unsigned Integer Value as a String
    procedure AddU(Value: cardinal);
    /// append a GUID value, encoded as text without any {}
    // - will store e.g. '3F2504E0-4F89-11D3-9A0C-0305E82C3301'
    procedure Add(const guid: TGUID); overload;
    /// append a floating-point Value as a String
    procedure AddDouble(Value: double);
    /// append a floating-point Value as a String
    procedure AddSingle(Value: single);
    /// append a floating-point Value as a String
    procedure Add(Value: Extended; precision: integer); overload;
    /// append a floating-point text buffer
    // - will correct on the fly '.5' -> '0.5' and '-.5' -> '-0.5'
    procedure AddFloatStr(P: PUTF8Char);
    /// append strings or integers with a specified format
    // - % = #37 indicates 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 cardinal values should be type-casted to Int64() (otherwise
    // the integer mapped value will be transmitted, therefore wrongly)
    {$ifdef OLDTEXTWRITERFORMAT}
    // - $ = #36 indicates an integer to be written with 2 digits and a comma
    // - £ = #163 indicates an integer to be written with 4 digits and a comma
    // - µ = #181 indicates an integer to be written with 3 digits without any comma
    // - ¤ = #164 indicates CR+LF chars
    // - CR = #13 indicates CR+LF chars
    // - § = #167 indicates to trim last comma
    // - | = #124 will write the next char e.g. Add('%|$',[10]) will write '10$'
    // - 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); 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
    procedure AddCR;
    /// mark an end of line, ready to be "echoed" to registered listeners
    // - append a CR (#13) char or CR+LF (#13#10) chars to the buffer, depending
    // on the EndOfLineCRLF property value (default is CR, 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 date and time, in a log-friendly format
    // - e.g. append '20110325 19241502 '
    // - this method is very fast, and avoid most calculation or API calls
    procedure AddCurrentLogTime;
    /// 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
    procedure AddString(const Text: RawUTF8);
      {$ifdef HASINLINE}inline;{$endif}
    /// 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);
      {$ifdef HASINLINE}inline;{$endif}
    /// 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)
    procedure AddPropName(const PropName: ShortString);
    /// 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
    procedure AddInstancePointer(Instance: TObject; SepChar: AnsiChar);
    /// 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
    procedure Add(P: PUTF8Char; Escape: TTextWriterKind); overload;
    /// write some #0 ended UTF-8 text, according to the specified format
    procedure Add(P: PUTF8Char; Len: PtrInt; Escape: TTextWriterKind); overload;
    /// write some #0 ended Unicode text as UTF-8, according to the specified format
    procedure AddW(P: PWord; Len: PtrInt; Escape: TTextWriterKind);
      {$ifdef HASINLINE}inline;{$endif}
    /// 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 the any AnsiString type
    // - 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 chars to the buffer
    // - if Len is 0, Len is calculated from zero-ended char
    // - don't escapes chars according to the JSON RFC
    procedure AddNoJSONEscape(P: Pointer; Len: integer=0); overload;
    /// append some chars, quoting all " chars
    // - same algorithm than AddString(QuotedStr()) - without memory allocation
    // - 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; TextLen: integer=0); 
    /// append some chars, escaping all HTML special chars as expected
    // - i.e.   < > & "  as   &lt; &gt; &amp; &quote;
    procedure AddHtmlEscape(Text: PUTF8Char); overload;
    /// append some chars, escaping all HTML special chars as expected
    // - i.e.   < > & "  as   &lt; &gt; &amp; &quote;
    procedure AddHtmlEscape(Text: PUTF8Char; TextLen: integer); overload;
    /// append some chars, escaping all HTML special chars as expected
    // - i.e.   < > & "  as   &lt; &gt; &amp; &quote;
    procedure AddHtmlEscapeString(const Text: string); 
    /// 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 encode it
    // in big-endian order (most-signignifican byte first): use it for display
    // - up to 128 bytes may be converted 
    procedure AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
    /// add the pointer into hexa chars, ready to be displayed
    procedure AddPointer(P: PtrUInt);
    /// 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;
    /// 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); 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 cardinal values should be type-casted to Int64() (otherwise
    // the integer mapped value will be transmitted, therefore wrongly)
    // - 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 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"]'
    procedure AddDynArrayJSON(const aDynArray: TDynArray); overload;
    /// 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; var 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 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
    procedure AddRecordJSON(const Rec; TypeInfo: pointer);
    {$ifndef NOVARIANTS}
    /// append a variant content as JSON number or string
    // - can be converted back to a variant value using VariantLoadJSON()
    // - note that before Delphi 2009, any varString value is expected to be
    // a RawUTF8 instance - which does make sense in the mORMot area
    procedure AddVariantJSON(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
    // - will handle tkClass,tkEnumeration,tkRecord,tkDynArray,tkVariant types
    // - write null for other types
    procedure AddTypedJSON(aTypeInfo: pointer; const aValue); virtual;
    /// 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);
    /// 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; end;'
    // ! '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 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;
    /// 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;
    /// 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;
      aTypeName: RawUTF8='');
    /// 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: cardinal read fTotalFileSize;
    /// the last char appended is canceled
    procedure CancelLastChar;
      {$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: cardinal read GetLength;
    /// if a call to FlushToStream should try to resize the internal memory
    // buffer when it appears undersized
    // - set to FALSE by default, to increase performance, as expected
    // - FlushFinal will set it to TRUE before calling a last FlushToStream
    property FlushToStreamNoAutoResize: boolean
      read fFlushToStreamNoAutoResize write fFlushToStreamNoAutoResize;
    /// define how AddEndOfLine method stores its line feed characters 
    // - by default (FALSE), it will append a CR (#13) char to the buffer
    // - you can set this property to TRUE, so that CR+LF (#13#10) chars will
    // be appended instead
    property EndOfLineCRLF: boolean read fEndOfLineCRLF write fEndOfLineCRLF;
    /// 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;
  end;

  /// simple writer to a Stream, specialized for the JSON format and SQL export
  // - use an internal buffer, faster than string+string
  TJSONWriter = class(TTextWriter)
  protected
    /// used to store output format
    fExpand: boolean;
    /// used to store output format for TSQLRecord.GetJSONValues()
    fWithID: boolean;
    /// used to store field for TSQLRecord.GetJSONValues()
    fFields: TSQLFieldIndexDynArray;
    /// if not Expanded format, contains the Stream position of the first
    // useful Row of data; i.e. ',val11' position in:
    // & { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
    fStartDataPosition: integer;
  public
    /// used internally to store column names and count for AddColumns
    ColNames: TRawUTF8DynArray;
    /// the data will be written to the specified Stream
    // - if no Stream is supplied, a temporary memory stream will be created
    // (it's faster to supply one, e.g. any TSQLRest.TempMemoryStream)
    constructor Create(aStream: TStream; Expand, withID: boolean;
      const Fields: TSQLFieldBits); overload;
    /// the data will be written to the specified Stream
    // - if no Stream is supplied, a temporary memory stream will be created
    // (it's faster to supply one, e.g. any TSQLRest.TempMemoryStream)
    constructor Create(aStream: TStream; Expand, withID: boolean;
      const Fields: TSQLFieldIndexDynArray=nil); overload;
    /// rewind the Stream position and write void JSON object
    procedure CancelAllVoid;
    /// write or init field names for appropriate JSON Expand later use
    // - ColNames[] must have been initialized before calling this procedure
    // - if aKnownRowsCount is not null, a "rowCount":... item will be added
    // to the generated JSON stream (for faster unserialization of huge content)
    procedure AddColumns(aKnownRowsCount: integer=0);
    /// allow to change on the fly an expanded format column layout
    // - by definition, a non expanded format would raise a ESynException
    // - caller should then set ColNames[] and run AddColumns()
    procedure ChangeExpandedFields(aWithID: boolean; const aFields: TSQLFieldIndexDynArray); overload;
    /// end the serialized JSON object
    // - cancel last ','
    // - close the JSON object ']' or ']}'
    // - write non expanded postlog (,"rowcount":...), if needed
    // - flush the internal buffer content
    procedure EndJSONObject(aKnownRowsCount,aRowsCount: integer);
      {$ifdef HASINLINE}inline;{$endif}
    /// the first data row is erased from the content
    // - only works if the associated storage stream is TMemoryStream
    // - expect not Expanded format
    procedure TrimFirstRow;
    /// is set to TRUE in case of Expanded format
    property Expand: boolean read fExpand write fExpand;
    /// is set to TRUE if the ID field must be appended to the resulting JSON
    property WithID: boolean read fWithID;
    /// Read-Only access to the field bits set for each column to be stored
    property Fields: TSQLFieldIndexDynArray read fFields;
    /// if not Expanded format, contains the Stream position of the first
    // useful Row of data; i.e. ',val11' position in:
    // & { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
    property StartDataPosition: integer read fStartDataPosition;
  end;

  /// handle safe storage of any connection properties
  // - would be used by SynDB.pas to serialize TSQLDBConnectionProperties, or
  // by mORMot.pas to serialize TSQLRest instances
  // - the password will be stored as Base64, after a simple encryption
  // - typical content could be:
  // $ {
  // $	"Kind": "TSQLDBSQLite3ConnectionProperties",
  // $	"ServerName": "server",
  // $	"DatabaseName": "",
  // $	"User": "",
  // $	"Password": "PtvlPA=="
  // $ }
  // - the "Kind" value will be used to let the corresponding TSQLRest or
  // TSQLDBConnectionProperties NewInstance*() class methods create the
  // actual instance, from its class name
  TSynConnectionDefinition = class(TSynPersistent)
  protected
    fKind: string;
    fServerName: RawUTF8;
    fDatabaseName: RawUTF8;
    fUser: RawUTF8;
    fPassWord: RawUTF8;
    fKey: cardinal;
    function GetKey: cardinal;
    function GetPassWordPlain: RawUTF8;
    procedure SetPassWordPlain(const Value: RawUTF8);
  public
    /// unserialize the database definition from JSON
    // - as previously serialized with the SaveToJSON method
    // - you can specify a custom Key used for password encryption, if the
    // default value is not safe enough for you
    constructor CreateFromJSON(const JSON: RawUTF8; Key: cardinal=0);
    /// serialize the database definition as JSON
    function SaveToJSON: RawUTF8;
    /// the private key used to cypher the password storage
    property Key: cardinal read GetKey write fKey;
    /// access to the associated unencrypted Password value
    property PasswordPlain: RawUTF8 read GetPassWordPlain write SetPassWordPlain;
  published
    /// the class name implementing the connection or TSQLRest instance
    // - will be used to instantiate the expected class type
    property Kind: string read fKind write fKind;
    /// the associated server name (or file, for SQLite3) to be connected to
    property ServerName: RawUTF8 read fServerName write fServerName;
    /// the associated database name (if any), or additional options
    property DatabaseName: RawUTF8 read fDatabaseName write fDatabaseName;
    /// the associated User Identifier (if any)
    property User: RawUTF8 read fUser write fUser;
    /// the associated Password, e.g. for storage or transmission encryption 
    // - will be persisted encrypted with a private key
    // - use the PassWordPlain property to access to its uncyphered value
    property Password: RawUTF8 read fPassword write fPassword;
  end;

/// 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)
// - won't handle shortstring properties
// - 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;


type
  /// implements a cross-platform enhanced mutex
  // - includes a TryEnter method for older versions of Delphi (e.g. Delphi 6-7)
  // - fix potential CPU cache conflict, as reported by 
  // @http://www.delphitools.info/2011/11/30/fixing-tcriticalsection
  TSynCriticalSection = class(TCriticalSection)
  protected
    PaddingForLock: array[0..11] of Int64;
  public
    {$ifndef DELPHI5OROLDER}
    {$ifndef HASINLINE}
    /// will try to acquire the mutex
    function TryEnter: boolean; 
    {$endif}
    {$endif}
  end;

  /// 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)
  TSynCache = class
  protected
    /// last index in fNameValue.List[] if was added by Find()
    // - contains -1 if no previous immediate call to Find()
    fFindLastAddedIndex: integer;
    /// store Key/Value pairs
    fNameValue: TSynNameValue;
    /// the global size of Values in cache, in bytes (to prevent memory burn)
    fValueSize: cardinal;
    /// the maximum RAM to be used for values, in bytes
    fMaxCacheRamUsed: cardinal;
  public
    /// initialize the internal storage
    // - aMaxCacheRamUsed can set the maximum RAM to be used for values, in bytes
    // (default is 16 MB per cache): cache will be reset when so much value
    // will be reached
    // - by default, key search is done case-insensitively, but you can specify
    // another option here
    constructor Create(aMaxCacheRamUsed: cardinal=16384*1024;
      aCaseSensitive: boolean=false);
    /// find a Key in the cache entries
    // - return '' if nothing found
    // - return the associated Value otherwise, and the associated integer tag
    // if aResultTag address is supplied
    function Find(const aKey: RawUTF8; aResultTag: PPtrInt): RawUTF8;
    /// add a Key and its associated value (and tag) to the cache entries
    // - you MUST always call Find() with the associated Key first
    procedure Add(const aValue: RawUTF8; aTag: PtrInt);
    /// 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
    function Reset: boolean;
    /// number of entries in the cache
    {$ifdef VER220} { circumvent Delphi XE compilation with packages }
    function Count: integer;
    {$else}
    property Count: integer read fNameValue.Count;
    {$endif}
  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;
    fHashValid: boolean;
    fHashed: 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 the hashed property 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;
    procedure IntHashValid;
  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;

  /// 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 Lock/Unlock methods by hand to protect the
  // execution of regular TObjectList methods (like Add/Remove/Count...)
  TObjectListLocked = class(TObjectList)
  protected
    fLock: TRTLCriticalSection;
    PaddingForLock: array[0..9] of Int64; // just like TSynCriticalSection
  public
    /// initialize the list instance
    // - the stored TObject instances will be owned by this TObjectListLocked 
    constructor Create(AOwnsObjects: Boolean=true); reintroduce;
    /// release the list instance (including the locking resource)
    destructor Destroy; override;
    /// lock the list for exclusive access
    procedure Lock;    {$ifdef HASINLINE}inline;{$endif}
    /// release the list for exclusive access
    procedure UnLock;  {$ifdef HASINLINE}inline;{$endif}
  end;

  /// This class is able to emulate a TStringList 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: 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
    // - set aOwnObjects=true to force memory 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, 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): 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); 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;
    /// update Value from an existing Name=Value, then optinally delete the entry
    procedure UpdateValue(const Name: RawUTF8; var Value: RawUTF8; ThenDelete: boolean);
    /// 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
    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 which will use an internal hash table for faster IndexOf()
  // - this is a rather rough implementation: all values are re-hashed after
  // change: but purpose of this class is to allow faster access of a static
  // list of identifiers (e.g. service method names) which are fixed during run
  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
    function IndexOf(const aText: RawUTF8): 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
    function AddObjectIfNotExisting(const aText: RawUTF8; aObject: TObject): PtrInt; override;
  end;

  /// a TRawUTF8List with an internal hash, with locking methods
  // - by default, inherited methods are not protected by the mutex: you have
  // to explicitely call Lock/UnLock to enter or leave the critical section
  TRawUTF8ListHashedLocked = class(TRawUTF8ListHashed)
  protected
    fLock: TRTLCriticalSection;
    PaddingForLock: array[0..4] of Int64; // just like TSynCriticalSection
  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;
    /// lock the list for exclusive access
    procedure Lock;    {$ifdef HASINLINE}inline;{$endif}
    /// release the list for exclusive access
    procedure UnLock;  {$ifdef HASINLINE}inline;{$endif}
    /// 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
    function LockedIndexOf(const aText: RawUTF8): PtrInt; virtual;
  end;

  /// This class is able to emulate a TStringList with our native UTF-8 string
  // type and storing TMethod callbacks
  // - cross-compiler, from Delphi 6 and up, i.e is Unicode Ready for all
  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;

const
  /// convert identified field types into high-level ORM types
  // - as will be implemented in unit mORMot.pas
  SQLDBFIELDTYPE_TO_DELPHITYPE: array[TSQLDBFieldType] of RawUTF8 = (
    '???','???', 'Int64', 'Double', 'Currency', 'TDateTime', 'RawUTF8', 'TSQLRawBlob');

type
  /// handle memory mapping of a file content
  /// used to store and retrieve Words in a sorted array
  TMemoryMap = {$ifndef UNICODE}object{$else}record{$endif}
  private
    fBuf: PAnsiChar;
    fBufSize: cardinal;
    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: cardinal=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: cardinal); 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: cardinal 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
  TRawByteStringStream = class(TStream)
  protected
    fDataString: RawByteString;
    fPosition: Integer;
    procedure SetSize(NewSize: Longint); override;
  public
    constructor Create(const aString: RawByteString=''); overload;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    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: integer); 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: cardinal=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: cardinal=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
  TFileBufferWriter = class
  private
    fPos: integer;
    fBufLen: Integer;
    fStream: TStream;
    fTotalWritten: Int64;
    fInternalStream: boolean;
    fTag: PtrInt;
    fBuf: 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
    constructor Create(const aFileName: TFileName; BufLen: integer=65536); 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;
    /// release internal TStream (after AssignToHandle call)
    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 4 bytes of data at the current position
    procedure Write4(Data: integer); {$ifdef HASINLINE}inline;{$endif}
    /// append 8 bytes of data at the current position
    procedure Write8(const Data8Bytes); {$ifdef HASINLINE}inline;{$endif}
    /// append some UTF-8 encoded text at the current position
    // - will write the string length, then the string content, as expected
    // by the FromVarString() function
    procedure Write(const Text: RawByteString); overload;
    /// append some UTF-8 encoded text at the current position
    // - will write the string length, 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;
    {$endif}
    /// 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 UInt64 values using 64-bit variable length integer encoding
    // - if Offset is TRUE, then it will store the difference between
    // two values using 32-bit variable-length integer encoding (in this case,
    // a fixed-sized record storage is also handled separately)
    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; 
    /// 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) 
  // - 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 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(var 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: cardinal); 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
    function CurrentMemory: 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;


/// 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 cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
// - 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 cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
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 cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
procedure JSONEncodeArrayOfConst(const Values: array of const;
  WithoutBraces: boolean; var result: RawUTF8); 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(JSON,['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 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 PUTF8Char; var Values: TPUtf8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean=false); overload;

type
  /// 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
    Name: PUTF8Char;
    Value: PUTF8Char;
  end;
  /// used e.g. by JSONDecode() overloaded function to returns name/value pairs
  TNameValuePUTF8CharDynArray = array of TNameValuePUTF8Char;

/// 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 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
// - returns a pointer to the next content item in the JSON buffer
function JSONDecode(P: PUTF8Char; const Names: array of PUTF8Char;
  var Values: TPUtf8CharDynArray; 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 on any unexpected end
// - optional wasString is set to true if the JSON value was a JSON "string"
// - null is decoded as nil, with wasString=false
// - true/false boolean values are returned as 'true'/'false', with wasString=false
// - '"strings"' are decoded as 'strings', with wasString=true, properly JSON
// unescaped (e.g. any \u0123 pattern would be converted into UTF-8 content)
// - any integer value is left as its ascii representation, with wasString=true
// - works for both field names or values (e.g. '"FieldName":' or 'Value,')
// - EndOfObject (if not nil) is set to the JSON value char (',' ':' or '}' e.g.)
function GetJSONField(P: PUTF8Char; out PDest: PUTF8Char;
  wasString: PBoolean=nil; EndOfObject: PUTF8Char=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): PUTF8Char;

/// 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
// - PDest points to the next field to be decoded, or nil on any unexpected end
// - 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 '}')
function GetJSONFieldOrObjectOrArray(var P: PUTF8Char; wasString: PBoolean=nil;
  EndOfObject: PUTF8Char=nil; HandleValuesAsObjectOrArray: Boolean=false): 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 '}')
function GetJSONItemAsRawJSON(var P: PUTF8Char; EndOfObject: PAnsiChar=nil): RawJSON;

/// 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. IsString('0')=false, IsString('abc')=true, IsString('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 '[' either '{' with default EndChar=#0
// - or you can 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=#0): PUTF8Char; 

/// reach the position of the next JSON object of JSON array
// - first char is expected to be either '[' either '{'
// - 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
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
// - 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 in-head
function JSONArrayCount(P,PMax: PUTF8Char): integer; overload;

/// compute the number of fields in a JSON object
// - this will handle any kind of objects, including those with nested
// JSON objects or arrays
function JSONObjectPropCount(P: PUTF8Char): integer;

/// 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 (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}ptInt64{$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];


{ ************ filtering and validation classes and functions }

/// return TRUE if the supplied content is a valid email address
// - follows RFC 822, to validate local-part@domain email format
function IsValidEmail(P: PUTF8Char): boolean;

/// return TRUE if the supplied content is a valid IP v4 address
function IsValidIP4Address(P: PUTF8Char): boolean;

{/ return TRUE if the supplied content matchs to a grep-like pattern
  - ?	   	Matches any single characer
	- *	   	Matches any contiguous characters
	- [abc]  	Matches a or b or c at that position
	- [^abc]	Matches anything but a or b or c at that position
	- [!abc]	Matches anything but a or b or c at that position
	- [a-e]  	Matches a through e at that position
  - [abcx-z]  Matches a or b or c or x or y or or z, as does [a-cx-z]
  - 'ma?ch.*'	would match match.exe, mavch.dat, march.on, etc..
  - 'this [e-n]s a [!zy]est' would match 'this is a test', but would not
    match 'this as a test' nor 'this is a zest'
  - initial C version by Kevin Boylan, first Delphi port by Sergey Seroukhov }
function IsMatch(const Pattern, Text: RawUTF8; CaseInsensitive: boolean=false): boolean;


type
  TSynFilterOrValidate = class;

  TSynFilterOrValidateObjArray = array of TSynFilterOrValidate;
  TSynFilterOrValidateObjArrayArray = array of TSynFilterOrValidateObjArray;

  /// will define a filter or a validation process to be applied to
  // a database Record content (typicaly a TSQLRecord)
  // - the optional associated parameters are to be supplied JSON-encoded
  TSynFilterOrValidate = class
  protected
    fParameters: RawUTF8;
    /// children must override this method in order to parse the JSON-encoded
    // parameters, and store it in protected field values
    // - the RawUTF8 param is not set as const, since it will probably be
    // decoded via JSONDecode(), so a local copy is needed
    procedure SetParameters(Value: RawUTF8); virtual;
  public
    /// add the filter or validation process to a list, checking if not present
    // - if an instance with the same class type and parameters is already
    // registered, will call aInstance.Free and return the exising instance
    // - if there is no similar instance, will add it to the list and return it
    function AddOnce(var aObjArray: TSynFilterOrValidateObjArray;
      aFreeIfAlreadyThere: boolean=true): TSynFilterOrValidate;
  public
    /// initialize the filter or validation instance
    // - most of the time, optional parameters may be specified as JSON,
    // possibly with the extended MongoDB syntax
    constructor Create(const aParameters: RawUTF8=''); overload; virtual;
    /// initialize the filter or validation instance
    /// - this overloaded constructor will allow to easily set the parameters
    constructor CreateUTF8(const Format: RawUTF8; const Args, Params: array of const); overload; 
    /// the optional associated parameters, supplied as JSON-encoded
    property Parameters: RawUTF8 read fParameters write SetParameters;
  end;

  /// will define a validation to be applied to a Record (typicaly a TSQLRecord)
  // field content
  // - a typical usage is to validate an email or IP adress e.g.
  // - the optional associated parameters are to be supplied JSON-encoded
  TSynValidate = class(TSynFilterOrValidate)
  public
    /// perform the validation action to the specified value
    // - the value is expected by be UTF-8 text, as generated by
    // TPropInfo.GetValue e.g.
    // - if the validation failed, must return FALSE and put some message in
    // ErrorMsg (translated into the current language: you could e.g. use
    // a resourcestring and a SysUtils.Format() call for automatic translation
    // via the mORMoti18n unit - you can leave ErrorMsg='' to trigger a
    // generic error message from clas name ('"Validate email" rule failed'
    // for TSynValidateEmail class e.g.)
    // - if the validation passed, will return TRUE
    function Process(FieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string): boolean;
      virtual; abstract;
  end;

  /// points to a TSynValidate variable
  // - used e.g. as optional parameter to TSQLRecord.Validate/FilterAndValidate
  PSynValidate = ^TSynValidate;

  /// IP v4 address validation to be applied to a Record field content
  // (typicaly a TSQLRecord)
  // - this versions expect no parameter
  TSynValidateIPAddress = class(TSynValidate)
  protected
  public
    /// perform the IP Address validation action to the specified value
    function Process(aFieldIndex: integer; const Value: RawUTF8;
      var ErrorMsg: string): boolean; override;
  end;

  /// IP address validation to be applied to a Record field content
  // (typicaly a TSQLRecord)
  // - optional JSON encoded parameters are "AllowedTLD" or "ForbiddenTLD",
  // expecting a CSV lis of Top-Level-Domain (TLD) names, e.g.
  // $ '{"AllowedTLD":"com,org,net","ForbiddenTLD":"fr"}'
  // $ '{AnyTLD:true,ForbiddenDomains:"mailinator.com,yopmail.com"}'
  // - this will process a validation according to RFC 822 (calling the
  // IsValidEmail() function) then will check for the TLD to be in one of
  // the Top-Level domains ('.com' and such) or a two-char country, and
  // then will check the TLD according to AllowedTLD and ForbiddenTLD
  TSynValidateEmail = class(TSynValidate)
  private
    fAllowedTLD: RawUTF8;
    fForbiddenTLD: RawUTF8;
    fForbiddenDomains: RawUTF8;
    fAnyTLD: boolean;
  protected
    /// decode all published properties from their JSON representation
    procedure SetParameters(Value: RawUTF8); override;
  public
    /// perform the Email Address validation action to the specified value
    // - call IsValidEmail() function and check for the supplied TLD
    function Process(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string): boolean; override;
    /// allow any TLD to be allowed, even if not a generic TLD (.com,.net ...)
    // - this may be mandatory since already over 1,300 new gTLD names or
    // "strings" could become available in the next few years: there is a
    // growing list of new gTLDs available at
    // @http://newgtlds.icann.org/en/program-status/delegated-strings
    // - the only restriction is that it should be ascii characters
    property AnyTLD: boolean read fAnyTLD write fAnyTLD;
    /// a CSV list of allowed TLD
    // - if accessed directly, should be set as lower case values
    // - e.g. 'com,org,net'
    property AllowedTLD: RawUTF8 read fAllowedTLD write fAllowedTLD;
    /// a CSV list of forbidden TLD
    // - if accessed directly, should be set as lower case values
    // - e.g. 'fr'
    property ForbiddenTLD: RawUTF8 read fForbiddenTLD write fForbiddenTLD;
    /// a CSV list of forbidden domain names
    // - if accessed directly, should be set as lower case values
    // - not only the TLD, but whole domains like 'cracks.ru,hotmail.com' or such
    property ForbiddenDomains: RawUTF8 read fForbiddenDomains write fForbiddenDomains;
  end;

  /// grep-like case-sensitive pattern validation of a Record field content
  // - parameter is NOT JSON encoded, but is some basic grep-like pattern
  // - ?	   	Matches any single characer
  // - *	   	Matches any contiguous characters
  // - [abc]  Matches a or b or c at that position
  // - [^abc]	Matches anything but a or b or c at that position
  // - [!abc]	Matches anything but a or b or c at that position
  // - [a-e]  Matches a through e at that position
  // - [abcx-z] Matches a or b or c or x or y or or z, as does [a-cx-z]
  // - 'ma?ch.*'	would match match.exe, mavch.dat, march.on, etc..
  // - 'this [e-n]s a [!zy]est' would match 'this is a test', but would not
  //   match 'this as a test' nor 'this is a zest'
  // - pattern check IS case sensitive (TSynValidatePatternI is not)
  // - this class is not as complete as PCRE regex for example,
  //   but code overhead is very small
  TSynValidatePattern = class(TSynValidate)
  public
    /// perform the pattern validation to the specified value
    // - pattern can be e.g. '[0-9][0-9]:[0-9][0-9]:[0-9][0-9]'
    // - this method will implement both TSynValidatePattern and
    // TSynValidatePatternI, checking the current class
    function Process(aFieldIndex: integer; const Value: RawUTF8;
      var ErrorMsg: string): boolean; override;
  end;

  {/ grep-like case-insensitive pattern validation of a Record field content
    (typicaly a TSQLRecord)
    - parameter is NOT JSON encoded, but is some basic grep-like pattern
    - same as TSynValidatePattern, but is NOT case sensitive }
  TSynValidatePatternI = class(TSynValidatePattern);

  /// text validation to ensure that to any text field would not be ''
  TSynValidateNonVoidText = class(TSynValidate)
  public
    /// perform the non void text validation action to the specified value
    function Process(aFieldIndex: integer; const Value: RawUTF8;
      var ErrorMsg: string): boolean; override;
  end;

  TSynValidateTextProps = array[0..15] of cardinal;

{$M+} // to have existing RTTI for published properties
  /// text validation to be applied to any Record field content
  // - default MinLength value is 1, MaxLength is maxInt: so a blank
  // TSynValidateText.Create('') is the same as TSynValidateNonVoidText
  // - MinAlphaCount, MinDigitCount, MinPunctCount, MinLowerCount and
  // MinUpperCount allow you to specify the minimal count of respectively
  // alphabetical [a-zA-Z], digit [0-9], punctuation [_!;.,/:?%$="#@(){}+-*],
  // lower case or upper case characters
  // - expects optional JSON parameters of the allowed text length range as
  // $ '{"MinLength":5,"MaxLength":10,"MinAlphaCount":1,"MinDigitCount":1,
  // $ "MinPunctCount":1,"MinLowerCount":1,"MinUpperCount":1}
  TSynValidateText = class(TSynValidate)
  private
    /// used to store all associated validation properties by index
    fProps: TSynValidateTextProps;
    fUTF8Length: boolean;
  protected
    /// use sInvalidTextChar resourcestring to create a translated error message
    procedure SetErrorMsg(fPropsIndex, InvalidTextIndex, MainIndex: integer;
      var result: string);
    /// decode "MinLength", "MaxLength", and other parameters into fProps[]
    procedure SetParameters(Value: RawUTF8); override;
  public
    /// perform the text length validation action to the specified value
    function Process(aFieldIndex: integer; const Value: RawUTF8;
      var ErrorMsg: string): boolean; override;
  published
    /// Minimal length value allowed for the text content
    // - the length is calculated with UTF-16 Unicode codepoints, unless
    // UTF8Length has been set to TRUE so that the UTF-8 byte count is checked
    // - default is 1, i.e. a void text will not pass the validation
    property MinLength: cardinal read fProps[0] write fProps[0];
    /// Maximal length value allowed for the text content
    // - the length is calculated with UTF-16 Unicode codepoints, unless
    // UTF8Length has been set to TRUE so that the UTF-8 byte count is checked
    // - default is maxInt, i.e. no maximum length is set
    property MaxLength: cardinal read fProps[1] write fProps[1];
    /// Minimal alphabetical character [a-zA-Z] count
    // - default is 0, i.e. no minimum set
    property MinAlphaCount: cardinal read fProps[2] write fProps[2];
    /// Maximal alphabetical character [a-zA-Z] count
    // - default is maxInt, i.e. no Maximum set
    property MaxAlphaCount: cardinal read fProps[10] write fProps[10];
    /// Minimal digit character [0-9] count
    // - default is 0, i.e. no minimum set
    property MinDigitCount: cardinal read fProps[3] write fProps[3];
    /// Maximal digit character [0-9] count
    // - default is maxInt, i.e. no Maximum set
    property MaxDigitCount: cardinal read fProps[11] write fProps[11];
    /// Minimal punctuation sign [_!;.,/:?%$="#@(){}+-*] count
    // - default is 0, i.e. no minimum set
    property MinPunctCount: cardinal read fProps[4] write fProps[4];
    /// Maximal punctuation sign [_!;.,/:?%$="#@(){}+-*] count
    // - default is maxInt, i.e. no Maximum set
    property MaxPunctCount: cardinal read fProps[12] write fProps[12];
    /// Minimal alphabetical lower case character [a-z] count
    // - default is 0, i.e. no minimum set
    property MinLowerCount: cardinal read fProps[5] write fProps[5];
    /// Maximal alphabetical lower case character [a-z] count
    // - default is maxInt, i.e. no Maximum set
    property MaxLowerCount: cardinal read fProps[13] write fProps[13];
    /// Minimal alphabetical upper case character [A-Z] count
    // - default is 0, i.e. no minimum set
    property MinUpperCount: cardinal read fProps[6] write fProps[6];
    /// Maximal alphabetical upper case character [A-Z] count
    // - default is maxInt, i.e. no Maximum set
    property MaxUpperCount: cardinal read fProps[14] write fProps[14];
    /// Minimal space count inside the value text
    // - default is 0, i.e. any space number allowed
    property MinSpaceCount: cardinal read fProps[7] write fProps[7];
    /// Maximal space count inside the value text
    // - default is maxInt, i.e. any space number allowed
    property MaxSpaceCount: cardinal read fProps[15] write fProps[15];
    /// Maximal space count allowed on the Left side
    // - default is maxInt, i.e. any Left space allowed
    property MaxLeftTrimCount: cardinal read fProps[8] write fProps[8];
    /// Maximal space count allowed on the Right side
    // - default is maxInt, i.e. any Right space allowed
    property MaxRightTrimCount: cardinal read fProps[9] write fProps[9];
    /// defines if lengths parameters expects UTF-8 or UTF-16 codepoints number
    // - with default FALSE, the length is calculated with UTF-16 Unicode
    // codepoints - MaxLength may not match the UCS4 glyphs number, in case of
    // UTF-16 surrogates
    // - you can set this property to TRUE so that the UTF-8 byte count would
    // be used for truncation againts the MaxLength parameter
    property UTF8Length: boolean read fUTF8Length write fUTF8Length;
  end;
{$M-}

  /// strong password validation for a Record field content (typicaly a TSQLRecord)
  // - the following parameters are set by default to
  // $ '{"MinLength":5,"MaxLength":20,"MinAlphaCount":1,"MinDigitCount":1,
  // $ "MinPunctCount":1,"MinLowerCount":1,"MinUpperCount":1,"MaxSpaceCount":0}'
  // - you can specify some JSON encoded parameters to change this default
  // values, which will validate the text field only if it contains from 5 to 10
  // characters, with at least one digit, one upper case letter, one lower case
  // letter, and one ponctuation sign, with no space allowed inside
  TSynValidatePassWord = class(TSynValidateText)
  protected
    /// set password specific parameters
    procedure SetParameters(Value: RawUTF8); override;
  end;

  /// will define a filter to be applied to a Record field content (typicaly
  // a TSQLRecord)
  // - a typical usage is to convert to lower or upper case, or
  // trim any time or date value in a TDateTime field
  // - the optional associated parameters are to be supplied JSON-encoded
  TSynFilter = class(TSynFilterOrValidate)
  protected
  public
    /// perform the filtering action to the specified value
    // - the value is converted into UTF-8 text, as expected by
    // TPropInfo.GetValue / TPropInfo.SetValue e.g.
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); virtual; abstract;
  end;

  /// class-reference type (metaclass) of a record filter 
  TSynFilterClass = class of TSynFilter;

  /// a custom filter which will convert the value into Upper Case characters
  // - UpperCase conversion is made for ASCII-7 only, i.e. 'a'..'z' characters
  // - this version expects no parameter
  TSynFilterUpperCase = class(TSynFilter)
  public
    /// perform the case conversion to the specified value
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); override;
  end;

  /// a custom filter which will convert the value into Upper Case characters
  // - UpperCase conversion is made for all latin characters in the WinAnsi
  // code page only, e.g. 'e' acute will be converted to 'E'
  // - this version expects no parameter
  TSynFilterUpperCaseU = class(TSynFilter)
  public
    /// perform the case conversion to the specified value
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); override;
  end;

  /// a custom filter which will convert the value into Lower Case characters
  // - LowerCase conversion is made for ASCII-7 only, i.e. 'A'..'Z' characters
  // - this version expects no parameter
  TSynFilterLowerCase = class(TSynFilter)
  public
    /// perform the case conversion to the specified value
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); override;
  end;

  /// a custom filter which will convert the value into Lower Case characters
  // - LowerCase conversion is made for all latin characters in the WinAnsi
  // code page only, e.g. 'E' acute will be converted to 'e'
  // - this version expects no parameter
  TSynFilterLowerCaseU = class(TSynFilter)
  public
    /// perform the case conversion to the specified value
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); override;
  end;

  /// a custom filter which will trim any space character left or right to
  // the value
  // - this versions expect no parameter
  TSynFilterTrim = class(TSynFilter)
  public
    /// perform the space triming conversion to the specified value
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); override;
  end;

  /// a custom filter which will truncate a text above a given maximum length
  // - expects optional JSON parameters of the allowed text length range as
  // $ '{MaxLength":10}
  TSynFilterTruncate = class(TSynFilter)
  protected
    fMaxLength: cardinal;
    fUTF8Length: boolean;
    /// decode the MaxLength: and UTF8Length: parameters
    procedure SetParameters(Value: RawUTF8); override;
  public
    /// perform the length truncation of the specified value
    procedure Process(aFieldIndex: integer; var Value: RawUTF8); override;
    /// Maximal length value allowed for the text content
    // - the length is calculated with UTF-16 Unicode codepoints, unless
    // UTF8Length has been set to TRUE so that the UTF-8 byte count is checked
    // - default is 0, i.e. no maximum length is forced
    property MaxLength: cardinal read fMaxLength write fMaxLength;
    /// defines if MaxLength is stored as UTF-8 or UTF-16 codepoints number
    // - with default FALSE, the length is calculated with UTF-16 Unicode
    // codepoints - MaxLength may not match the UCS4 glyphs number, in case of
    // UTF-16 surrogates
    // - you can set this property to TRUE so that the UTF-8 byte count would
    // be used for truncation againts the MaxLength parameter
    property UTF8Length: boolean read fUTF8Length write fUTF8Length;
  end;


{ ************ some other common types and conversion routines }

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;
    /// 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)
  public
    /// constructor which will use FormatUTF8() instead of Format()
    // - expect % as delimitor, 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 the supplied variant
    constructor CreateUTF8(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}
  published
    property Message;
  end;
  {$M-}

  /// exception raised by all TSynTable related code
  ETableDataException = class(ESynException);

  /// exception class associated to TDocVariant JSON/BSON document
  EDocVariant = 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;
  {$ifdef HASINLINE}inline;{$endif}

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

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

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
  ConvertHexToBin: array[byte] of byte;

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

/// 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 binary data into hexa chars
function BinToHex(const Bin: RawByteString): 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);

/// 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 Cardinal value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
function CardinalToHex(aCardinal: Cardinal): RawUTF8;

/// fast conversion from a Int64 value into hexa chars, ready to be displayed
// - use internally BinToHexDisplay()
function Int64ToHex(aInt64: Int64): RawUTF8;

/// fast conversion from hexa chars into a pointer
function HexDisplayToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: integer): boolean;

/// fast conversion from hexa chars into a cardinal
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 binary data into Base64 encoded text
function BinToBase64(const s: RawByteString): RawByteString; overload;

/// fast conversion from binary data into Base64 encoded text
function BinToBase64(Bin: PAnsiChar; BinBytes: integer): RawByteString; overload;

/// fast conversion from binary data into Base64-like URI-compatible encoded text
// - will trim any right-sided '=' unsignificant characters, and replace
// '+' or '/' by '_' or '-'
function BinToBase64URI(Bin: PAnsiChar; BinBytes: integer): RawByteString;

/// conversion from any Base64 encoded value into URI-compatible encoded text
// - will trim any right-sided '=' unsignificant characters, and replace
// '+' or '/' by '_' or '-'
procedure Base64ToURI(var base64: RawByteString);

/// conversion from URI-compatible encoded text into its original Base64 value
// - will add any right-sided '=' unsignificant characters, and replace back
// '_' or '-' by '+' or '/' 
procedure Base64FromURI(var base64: RawByteString);

/// fast conversion from binary data into Base64 encoded text
// with JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64WithMagic(const s: RawByteString): RawByteString; overload;

/// fast conversion from binary data into Base64 encoded text
// with JSON_BASE64_MAGIC prefix (UTF-8 encoded \uFFF0 special code)
function BinToBase64WithMagic(Data: pointer; DataLen: integer): RawByteString; overload;

/// fast conversion from Base64 encoded text into binary data
function Base64ToBin(const s: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast conversion from Base64 encoded text into binary data
function Base64ToBin(sp: PAnsiChar; len: PtrInt): RawByteString; 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 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
function Base64ToBinLength(sp: PAnsiChar; len: PtrInt): PtrInt;

/// direct decoding of a Base64 encoded buffer
procedure Base64Decode(sp,rp: PAnsiChar; len: PtrInt);

/// revert the value as encoded by TTextWriter.AddInt18ToChars3() method
function Chars3ToInt18(P: pointer): cardinal;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a date to a ISO-8601 string format for SQL '?' inlined parameters
// - will return the date encoded as '\uFFF1YYYY-MM-DD' - therefore
// ':("\uFFF12012-05-04"):' pattern will be recognized as a sftDateTime
// inline parameter in  SQLParamContent() / ExtractInlineParameters() functions
// (JSON_SQLDATE_MAGIC will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum=?',[DateToSQL(EncodeDate(2012,5,4))]);
function DateToSQL(Date: TDateTime): RawUTF8; overload;

/// convert a date to a ISO-8601 string format for SQL '?' inlined parameters
// - will return the date encoded as '\uFFF1YYYY-MM-DD' - therefore
// ':("\uFFF12012-05-04"):' pattern will be recognized as a sftDateTime
// inline parameter in  SQLParamContent() / ExtractInlineParameters() functions
// (JSON_SQLDATE_MAGIC will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum=?',[DateToSQL(2012,5,4)]);
function DateToSQL(Year,Month,Day: cardinal): RawUTF8; overload;

/// convert a date/time to a ISO-8601 string format for SQL '?' inlined parameters
// - if DT=0, returns ''
// - if DT contains only a date, returns the date encoded as '\uFFF1YYYY-MM-DD'
// - if DT contains only a time, returns the time encoded as '\uFFF1Thh:mm:ss'
// - otherwise, returns the ISO-8601 date and time encoded as '\uFFF1YYYY-MM-DDThh:mm:ss'
// (JSON_SQLDATE_MAGIC will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum<=?',[DateTimeToSQL(Now)]);
// - see TimeLogToSQL() if you are using TTimeLog/TModTime/TCreateTime values
function DateTimeToSQL(DT: TDateTime): RawUTF8;

/// decode a SQL '?' inlined parameter (i.e. with JSON_SQLDATE_MAGIC prefix)
// - as generated by DateToSQL/DateTimeToSQL/TimeLogToSQL functions  
function SQLToDateTime(const ParamValueWithMagic: RawUTF8): TDateTime;

/// guess the content type of an UTF-8 SQL value, in :(....): format
// - will be used e.g. by ExtractInlineParameters() to un-inline a SQL statement
// - sftInteger is returned for an INTEGER value, e.g. :(1234):
// - sftFloat is returned for any floating point value (i.e. some digits
// separated by a '.' character), e.g. :(12.34): or :(12E-34):
// - sftUTF8Text is returned for :("text"): or :('text'):, with double quoting
// inside the value
// - sftBlob will be recognized from the ':("\uFFF0base64encodedbinary"):'
// pattern, and return raw binary (for direct blob parameter assignment)
// - sftDateTime will be recognized from ':(\uFFF1"2012-05-04"):' pattern,
// i.e. JSON_SQLDATE_MAGIC-prefixed string as returned by DateToSQL() or
// DateTimeToSQL() functions
// - sftUnknown is returned on invalid content, or if wasNull is set to TRUE
// - if ParamValue is not nil, the pointing RawUTF8 string is set with the
// value inside :(...): without double quoting in case of sftUTF8Text
// - wasNull is set to TRUE if P was ':(null):' and ParamType is sftUnknwown
function SQLParamContent(P: PUTF8Char; out ParamType: TSQLParamType; out ParamValue: RawUTF8;
  out wasNull: boolean): PUTF8Char;

/// this function will extract inlined :(1234): parameters into Types[]/Values[]
// - will return the generic SQL statement with ? instead of :(1234):
// - call internaly SQLParamContent() function for inline parameters decoding
// - will set maxParam=0 in case of no inlined parameters
// - recognized types are sptInteger, sptFloat, sptDateTime ('\uFFF1...'),
// sptUTF8Text and sptBlob ('\uFFF0...')
// - sptUnknown is returned on invalid content
function ExtractInlineParameters(const SQL: RawUTF8;
  var Types: TSQLParamTypeDynArray; var Values: TRawUTF8DynArray;
  var maxParam: integer; var Nulls: TSQLFieldBits): RawUTF8;


/// add the 4 digits of integer Y to P^
procedure YearToPChar(Y: Word; P: PUTF8Char);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

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

// our custom hash function, specialized for Text comparaison
// - has less colision than Adler32 for short strings
// - is faster than CRC32 or Adler32, since use DQWord (128 bytes) aligned read
// - uses RawByteString for binary content hashing, thatever the codepage is
function Hash32(const Text: RawByteString): cardinal; overload;
  {$ifdef HASINLINE}inline;{$endif}

// our custom hash function, specialized for Text comparaison
// - has less colision than Adler32 for short strings
// - is faster than CRC32 or Adler32, since use DQWord (128 bytes) aligned read:
// Hash32() is 2.5 GB/s, kr32() 0.9 GB/s, crc32c() 1.7 GB/s or 3.7 GB/s (SSE4.2)
// - overloaded version for direct binary content hashing
function Hash32(Data: pointer; Len: integer): cardinal; overload;

/// 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() 3.7 GB/s
function kr32(crc: cardinal; buf: PAnsiChar; len: cardinal): 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. to implement a bloom filter)
function fnv32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

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
  crc32ctab: array[0..{$ifdef PUREPASCAL}3{$else}7{$endif},byte] of cardinal;

/// 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 3.7 GB/s
function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;

{$ifdef NOTPUREPASCALNORCPU64DELPHI}
var
  /// the available CPU features, as recognized at program startup
  CpuFeatures: set of
   ( { 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, cfIA_64, cfPBE,
   { in ECX }
   cfSSE3, cf_c1, cf_c2, cfMON, cfDS_CPL, cf_c5, cf_c6, cfEIST,
   cfTM2, cfSSSE3, cfCID, cfSSE5, cf_c12, cfCX16, cfxTPR, cf_c15,
   cf_c16, cf_c17, cf_c18, cfSSE41, cfSSE42, cf_c21, cf_c22, cfPOPCNT,
   cf_c24, cfAESNI, cf_c26, cf_c27, cfAVX, cf_c29, cf_c30, cf_c31);

/// 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 (checked with SupportSSE42)
// - result is not compatible with zlib's crc32() - not the same polynom
// - crc32cfast() is 1.7 GB/s, crc32csse42() is 3.7 GB/s
function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$endif}

/// naive symmetric encryption scheme using a 32 bit key
// - fast, but not very secure
procedure SymmetricEncrypt(key: cardinal; var data: RawByteString);

var
  /// compute CRC32C checksum on the supplied buffer
  // - this variable will use the fastest mean available, e.g. SSE 4.2
  // - you should use this function instead of crc32cfast() nor crc32csse42()
  crc32c: THasher;

/// 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()
  // - is set to crc32c() function above
  // - should be set to faster and more accurate crc32() function if available
  // (this is what mORMot.pas unit does in its initialization block) 
  DefaultHasher: THasher;

/// retrieve a particular bit status from a bit array
function GetBit(const Bits; aIndex: PtrInt): boolean;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// set a particular bit into a bit array
procedure SetBit(var Bits; aIndex: PtrInt);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// unset/clear a particular bit into a bit array
procedure UnSetBit(var Bits; aIndex: PtrInt);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$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 cardinal
function GetAllBits(Bits: Cardinal; BitCount: Integer): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve a particular bit status from a Int64 bit array (max aIndex is 63)
function GetBit64(const Bits; aIndex: PtrInt): boolean;
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// set a particular bit into a Int64 bit array (max aIndex is 63)
procedure SetBit64(var Bits: Int64; aIndex: PtrInt);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// unset/clear a particular bit into a Int64 bit array (max aIndex is 63)
procedure UnSetBit64(var Bits: Int64; aIndex: PtrInt);
  {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}

/// returns TRUE if all bytes equal zero
function IsZero(P: pointer; Length: integer): boolean; overload;

/// returns TRUE if no bit inside this TSQLFieldBits is set
// - is optimized for 64, 128, 192 and 256 max bits count (i.e. MAX_SQLFIELDS)
// - will work also with any other value
function IsZero(const Fields: TSQLFieldBits): boolean; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// fast comparison of two TSQLFieldBits values
function IsEqual(const A,B: TSQLFieldBits): boolean;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TSQLFieldBits set of bits into an array of integers
procedure FieldBitsToIndex(const Fields: TSQLFieldBits;
  var Index: TSQLFieldIndexDynArray; MaxLength: integer=MAX_SQLFIELDS;
  IndexStart: integer=0); overload;

/// convert a TSQLFieldBits set of bits into an array of integers
function FieldBitsToIndex(const Fields: TSQLFieldBits;
  MaxLength: integer=MAX_SQLFIELDS): TSQLFieldIndexDynArray; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// add a field index to an array of field indexes
// - returns the index in Indexes[] of the newly appended Field value
function AddFieldIndex(var Indexes: TSQLFieldIndexDynArray; Field: integer): integer;

/// convert an array of field indexes into a TSQLFieldBits set of bits
procedure FieldIndexToBits(const Index: TSQLFieldIndexDynArray; var Fields: TSQLFieldBits); overload;

// search a field index in an array of field indexes
// - returns the index in Indexes[] of the given Field value, -1 if not found
function SearchFieldIndex(var Indexes: TSQLFieldIndexDynArray; Field: integer): integer;

/// convert an array of field indexes into a TSQLFieldBits set of bits
function FieldIndexToBits(const Index: TSQLFieldIndexDynArray): TSQLFieldBits; overload;
  {$ifdef HASINLINE}inline;{$endif}

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

type
  TSynBackgroundThreadAbstract = class;
  TSynBackgroundThreadEvent = class;

  /// idle method called by TSynBackgroundThreadAbstract in the caller thread
  // during remote blocking process in a background thread
  // - typical use is to run Application.ProcessMessages, e.g. for
  // TSQLRestClientURI.URI() to provide a responsive UI even in case of slow
  // blocking remote access
  // - provide the time elapsed (in milliseconds) from the request start (can be
  // used e.g. to popup a temporary message to wait)
  // - is call once with ElapsedMS=0 at request start
  // - is call once with ElapsedMS=-1 at request ending
  // - see TLoginForm.OnIdleProcess and OnIdleProcessForm in mORMotUILogin.pas
  TOnIdleSynBackgroundThread = procedure(Sender: TSynBackgroundThreadAbstract;
    ElapsedMS: Integer) of object;

  /// state machine status of the TSynBackgroundThreadAbstract process
  TSynBackgroundThreadProcessStep = (
    flagIdle, flagStarted, flagFinished, flagDestroying);

  /// state machine statuses of the TSynBackgroundThreadAbstract process
  TSynBackgroundThreadProcessSteps = set of TSynBackgroundThreadProcessStep;

  {$ifndef LVCL}
  /// event prototype used e.g. by TSynBackgroundThreadAbstract callbacks
  // - a similar signature is defined in SynCrtSock and LVCL.Classes
  TNotifyThreadEvent = procedure(Sender: TThread) of object;
  {$endif}

  /// abstract TThread able to run a method in its own execution content
  // - typical use is a background thread for processing data or remote access,
  // while the UI will be still responsive by running OnIdle event in loop: see
  // e.g. how TSQLRestClientURI.OnIdle handle this in mORMot.pas unit
  // - you should not use this class directly, but inherit from it and override
  // the Process method, or use either TSynBackgroundThreadEvent /
  // TSynBackgroundThreadMethod and provide a much more convenient callback
  TSynBackgroundThreadAbstract = class(TThread)
  protected
    fPendingProcessLock: TRTLCriticalSection;
    fPendingProcessFlag: TSynBackgroundThreadProcessStep;
    fProcessEvent: TEvent;
    fCallerEvent: TEvent;
    fParam: pointer;
    fCallerThreadID: TThreadID;
    fBackgroundException: Exception;
    fOnIdle: TOnIdleSynBackgroundThread;
    fOnBeforeExecute: TNotifyThreadEvent;
    fOnAfterExecute: TNotifyThreadEvent;
    fOnBeforeProcess: TNotifyThreadEvent;
    fOnAfterProcess: TNotifyThreadEvent;
    fThreadName: RawUTF8;
    function GetOnIdleBackgroundThreadActive: boolean;
    /// where the main process takes place
    procedure Execute; override;
    /// called by Execute method when fProcessParams<>nil and fEvent is notified
    procedure Process; virtual; abstract;
    function GetPendingProcess: TSynBackgroundThreadProcessStep;
    procedure SetPendingProcess(State: TSynBackgroundThreadProcessStep);
  public
    /// initialize the thread
    // - if aOnIdle is not set (i.e. equals nil), it will simply wait for
    // the background process to finish until RunAndWait() will return
    constructor Create(aOnIdle: TOnIdleSynBackgroundThread;
      const aThreadName: RawUTF8); reintroduce;
    /// release used resources
    destructor Destroy; override;
    /// launch Process abstract method asynchronously in the background thread
    // - wait until process is finished, calling OnIdle() callback in
    // the meanwhile
    // - any exception raised in background thread will be translated in the
    // caller thread
    // - returns false if self is not set, or if called from the same thread
    // as it is currently processing (to avoid race condition from OnIdle()
    // callback)
    // - returns true when the background process is finished
    // - OpaqueParam will be used to specify a thread-safe content for the
    // background process
    // - this method is thread-safe, that is it will wait for any started process
    // already launch by another thread: you may call this method from any
    // thread, even if its main purpose is to be called from the main UI thread
    function RunAndWait(OpaqueParam: pointer): boolean;
    /// set a callback event to be executed in loop during remote blocking
    // process, e.g. to refresh the UI during a somewhat long request
    // - you can assign a callback to this property, calling for instance
    // Application.ProcessMessages, to execute the remote request in a
    // background thread, but let the UI still be reactive: the
    // TLoginForm.OnIdleProcess and OnIdleProcessForm methods of
    // mORMotUILogin.pas will match this property expectations
    // - if OnIdle is not set (i.e. equals nil), it will simply wait for
    // the background process to finish until RunAndWait() will return
    property OnIdle: TOnIdleSynBackgroundThread read fOnIdle write fOnIdle;
    /// TRUE if the background thread is active, and OnIdle event is called
    // during process
    // - to be used e.g. to ensure no re-entrance from User Interface messages
    property OnIdleBackgroundThreadActive: Boolean read GetOnIdleBackgroundThreadActive;
    /// optional callback event triggered in Execute before main process loop
    // - could be assigned e.g. to TSQLRestServer.BeginCurrentThread
    property OnBeforeExecute: TNotifyThreadEvent read fOnBeforeExecute write fOnBeforeExecute;
    /// optional callback event triggered in Execute after main process loop
    // - could be assigned e.g. to TSQLRestServer.EndCurrentThread
    property OnAfterExecute: TNotifyThreadEvent read fOnAfterExecute write fOnAfterExecute;
    /// optional callback event triggered in Execute before each Process
    property OnBeforeProcess: TNotifyThreadEvent read fOnBeforeProcess write fOnBeforeProcess;
    /// optional callback event triggered in Execute after each Process
    property OnAfterProcess: TNotifyThreadEvent read fOnAfterProcess write fOnAfterProcess;
  end;

  /// background process method called by TSynBackgroundThreadEvent
  // - will supply the OpaqueParam parameter as provided to RunAndWait()
  // method when the Process virtual method will be executed
  TOnProcessSynBackgroundThread = procedure(Sender: TSynBackgroundThreadEvent;
    ProcessOpaqueParam: pointer) of object;

  /// allow background thread process of a method callback
  TSynBackgroundThreadEvent = class(TSynBackgroundThreadAbstract)
  protected
    fOnProcess: TOnProcessSynBackgroundThread;
    /// just call the OnProcess handler
    procedure Process; override;
  public
    /// initialize the thread
    // - if aOnIdle is not set (i.e. equals nil), it will simply wait for
    // the background process to finish until RunAndWait() will return 
    constructor Create(aOnProcess: TOnProcessSynBackgroundThread;
      aOnIdle: TOnIdleSynBackgroundThread; const aThreadName: RawUTF8); reintroduce;
    /// provide a method handler to be execute in the background thread
    // - triggered by RunAndWait() method - which will wait until finished
    // - the OpaqueParam as specified to RunAndWait() will be supplied here
    property OnProcess: TOnProcessSynBackgroundThread read fOnProcess write fOnProcess;
  end;

  /// allow background thread process of a variable TThreadMethod callback
  TSynBackgroundThreadMethod = class(TSynBackgroundThreadAbstract)
  protected
    /// just call the TThreadMethod, as as supplied to RunAndWait()
    procedure Process; override;
  public
    /// run once the supplied TThreadMethod callback
    // - use this method, and not the inherited RunAndWait()  
    procedure RunAndWait(Method: TThreadMethod); reintroduce;
  end;

  /// background process procedure called by TSynBackgroundThreadProcedure
  // - will supply the OpaqueParam parameter as provided to RunAndWait()
  // method when the Process virtual method will be executed
  TOnProcessSynBackgroundThreadProc = procedure(ProcessOpaqueParam: pointer);

  /// allow background thread process of a procedure callback
  TSynBackgroundThreadProcedure = class(TSynBackgroundThreadAbstract)
  protected
    fOnProcess: TOnProcessSynBackgroundThreadProc;
    /// just call the OnProcess handler
    procedure Process; override;
  public
    /// initialize the thread
    // - if aOnIdle is not set (i.e. equals nil), it will simply wait for
    // the background process to finish until RunAndWait() will return
    constructor Create(aOnProcess: TOnProcessSynBackgroundThreadProc;
      aOnIdle: TOnIdleSynBackgroundThread; const aThreadName: RawUTF8); reintroduce;
    /// provide a procedure handler to be execute in the background thread
    // - triggered by RunAndWait() method - which will wait until finished
    // - the OpaqueParam as specified to RunAndWait() will be supplied here
    property OnProcess: TOnProcessSynBackgroundThreadProc read fOnProcess write fOnProcess;
  end;

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

/// 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(var EventList; const Event: TMethod): integer;


{ ************ fast ISO-8601 types and conversion routines }

type
  /// 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 = {$ifndef UNICODE}object{$else}record{$endif}
    /// 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;
{$ifdef MSWINDOWS}
    /// extract the date and time content in Value into individual values
    procedure Expand(out Date: TSystemTime);
{$endif}
    /// 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: Int64;
    /// convert to a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
    function ToUnixMSTime: Int64;
    /// 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 second-based c-encoded time (from Unix epoch 1/1/1970)
    procedure FromUnixTime(const UnixTime: Int64);
    /// fill Value from millisecond-based c-encoded time (from Unix epoch 1/1/1970)
    procedure FromUnixMSTime(const UnixMSTime: Int64);
    /// 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(DateTime: TDateTime): 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; overload;
  {$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}

/// convert a TTimeLog value into a ISO-8601 string format for SQL '?' inlined
// parameters
// - handle TTimeLog bit-encoded Int64 format
// - follows the same pattern as DateToSQL or DateTimeToSQL functions, i.e.
// will return the date or time encoded as '\uFFF1YYYY-MM-DDThh:mm:ss' -
// therefore ':("\uFFF12012-05-04T20:12:13"):' pattern will be recognized as a
// sftDateTime inline parameter in  SQLParamContent() / ExtractInlineParameters()
// (JSON_SQLDATE_MAGIC will be used as prefix to create '\uFFF1...' pattern)
// - to be used e.g. as in:
// ! aRec.CreateAndFillPrepare(Client,'Datum<=?',[TimeLogToSQL(TimeLogNow)]);
function TimeLogToSQL(const TimeStamp: TTimeLog): RawUTF8;

/// 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
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
// - 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')
// - 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 only 'YYYY-MM-DDThh:mm:ss' or 'YYYY-MM-DD' or 'Thh:mm:ss'
// patterns, as e.g. generated by TTextWriter.AddDateTime() or RecordSaveJSON() 
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
// - 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
// - 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)
// - handle 'hhmmss' and 'hh:mm:ss' format
// - if L is left to default 0, it will be computed from StrLen(P)
function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer; var H,M,S: 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
function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar='T'): 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 Time conversion into ISO-8601
// - use 'Thhmmss' format if not Expanded
// - use 'Thh:mm:ss' format if Expanded
function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar='T'): 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: cardinal); 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'
procedure DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUTF8Char;
  FirstChar: AnsiChar='T');

/// 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'
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar='T'): 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'
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar; var result: RawUTF8);

/// 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'
// - used e.g. by TPropInfo.GetValue() and TPropInfo.NormalizeValue() methods
procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar; var result: string);

/// 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
procedure TimeToIso8601PChar(P: PUTF8Char; Expanded: boolean; H,M,S: cardinal;
  FirstChar: AnsiChar = 'T'); 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
procedure TimeToIso8601PChar(Time: TDateTime; P: PUTF8Char; Expanded: boolean;
  FirstChar: AnsiChar = 'T'); overload;

/// 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 Time (whithout Date), in the ISO 8601 layout
// - useful for direct on screen logging e.g.
function TimeToString: RawUTF8;

/// convert a second-based c-encoded time (from Unix epoch 1/1/1970) as TDateTime
function UnixTimeToDateTime(const UnixTime: Int64): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TDateTime into a second-based c-encoded time (from Unix epoch 1/1/1970)
function DateTimeToUnixTime(const AValue: TDateTime): Int64;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a millisecond-based c-encoded time (from Unix epoch 1/1/1970) as TDateTime
function UnixMSTimeToDateTime(const UnixTime: Int64): TDateTime;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a TDateTime into a millisecond-based c-encoded time (from Unix epoch 1/1/1970)
function DateTimeToUnixMSTime(const AValue: TDateTime): Int64;
  {$ifdef HASINLINE}inline;{$endif}

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


var
  /// 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 by TTimeLogBits.i18nText and by TSQLTable.ExpandAsString() method,
  // i.e. TSQLTableToGrid.DrawCell()
  i18nDateText: function(Iso: TTimeLog): string = nil;


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


/// 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 expect 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);

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;


{ ************ 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
  /// used internaly for fast word recognition (32 bytes const)
  IsWord: set of byte =
    [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
  IsIdentifier: set of byte =
    [ord('_'),ord('0')..ord('9'),ord('a')..ord('z'),ord('A')..ord('Z')];

  /// used internaly for fast URI "unreserved" characters identifier
  // - defined as unreserved  = ALPHA / DIGIT / "-" / "." / "_" / "~"
  // in @http://tools.ietf.org/html/rfc3986#section-2.3
  IsURIUnreserved: set of byte =
    [ord('a')..ord('z'),ord('A')..ord('Z'),ord('0')..ord('9'),
     ord('-'),ord('.'),ord('_'),ord('~')];


{$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;
    fBuildDateTime: TDateTime;
  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;
    /// 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,aMinor,aRelease: integer);
    /// retrieve the version as a 32 bits integer with Major.Minor.Release
    // - following Major shl 16+Minor shl 8+Release bit pattern
    function Version32: integer;
  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
    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;
  UnixDateDelta = 25569;

/// GetFileVersion returns the most significant 32 bits 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}

{$ifdef MSWINDOWS}

type
  /// the recognized Windows versions
  TWindowsVersion = (
    wUnknown, w2000, wXP, wXP_64, wServer2003, wServer2003_R2,
    wVista, wVista_64, wServer2008, wServer2008_64,
    wServer2008_R2, wServer2008_R2_64, wSeven, wSeven_64,
    wEight, wEight_64, wServer2012, wServer2012_64,
    wEightOne, wEightOne_64, wServer2012R2, wServer2012R2_64,
    wTen, wTen_64, wServer2014R2, wServer2014R2_64);
  {$ifndef UNICODE}
  /// 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}


var
  /// is set to TRUE if the current process is running under WOW64
  // - WOW64 is the x86 emulator that allows 32-bit Windows-based applications
  // to run seamlessly on 64-bit Windows
  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)
  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;

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

{$else MSWINDOWS}

{$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
// - will call the corresponding function in SynKylix.pas or SynFPCLinux.pas
function GetTickCount64: Int64;

{$endif MSWINDOWS}

{$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}{$ifdef HASINLINE}inline;{$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}

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

/// 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: integer);

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

{$ifndef CPUARM}
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 CPUARM}

/// allow to fix TEvent.WaitFor() method for Kylix
// - under Windows or with FPC, will call original TEvent.WaitFor() method
function FixedWaitFor(Event: TEvent; Timeout: LongWord): TWaitResult;

/// allow to fix TEvent.WaitFor(Event,INFINITE) method for Kylix
// - under Windows or with FPC, will call original TEvent.WaitFor() method
procedure FixedWaitForever(Event: TEvent);


type
  /// to be used instead of TMemoryStream, for speed
  // - allocates memory from Delphi heap (i.e. FastMM4/SynScaleMM)
  // and not GlobalAlloc()
  // - uses bigger growing size of the capacity
{$ifdef LVCL} // LVCL already use Delphi heap instead of GlobalAlloc()
  THeapMemoryStream = TMemoryStream;
{$else}
  {$ifdef FPC} // FPC already use Delphi 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);
  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;


{ ************ TSynTable generic types and classes }

{$define SORTCOMPAREMETHOD}
{ if defined, the field content comparison will use a method instead of fixed
  functions - could be mandatory for tftArray field kind }

type
  /// the available types for any TSynTable field property
  // - this is used in our so-called SBF compact binary format
  // (similar to BSON or Protocol Buffers)
  // - those types are used for both storage and JSON conversion
  // - basic types are similar to SQLite3, i.e. Int64/Double/UTF-8/Blob
  // - storage can be of fixed size, or of variable length
  // - you can specify to use WinAnsi encoding instead of UTF-8 for string storage
  // (it can use less space on disk than UTF-8 encoding)
  // - BLOB fields can be either internal (i.e. handled by TSynTable like a
  // RawByteString text storage), either external (i.e. must be stored in a dedicated
  // storage structure - e.g. another TSynBigTable instance)
  TSynTableFieldType =
    (// unknown or not defined field type
     tftUnknown,
     // some fixed-size field value
     tftBoolean, tftUInt8, tftUInt16, tftUInt24, tftInt32, tftInt64,
     tftCurrency, tftDouble,
     // some variable-size field value
     tftVarUInt32, tftVarInt32, tftVarUInt64,
     // text storage
     tftWinAnsi, tftUTF8,
     // BLOB fields
     tftBlobInternal, tftBlobExternal,
     // other variable-size field value
     tftVarInt64);
    
  {/ set of available field types for TSynTable }
  TSynTableFieldTypes = set of TSynTableFieldType;

  /// available option types for a field property
  // - tfoIndex is set if an index must be created for this field
  // - tfoUnique is set if field values must be unique (if set, the tfoIndex
  // will be always forced)
  // - tfoCaseInsensitive can be set to make no difference between 'a' and 'A'
  // (by default, comparison is case-sensitive) - this option has an effect
  // not only if tfoIndex or tfoUnique is set, but also for iterating search
  TSynTableFieldOption = (
    tfoIndex, tfoUnique, tfoCaseInsensitive);

  /// set of option types for a field
  TSynTableFieldOptions = set of TSynTableFieldOption;

  /// used to store bit set for all available fiels in a Table
  // - with current format, maximum field count is 64
  TSynTableFieldBits = set of 0..63;

  /// an custom RawByteString type used to store internaly a data in
  // our SBF compact binary format
  TSBFString = type RawByteString;

  /// function prototype used to retrieve the index of a specified property name
  // - 'ID' is handled separately: here must be available only the custom fields
  TSynTableFieldIndex = function(const PropName: RawUTF8): integer of object;

  /// the recognized operators for a TSynTableStatement where clause
  TSynTableStatementOperator = (
     opEqualTo,
     opNotEqualTo,
     opLessThan,
     opLessThanOrEqualTo,
     opGreaterThan,
     opGreaterThanOrEqualTo,
     opIn,
     opIsNull,
     opIsNotNull,
     opLike,
     opContains,
     opFunction);

  TSynTableFieldProperties = class;

  /// one recognized SELECT expression for TSynTableStatement
  TSynTableStatementSelect = record
    /// the column SELECTed for the SQL statement, in the expected order
    // - contains 0 for ID/RowID, or the RTTI field index + 1
    Field: integer;
    /// an optional integer to be added
    // - recognized from .. +123 .. -123 patterns in the select 
    ToBeAdded: integer;
    /// the optional column alias, e.g. 'MaxID' for 'max(id) as MaxID'
    Alias: RawUTF8;
    /// the optional function applied to the SELECTed column
    // - e.g. Max(RowID) would store 'Max' and SelectField[0]=0
    // - but Count(*) would store 'Count' and SelectField[0]=0, and
    // set FunctionIsCountStart = TRUE
    FunctionName: RawUTF8;
    /// if the function needs a special process
    // - e.g. funcCountStar for the special Count(*) expression or
    // funcDistinct for distinct(...) aggregation
    FunctionKnown: (funcNone, funcCountStar, funcDistinct);
  end;

  /// the recognized SELECT expressions for TSynTableStatement
  TSynTableStatementSelectDynArray = array of TSynTableStatementSelect;
  
  /// one recognized WHERE expression for TSynTableStatement
  TSynTableStatementWhere = record
    /// expressions are evaluated as AND unless this field is set to TRUE
    JoinedOR: boolean;
    /// if this expression is preceded by a NOT modifier
    NotClause: boolean;
    /// the index of the field used for the WHERE expression
    // - WhereField=0 for ID, 1 for field # 0, 2 for field #1,
    // and so on... (i.e. WhereField = RTTI field index +1)
    Field: integer;
    /// the operator of the WHERE expression
    Operator: TSynTableStatementOperator;
    /// the SQL function name associated to a Field and Value
    // - e.g. 'INTEGERDYNARRAYCONTAINS' and Field=0 for
    // IntegerDynArrayContains(RowID,10) and ValueInteger=10 
    // - Value does not contain anything
    FunctionName: RawUTF8;
    /// the value used for the WHERE expression
    Value: RawUTF8;
    /// the raw value SQL buffer used for the WHERE expression
    ValueSQL: PUTF8Char;
    /// the raw value SQL buffer length used for the WHERE expression
    ValueSQLLen: integer;
    /// an integer representation of WhereValue (used for ID check e.g.)
    ValueInteger: integer;
    /// used to fast compare with SBF binary compact formatted data
    ValueSBF: TSBFString;
    {$ifndef NOVARIANTS}
    /// the value used for the WHERE expression, encoded as Variant
    // - may be a TDocVariant for the IN operator
    ValueVariant: variant;
    {$endif}
  end;

  /// the recognized WHERE expressions for TSynTableStatement
  TSynTableStatementWhereDynArray = array of TSynTableStatementWhere;

  /// used to parse a SELECT SQL statement, following the SQlite3 syntax
  // - handle basic REST commands, i.e. a SELECT over a single table (no JOIN)
  // with its WHERE clause, and result column aliases 
  // - handle also aggregate functions like "SELECT Count(*) FROM TableName"
  // - will also parse any LIMIT, OFFSET, ORDER BY, GROUP BY statement clause
  TSynTableStatement = class
  protected
    fSQLStatement: RawUTF8;
    fSelect: TSynTableStatementSelectDynArray;
    fSelectFunctionCount: integer;
    fTableName: RawUTF8;
    fWhere: TSynTableStatementWhereDynArray;
    fOrderByField: TSQLFieldIndexDynArray;
    fGroupByField: TSQLFieldIndexDynArray;
    fOrderByDesc: boolean;
    fLimit: integer;
    fOffset: integer;
    fWriter: TJSONWriter;
  public
    /// parse the given SELECT SQL statement and retrieve the corresponding
    // parameters into this class read-only properties
    // - the supplied GetFieldIndex() method is used to populate the
    // SelectedFields and Where[].Field properties
    // - SimpleFieldsBits is used for '*' field names
    // - SQLStatement is left '' if the SQL statement is not correct
    // - if SQLStatement is set, the caller must check for TableName to match
    // the expected value, then use the Where[] to retrieve the content
    // - if FieldProp is set, then the Where[].ValueSBF property is initialized
    // with the SBF equivalence of the Where[].Value
    constructor Create(const SQL: RawUTF8; GetFieldIndex: TSynTableFieldIndex;
      SimpleFieldsBits: TSQLFieldBits=[0..MAX_SQLFIELDS-1];
      FieldProp: TSynTableFieldProperties=nil);
    /// compute the SELECT column bits from the SelectFields array
    procedure SelectFieldBits(var Fields: TSQLFieldBits; var withID: boolean);

    /// the SELECT SQL statement parsed
    // - equals '' if the parsing failed
    property SQLStatement: RawUTF8 read fSQLStatement;
    /// the column SELECTed for the SQL statement, in the expected order
    property Select: TSynTableStatementSelectDynArray read fSelect;
    /// if the SELECTed expression of this SQL statement have any function defined
    property SelectFunctionCount: integer read fSelectFunctionCount;
    /// the retrieved table name
    property TableName: RawUTF8 read fTableName;
    /// the WHERE clause of this SQL statement
    property Where: TSynTableStatementWhereDynArray read fWhere;
    /// recognize an GROUP BY clause with one or several fields
    // - here 0 = ID, otherwise RTTI field index +1
    property GroupByField: TSQLFieldIndexDynArray read fGroupByField;
    /// recognize an ORDER BY clause with one or several fields
    // - here 0 = ID, otherwise RTTI field index +1
    property OrderByField: TSQLFieldIndexDynArray read fOrderByField;
    /// false for default ASC order, true for DESC attribute
    property OrderByDesc: boolean read fOrderByDesc;
    /// the number specified by the optional LIMIT ... clause
    // - set to 0 by default (meaning no LIMIT clause)
    property Limit: integer read fLimit;
    /// the number specified by the optional OFFSET ... clause
    // - set to 0 by default (meaning no OFFSET clause)
    property Offset: integer read fOffset;
    /// optional associated writer
    property Writer: TJSONWriter read fWriter write fWriter;
  end;

  /// function prototype used to retrieve the RECORD data of a specified Index
  // - the index is not the per-ID index, but the "physical" index, i.e. the
  // index value used to retrieve data from low-level (and faster) method
  // - should return nil if Index is out of range
  // - caller must provide a temporary storage buffer to be used optionally
  TSynTableGetRecordData = function(
    Index: integer; var aTempData: RawByteString): pointer of object;

  TSynTable = class;

  {$ifdef SORTCOMPAREMETHOD}
  /// internal value used by TSynTableFieldProperties.SortCompare() method to
  // avoid stack allocation
  TSortCompareTmp = record
    PB1, PB2: PByte;
    L1,L2: integer;
  end;
  {$endif}

  /// store the type properties of a given field / database column
  TSynTableFieldProperties = class
  protected
    /// used during OrderedIndexSort to prevent stack usage
    SortPivot: pointer;
    {$ifdef SORTCOMPAREMETHOD}
    /// internal value used by SortCompare() method to avoid stack allocation
    SortCompareTmp: TSortCompareTmp;
    {$endif}
    /// these two temporary buffers are used to call TSynTableGetRecordData
    DataTemp1, DataTemp2: RawByteString;
    /// the associated table which own this field property
    Owner: TSynTable;
    /// the global size of a default field value, as encoded
    // in our SBF compact binary format
    fDefaultFieldLength: integer;
    /// a default field data, as encoded in our SBF compact binary format
    fDefaultFieldData: TSBFString;
    /// last >=0 value returned by the last OrderedIndexFindAdd() call
    fOrderedIndexFindAdd: integer;
    /// used for internal QuickSort of OrderedIndex[]
    // - call SortCompare() for sorting the items
    procedure OrderedIndexSort(L,R: PtrInt);
    /// retrieve an index from OrderedIndex[] of the given value
    // - call SortCompare() to compare to the reference value
    function OrderedIndexFind(Value: pointer): PtrInt;
    /// retrieve an index where a Value must be added into OrderedIndex[]
    // - call SortCompare() to compare to the reference value
    // - returns -1 if Value is there, or the index where to insert
    // - the returned value (if >= 0) will be stored in fOrderedIndexFindAdd
    function OrderedIndexFindAdd(Value: pointer): PtrInt;
    /// set OrderedIndexReverse[OrderedIndex[aOrderedIndex]] := aOrderedIndex;
    procedure OrderedIndexReverseSet(aOrderedIndex: integer);
  public
    /// the field name
    Name: RawUTF8;
    /// kind of field (defines both value type and storage to be used)
    FieldType: TSynTableFieldType;
    /// the fixed-length size, or -1 for a varInt, -2 for a variable string
    FieldSize: integer;
    /// options of this field
    Options: TSynTableFieldOptions;
    /// contains the offset of this field, in case of fixed-length field
    // - normaly, fixed-length fields are stored in the beginning of the record
    // storage: in this case, a value >= 0 will point to the position of the
    // field value of this field
    // - if the value is < 0, its absolute will be the field number to be counted
    // after TSynTable.fFieldVariableOffset (-1 for first item)
    Offset: integer;
    /// number of the field in the table (starting at 0)
    FieldNumber: integer;
    /// if allocated, contains the storage indexes of every item, in sorted order
    // - only available if tfoIndex is in Options
    // - the index is not the per-ID index, but the "physical" index, i.e. the
    // index value used to retrieve data from low-level (and faster) method
    OrderedIndex: TIntegerDynArray;
    /// if allocated, contains the reverse storage index of OrderedIndex
    // - i.e. OrderedIndexReverse[OrderedIndex[i]] := i;
    // - used to speed up the record update procedure with huge number of
    // records
    OrderedIndexReverse: TIntegerDynArray;
    /// number of items in OrderedIndex[]
    // - is set to 0 when the content has been modified (mark force recreate)
    OrderedIndexCount: integer;
    /// if set to TRUE after an OrderedIndex[] refresh but with not sorting
    // - OrderedIndexSort(0,OrderedIndexCount-1) must be called before using
    // the OrderedIndex[] array
    // - you should call OrderedIndexRefresh method to ensure it is sorted
    OrderedIndexNotSorted: boolean;
    /// all TSynValidate instances registered per each field
    Filters: TObjectList;
    /// all TSynValidate instances registered per each field
    Validates: TObjectList;
    /// low-level binary comparison used by IDSort and TSynTable.IterateJSONValues
    // - P1 and P2 must point to the values encoded in our SBF compact binary format
    {$ifdef SORTCOMPAREMETHOD}
    function SortCompare(P1,P2: PUTF8Char): PtrInt;
    {$else}
    SortCompare: TUTF8Compare;
    {$endif}

    /// read entry from a specified file reader
    constructor CreateFrom(var RD: TFileBufferReader);
    /// release associated memory and objects
    destructor Destroy; override;
    /// save entry to a specified file writer
    procedure SaveTo(WR: TFileBufferWriter);
    {$ifndef DELPHI5OROLDER}
    /// decode the value from our SBF compact binary format into UTF-8 JSON
    // - returns the next FieldBuffer value
    function GetJSON(FieldBuffer: pointer; W: TTextWriter): pointer;
    {$endif DELPHI5OROLDER}
    /// decode the value from our SBF compact binary format into UTF-8 text
    // - this method does not check for FieldBuffer to be not nil -> caller
    // should check this explicitely
    function GetValue(FieldBuffer: pointer): RawUTF8;
    /// decode the value from a record buffer into an Boolean
    // - will call Owner.GetData to retrieve then decode the field SBF content
    function GetBoolean(RecordBuffer: pointer): Boolean;
      {$ifdef HASINLINE}inline;{$endif}
    /// decode the value from a record buffer into an integer
    // - will call Owner.GetData to retrieve then decode the field SBF content
    function GetInteger(RecordBuffer: pointer): Integer;
    /// decode the value from a record buffer into an Int64
    // - will call Owner.GetData to retrieve then decode the field SBF content
    function GetInt64(RecordBuffer: pointer): Int64;
    /// decode the value from a record buffer into an floating-point value
    // - will call Owner.GetData to retrieve then decode the field SBF content
    function GetDouble(RecordBuffer: pointer): Double;
    /// decode the value from a record buffer into an currency value
    // - will call Owner.GetData to retrieve then decode the field SBF content
    function GetCurrency(RecordBuffer: pointer): Currency;
    /// decode the value from a record buffer into a RawUTF8 string
    // - will call Owner.GetData to retrieve then decode the field SBF content
    function GetRawUTF8(RecordBuffer: pointer): RawUTF8;
    {$ifndef NOVARIANTS}
    /// decode the value from our SBF compact binary format into a Variant
    function GetVariant(FieldBuffer: pointer): Variant; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// decode the value from our SBF compact binary format into a Variant
    procedure GetVariant(FieldBuffer: pointer; var result: Variant); overload;
    {$endif}
    /// retrieve the binary length (in bytes) of some SBF compact binary format
    function GetLength(FieldBuffer: pointer): Integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// create some SBF compact binary format from a Delphi binary value
    // - will return '' if the field type doesn't match a boolean
    function SBF(const Value: Boolean): TSBFString; overload;
    /// create some SBF compact binary format from a Delphi binary value
    // - will encode any byte, word, integer, cardinal, Int64 value
    // - will return '' if the field type doesn't match an integer
    function SBF(const Value: Int64): TSBFString; overload;
    /// create some SBF compact binary format from a Delphi binary value
    // - will encode any byte, word, integer, cardinal value
    // - will return '' if the field type doesn't match an integer
    function SBF(const Value: Integer): TSBFString; overload;
    /// create some SBF compact binary format from a Delphi binary value
    // - will return '' if the field type doesn't match a currency
    // - we can't use SBF() method name because of Currency/Double ambiguity
    function SBFCurr(const Value: Currency): TSBFString;
    /// create some SBF compact binary format from a Delphi binary value
    // - will return '' if the field type doesn't match a floating-point
    // - we can't use SBF() method name because of Currency/Double ambiguity
    function SBFFloat(const Value: Double): TSBFString;
    /// create some SBF compact binary format from a Delphi binary value
    // - expect a RawUTF8 string: will be converted to WinAnsiString
    // before storage, for tftWinAnsi
    // - will return '' if the field type doesn't match a string
    function SBF(const Value: RawUTF8): TSBFString; overload;
    /// create some SBF compact binary format from a BLOB memory buffer
    // - will return '' if the field type doesn't match tftBlobInternal
    function SBF(Value: pointer; ValueLen: integer): TSBFString; overload;
    /// convert any UTF-8 encoded value into our SBF compact binary format
    // - can be used e.g. from a WHERE clause, for fast comparison in
    // TSynTableStatement.WhereValue content using OrderedIndex[]
    // - is the reverse of GetValue/GetRawUTF8 methods above
    function SBFFromRawUTF8(const aValue: RawUTF8): TSBFString;
    {$ifndef NOVARIANTS}
    /// create some SBF compact binary format from a Variant value
    function SBF(const Value: Variant): TSBFString; overload;
    {$endif}

    /// will update then sort the array of indexes used for the field index
    // - the OrderedIndex[] array is first refreshed according to the
    // aOldIndex, aNewIndex parameters: aOldIndex=-1 for Add, aNewIndex=-1 for
    // Delete, or both >= 0 for update
    // - call with both indexes = -1 will sort the existing OrderedIndex[] array
    // - GetData property must have been set with a method returning a pointer
    // to the field data for a given index (this index is not the per-ID index,
    // but the "physical" index, i.e. the index value used to retrieve data
    // from low-level (and fast) GetData method)
    // - aOldRecordData and aNewRecordData can be specified in order to guess
    // if the field data has really been modified (speed up the update a lot
    // to only sort indexed fields if its content has been really modified)
    // - returns FALSE if any parameter is invalid
    function OrderedIndexUpdate(aOldIndex, aNewIndex: integer;
      aOldRecordData, aNewRecordData: pointer): boolean;
    /// retrieve one or more "physical" indexes matching a WHERE Statement
    // - is faster than a GetIteraring(), because will use binary search using
    // the OrderedIndex[] array
    // - returns the resulting indexes as a a sorted list in MatchIndex/MatchIndexCount
    // - if the indexes are already present in the list, won't duplicate them
    // - WhereSBFValue must be a valid SBF formated field buffer content
    // - the Limit parameter is similar to the SQL LIMIT clause: if greater than 0,
    // an upper bound on the number of rows returned is placed (e.g. set Limit=1
    // to only retrieve the first match)
    // - GetData property must have been set with a method returning a pointer
    // to the field data for a given index (this index is not the per-ID index,
    // but the "physical" index, i.e. the index value used to retrieve data
    // from low-level (and fast) GetData method)
    // - in this method, indexes are not the per-ID indexes, but the "physical"
    // indexes, i.e. each index value used to retrieve data from low-level
    // (and fast) GetData method
    function OrderedIndexMatch(WhereSBFValue: pointer;
      var MatchIndex: TIntegerDynArray; var MatchIndexCount: integer;
      Limit: Integer=0): Boolean;
    /// will force refresh the OrderedIndex[] array
    // - to be called e.g. if OrderedIndexNotSorted = TRUE, if you want to
    // access to the OrderedIndex[] array
    procedure OrderedIndexRefresh;
    /// register a custom filter or validation rule to the class for this field
    // - this will be used by Filter() and Validate() methods
    // - will return the specified associated TSynFilterOrValidate instance
    // - a TSynValidateTableUniqueField is always added by
    // TSynTable.AfterFieldModif if tfoUnique is set in Options
    function AddFilterOrValidate(aFilter: TSynFilterOrValidate): TSynFilterOrValidate;
    /// check the registered constraints
    // - returns '' on success
    // - returns an error message e.g. if a tftUnique constraint failed
    // - RecordIndex=-1 in case of adding, or the physical index of the updated record
    function Validate(RecordBuffer: pointer; RecordIndex: integer): string;
    /// some default SBF compact binary format content
    property SBFDefault: TSBFString read fDefaultFieldData;
  end;


{$ifndef DELPHI5OROLDER}

  /// a pointer to structure used to store a TSynTable record 
  PSynTableData = ^TSynTableData;
  
  {$A-} { packet object not allowed since Delphi 2009 :( }
  /// used to store a TSynTable record using our SBF compact binary format
  // - this object can be created on the stack
  // - it is mapped into a variant TVarData, to be retrieved by the
  // TSynTable.Data method - but direct allocation of a TSynTableData on the
  // stack is faster (due to the Variant overhead)
  // - 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 UNICODE}
  TSynTableData = record
  private
  {$else}
  TSynTableData = object
  protected
  {$endif UNICODE}
    VType: TVarType;
    Filler: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(pointer)*2-4] of byte;
    VID: integer;
    VTable: TSynTable;
    VValue: TSBFString;
    {$ifndef NOVARIANTS}
    function GetFieldValue(const FieldName: RawUTF8): Variant; overload;
    procedure GetFieldVariant(const FieldName: RawUTF8; var result: Variant);
    procedure SetFieldValue(const FieldName: RawUTF8; const Value: Variant); overload;
    {$endif}
    /// raise an exception if VTable=nil
    procedure CheckVTableInitialized;
      {$ifdef HASINLINE}inline;{$endif}
  public
    /// initialize a record data content for a specified table
    // - a void content is set
    procedure Init(aTable: TSynTable; aID: Integer=0); overload; {$ifdef HASINLINE}inline;{$endif}
    /// initialize a record data content for a specified table
    // - the specified SBF content is store inside this TSynTableData
    procedure Init(aTable: TSynTable; aID: Integer; RecordBuffer: pointer;
      RecordBufferLen: integer); overload;
    /// the associated record ID
    property ID: integer read VID write VID;
    /// the associated TSynTable instance
    property Table: TSynTable read VTable write VTable;
    /// the record content, SBF compact binary format encoded
    property SBF: TSBFString read VValue;
    {$ifndef NOVARIANTS}
    /// set or retrieve a field value from a variant data
    property Field[const FieldName: RawUTF8]: Variant read GetFieldValue write SetFieldValue;
    /// get a field value for a specified field
    // - this method is faster than Field[], because it won't look for the field name
    function GetFieldValue(aField: TSynTableFieldProperties): Variant; overload;
    /// set a field value for a specified field
    // - this method is faster than Field[], because it won't look for the field name
    procedure SetFieldValue(aField: TSynTableFieldProperties; const Value: Variant); overload;
      {$ifdef HASINLINE}inline;{$endif}
    {$endif}
    /// set a field value for a specified field, from SBF-encoded data
    // - this method is faster than the other, because it won't look for the field
    // name nor make any variant conversion
    procedure SetFieldSBFValue(aField: TSynTableFieldProperties; const Value: TSBFString);
    /// get a field value for a specified field, into SBF-encoded data
    // - this method is faster than the other, because it won't look for the field
    // name nor make any variant conversion
    function GetFieldSBFValue(aField: TSynTableFieldProperties): TSBFString;
    /// filter the SBF buffer record content with all registered filters
    // - all field values are filtered in-place, following our SBF compact
    // binary format encoding for this record
    procedure FilterSBFValue; {$ifdef HASINLINE}inline;{$endif}
    /// check the registered constraints according to a record SBF buffer
    // - returns '' on success
    // - returns an error message e.g. if a tftUnique constraint failed
    // - RecordIndex=-1 in case of adding, or the physical index of the updated record
    function ValidateSBFValue(RecordIndex: integer): string;
  end;
  {$A+} { packet object not allowed since Delphi 2009 :( }
{$endif DELPHI5OROLDER}

  PUpdateFieldEvent = ^TUpdateFieldEvent;

  /// an opaque structure used for TSynTable.UpdateFieldEvent method
  TUpdateFieldEvent = record
    /// the number of record added
    Count: integer;
    /// the list of IDs added
    // - this list is already in increasing order, because GetIterating was
    // called with the ioID order
    IDs: TIntegerDynArray;
    /// the offset of every record added
    // - follows the IDs[] order
    Offsets64: TInt64DynArray;
    /// previous indexes: NewIndexs[oldIndex] := newIndex
    NewIndexs: TIntegerDynArray;
    /// the list of existing field in the previous data
    AvailableFields: TSQLFieldBits;
    /// where to write the updated data
    WR: TFileBufferWriter;
  end;
  
  /// will define a validation to be applied to a TSynTableFieldProperties field
  // - a typical usage is to validate a value to be unique in the table
  // (implemented in the TSynValidateTableUniqueField class)
  // - the optional associated parameters are to be supplied JSON-encoded
  // - ProcessField and ProcessRecordIndex properties will be filled before
  // Process method call by TSynTableFieldProperties.Validate()
  TSynValidateTable = class(TSynValidate)
  protected
    fProcessField: TSynTableFieldProperties;
    fProcessRecordIndex: integer;
  public
    /// the associated TSQLRest instance
    // - this value is filled by TSynTableFieldProperties.Validate with its
    // self value to be used for the validation
    // - it can be used in the overridden Process method
    property ProcessField: TSynTableFieldProperties read fProcessField write fProcessField;
    /// the associated record index (in case of update)
    // - is set to -1 in case of adding, or the physical index of the updated record
    // - this value is filled by TSynTableFieldProperties.Validate
    // - it can be used in the overridden Process method
    property ProcessRecordIndex: integer read fProcessRecordIndex write fProcessRecordIndex;
  end;

  /// will define a validation for a TSynTableFieldProperties Unique field
  // - implement constraints check e.g. if tfoUnique is set in Options
  // - it will check that the field value is not void
  // - it will check that the field value is not a duplicate
  TSynValidateTableUniqueField = class(TSynValidateTable)
  public
    /// perform the unique field validation action to the specified value
    // - duplication value check will use the ProcessField  and
    // ProcessRecordIndex properties, which will be filled before call by
    // TSynTableFieldProperties.Validate()
    // - aFieldIndex parameter is not used here, since we have already the
    // ProcessField property set
    // - here the Value is expected to be UTF-8 text, as converted from our SBF
    // compact binary format via e.g. TSynTableFieldProperties.GetValue /
    // GetRawUTF8: this is mandatory to have the validation rule fit with other
    // TSynValidateTable classes
    function Process(aFieldIndex: integer; const Value: RawUTF8; var ErrorMsg: string): boolean; override;
  end;

  /// store the description of a table with records, to implement a Database
  // - can be used with several storage engines, for instance TSynBigTableRecord
  // - each record can have up to 64 fields
  // - a mandatory ID field must be handled by the storage engine itself
  // - will handle the storage of records into our SBF compact binary format, in
  // which fixed-length fields are stored leftmost side, then variable-length
  // fields follow
  TSynTable = class
  protected
    fTableName: RawUTF8;
    /// list of TSynTableFieldProperties instances
    fField: TObjectList;
    /// offset of the first variable length value field
    fFieldVariableOffset: PtrUInt;
    /// index of the first variable length value field
    // - equals -1 if no variable length field exists
    fFieldVariableIndex: integer;
    /// bit is set for a tftWinAnsi, tftUTF8 or tftBlobInternal kind of field
    // - these kind of field are encoded as a VarInt length, then the data
    fFieldIsVarString: TSynTableFieldBits;
    /// bit is set for a tftBlobExternal kind of field e.g.
    fFieldIsExternal: TSynTableFieldBits;
    /// event used for proper data retrieval of a given record buffer
    fGetRecordData: TSynTableGetRecordData;
    /// the global size of a default value, as encoded in our SBF compact binary format
    fDefaultRecordLength: integer;
    /// a default record data, as encoded in our SBF compact binary format
    fDefaultRecordData: TSBFString;
    /// list of TSynTableFieldProperties added via all AddField() call
    fAddedField: TList;
    /// true if any field has a tfoUnique option set
    fFieldHasUniqueIndexes: boolean;
    function GetFieldType(Index: integer): TSynTableFieldProperties;
    function GetFieldCount: integer;
    function GetFieldFromName(const aName: RawUTF8): TSynTableFieldProperties;
    function GetFieldIndexFromName(const aName: RawUTF8): integer;
    /// this method matchs the TSynTableFieldIndex event type
    function GetFieldIndexFromShortName(const aName: ShortString): integer;
    /// refresh Offset,FieldNumber,FieldSize and fFieldVariableIndex,fFieldVariableOffset
    procedure AfterFieldModif;
  public
    /// create a table definition instance
    constructor Create(const aTableName: RawUTF8);
    /// create a table definition instance from a specified file reader
    procedure LoadFrom(var RD: TFileBufferReader);
    /// release used memory
    destructor Destroy; override;
    /// save field properties to a specified file writer
    procedure SaveTo(WR: TFileBufferWriter);

    /// retrieve to the corresponding data address of a given field
    function GetData(RecordBuffer: PUTF8Char; Field: TSynTableFieldProperties): pointer;
    /// add a field description to the table
    // - warning: the class responsible of the storage itself must process the
    // data already stored when a field is created, e.g. in
    // TSynBigTableRecord.AddFieldUpdate method
    // - physical order does not necessary follow the AddField() call order:
    // for better performance, it will try to store fixed-sized record first,
    // multiple of 4 bytes first (access is faster if dat is 4 byte aligned),
    // then variable-length after fixed-sized fields; in all case, a field
    // indexed will be put first
    function AddField(const aName: RawUTF8; aType: TSynTableFieldType;
      aOptions: TSynTableFieldOptions=[]): TSynTableFieldProperties;
    /// update a record content
    // - return the updated record data, in our SBF compact binary format
    // - if NewFieldData is not specified, a default 0 or '' value is appended
    // - if NewFieldData is set, it must match the field value kind
    // - warning: this method will update result in-place, so RecordBuffer MUST
    // be <> pointer(result) or data corruption may occur
    procedure UpdateFieldData(RecordBuffer: PUTF8Char; RecordBufferLen,
      FieldIndex: integer; var result: TSBFString; const NewFieldData: TSBFString='');
    /// update a record content after any AddfieldUpdate, to refresh the data
    // - AvailableFields must contain the list of existing fields in the previous data
    function UpdateFieldRecord(RecordBuffer: PUTF8Char; var AvailableFields: TSQLFieldBits): TSBFString;
    /// this Event is to be called for all data records (via a GetIterating method)
    // after any AddfieldUpdate, to refresh the data
    // - Opaque is in fact a pointer to a TUpdateFieldEvent record, and will contain
    // all parameters set by TSynBigTableRecord.AddFieldUpdate, including a
    // TFileBufferWriter instance to use to write the recreated data
    // - it will work with either any newly added field, handly also field data
    // order change in SBF record (e.g. when a fixed-sized field has been added
    // on a record containing variable-length fields)
    function UpdateFieldEvent(Sender: TObject; Opaque: pointer; ID, Index: integer;
      Data: pointer; DataLen: integer): boolean;
    /// event which must be called by the storage engine when some values are modified
    // - if aOldIndex and aNewIndex are both >= 0, the corresponding aOldIndex
    // will be replaced by aNewIndex value (i.e. called in case of a data Update)
    // - if aOldIndex is -1 and aNewIndex is >= 0, aNewIndex refers to a just
    // created item (i.e. called in case of a data Add)
    // - if aOldIndex is >= 0 and aNewIndex is -1, aNewIndex refers to a just
    // deleted item (i.e. called in case of a data Delete)
    // - will update then sort all existing TSynTableFieldProperties.OrderedIndex
    // values
    // - the GetDataBuffer protected virtual method must have been overridden to
    // properly return the record data for a given "physical/stored" index
    // - aOldRecordData and aNewRecordData can be specified in order to guess
    // if the field data has really been modified (speed up the update a lot
    // to only sort indexed fields if its content has been really modified)
    procedure FieldIndexModify(aOldIndex, aNewIndex: integer;
      aOldRecordData, aNewRecordData: pointer);
    /// return the total length of the given record buffer, encoded in our SBF
    // compact binary format
    function DataLength(RecordBuffer: pointer): integer;
    {$ifndef NOVARIANTS}
    /// create a Variant able to access any field content via late binding
    // - i.e. you can use Var.Name to access the 'Name' field of record Var
    // - if you leave ID and RecordBuffer void, a void record is created
    function Data(aID: integer=0; RecordBuffer: pointer=nil;
      RecordBufferLen: Integer=0): Variant; overload;
    {$endif NOVARIANTS}
    /// return a default content for ALL record fields
    // - uses our SBF compact binary format
    property DefaultRecordData: TSBFString read fDefaultRecordData;
    /// list of TSynTableFieldProperties added via all AddField() call
    // - this list will allow TSynBigTableRecord.AddFieldUpdate to refresh
    // the data on disk according to the new field configuration
    property AddedField: TList read fAddedField write fAddedField;
    /// offset of the first variable length value field
    property FieldVariableOffset: PtrUInt read fFieldVariableOffset;
  public
    {$ifndef DELPHI5OROLDER}
    /// create a TJSONWriter, ready to be filled with GetJSONValues(W) below
    // - will initialize all TJSONWriter.ColNames[] values according to the
    // specified Fields index list, and initialize the JSON content
    function CreateJSONWriter(JSON: TStream; Expand, withID: boolean;
      const Fields: TSQLFieldIndexDynArray): TJSONWriter; overload;
    /// create a TJSONWriter, ready to be filled with GetJSONValues(W) below
    // - will initialize all TJSONWriter.ColNames[] values according to the
    // specified Fields bit set, and initialize the JSON content
    function CreateJSONWriter(JSON: TStream; Expand, withID: boolean;
      const Fields: TSQLFieldBits): TJSONWriter; overload;
    (** return the UTF-8 encoded JSON objects for the values contained
      in the specified RecordBuffer encoded in our SBF compact binary format,
      according to the Expand/WithID/Fields parameters of W
      - if W.Expand is true, JSON data is an object, for direct use with any Ajax or .NET client:
      ! {"col1":val11,"col2":"val12"}
      - if W.Expand is false, JSON data is serialized (as used in TSQLTableJSON)
      ! { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
      - only fields with a bit set in W.Fields will be appended
      - if W.WithID is true, then the first ID field value is included *)
    procedure GetJSONValues(aID: integer; RecordBuffer: PUTF8Char; W: TJSONWriter);
    /// can be used to retrieve all values matching a preparated TSynTableStatement
    // - this method matchs the TSynBigTableIterateEvent callback definition
    // - Sender will be the TSynBigTable instance, and Opaque will point to a
    // TSynTableStatement instance (with all fields initialized, including Writer)
    function IterateJSONValues(Sender: TObject; Opaque: pointer; ID: integer;
      Data: pointer; DataLen: integer): boolean;
    {$endif DELPHI5OROLDER}
    /// check the registered constraints according to a record SBF buffer
    // - returns '' on success
    // - returns an error message e.g. if a tftUnique constraint failed
    // - RecordIndex=-1 in case of adding, or the physical index of the updated record
    function Validate(RecordBuffer: pointer; RecordIndex: integer): string;
    /// filter the SBF buffer record content with all registered filters
    // - all field values are filtered in-place, following our SBF compact
    // binary format encoding for this record
    procedure Filter(var RecordBuffer: TSBFString);

    /// event used for proper data retrieval of a given record buffer, according
    // to the physical/storage index value (not per-ID index)
    // - if not set, field indexes won't work
    // - will be mapped e.g. to TSynBigTable.GetPointerFromPhysicalIndex
    property GetRecordData: TSynTableGetRecordData read fGetRecordData write fGetRecordData;
  public
    /// the internal Table name used to identify it (e.g. from JSON or SQL)
    // - similar to the SQL Table name
    property TableName: RawUTF8 read fTableName write fTableName;
    /// number of fields in this table
    property FieldCount: integer read GetFieldCount;
    /// retrieve the properties of a given field
    // - returns nil if the specified Index is out of range
    property Field[Index: integer]: TSynTableFieldProperties read GetFieldType;
    /// retrieve the properties of a given field
    // - returns nil if the specified Index is out of range
    property FieldFromName[const aName: RawUTF8]: TSynTableFieldProperties read GetFieldFromName; default;
    /// retrieve the index of a given field
    // - returns -1 if the specified Index is out of range
    property FieldIndexFromName[const aName: RawUTF8]: integer read GetFieldIndexFromName;
    /// read-only access to the Field list
    property FieldList: TObjectList read fField;
    /// true if any field has a tfoUnique option set
    property HasUniqueIndexes: boolean read fFieldHasUniqueIndexes;
  end;

  /// SQL Query comparison operators
  // - these operators are e.g. used by CompareOperator() functions
  TCompareOperator = (
     soEqualTo,
     soNotEqualTo,
     soLessThan,
     soLessThanOrEqualTo,
     soGreaterThan,
     soGreaterThanOrEqualTo,
     soBeginWith,
     soContains,
     soSoundsLikeEnglish,
     soSoundsLikeFrench,
     soSoundsLikeSpanish);

/// low-level integer comparison according to a specified operator
// - SBF must point to the values encoded in our SBF compact binary format
// - Value must contain the plain integer value
// - Value can be a Currency accessed via a PInt64
// - will work only for tftBoolean, tftUInt8, tftUInt16, tftUInt24,
// tftInt32, tftInt64 and tftCurrency field types
// - will handle only soEqualTo...soGreaterThanOrEqualTo operators
// - if SBFEnd is not nil, it will test for all values until SBF>=SBFEnd
// (can be used for tftArray)
// - returns true if both values match, or false otherwise
function CompareOperator(FieldType: TSynTableFieldType; SBF, SBFEnd: PUTF8Char;
  Value: Int64; Oper: TCompareOperator): boolean; overload;

/// low-level floating-point comparison according to a specified operator
// - SBF must point to the values encoded in our SBF compact binary format
// - Value must contain the plain floating-point value
// - will work only for tftDouble field type
// - will handle only soEqualTo...soGreaterThanOrEqualTo operators
// - if SBFEnd is not nil, it will test for all values until SBF>=SBFEnd
// (can be used for tftArray)
// - returns true if both values match, or false otherwise
function CompareOperator(SBF, SBFEnd: PUTF8Char;
  Value: double; Oper: TCompareOperator): boolean; overload;

/// low-level text comparison according to a specified operator
// - SBF must point to the values encoded in our SBF compact binary format
// - Value must contain the plain text value, in the same encoding (either
// WinAnsi either UTF-8, as FieldType defined for the SBF value)
// - will work only for tftWinAnsi and tftUTF8 field types
// - will handle all kind of operators (including soBeginWith, soContains and
// soSoundsLike*) but soSoundsLike* won't make use of the CaseSensitive parameter
// - for soSoundsLikeEnglish, soSoundsLikeFrench and soSoundsLikeSpanish
// operators, Value is not a real PUTF8Char but a prepared PSynSoundEx
// - if SBFEnd is not nil, it will test for all values until SBF>=SBFEnd
// (can be used for tftArray)
// - returns true if both values match, or false otherwise
function CompareOperator(FieldType: TSynTableFieldType; SBF, SBFEnd: PUTF8Char;
  Value: PUTF8Char; ValueLen: integer; Oper: TCompareOperator;
  CaseSensitive: boolean): boolean; overload;

const
  /// JSON compatible representation of a boolean value
  JSON_BOOLEAN: array[boolean] of RawUTF8 = ('false','true');

  /// can be used to append to most English nouns to form a plural 
  PLURAL_FORM: array[boolean] of RawUTF8 = ('','s');

  /// used by TSynTableStatement.WhereField for "SELECT .. FROM TableName WHERE ID=?"
  SYNTABLESTATEMENTWHEREID = 0;

/// convert any AnsiString content into our SBF compact binary format storage
procedure ToSBFStr(const Value: RawByteString; out Result: TSBFString);

/// 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
  /// this variant type is not defined in older versions of Delphi
  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 not(TVarData(aVariant).VType in VTYPE_STATIC) then
  // !    VarClear(aVariant);
  VTYPE_STATIC: set of varEmpty..varWord64 =
    [varEmpty..varDate,varBoolean,varShortInt..varWord64];

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

/// 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 faster
procedure SetVariantNull(var Value: variant);
  {$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;
    /// 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
    // - this default implementation will raise an ESynException
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); overload; virtual;
  public
    /// 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;

  /// a custom variant type used to have direct access to a record content
  // - use TSynTable.Data method to retrieve such a Variant
  // - this variant will store internaly a SBF compact binary format
  // representation of the record content
  // - uses internally a TSynTableData object
  TSynTableVariantType = class(TSynInvokeableVariantType)
  protected
    procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
    procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
  public
    /// retrieve the SBF compact binary format representation of a record content
    class function ToSBF(const V: Variant): TSBFString;
    /// retrieve the ID value associated to a record content
    class function ToID(const V: Variant): integer;
    /// retrieve the TSynTable instance associated to a record content
    class function ToTable(const V: Variant): TSynTable;
    /// clear the content
    procedure Clear(var V: TVarData); override;
    /// copy two record content
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
  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
  // - 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)
  // - dvoReturnNullForOutOfRangeIndex  will be used when retrieving any value
  // from its 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()
  TDocVariantOption =
    (dvoNameCaseSensitive, dvoCheckForDuplicatedNames,
     dvoReturnNullForUnknownProperty, dvoReturnNullForOutOfRangeIndex,
     dvoValueCopiedByReference, dvoJSONParseDoNotTryCustomVariants,
     dvoJSONObjectParseWithinString);

  /// set of options for a TDocVariant storage
  // - you can use JSON_OPTIONS[true] if you want to create a fast by-reference
  // local document
  TDocVariantOptions = set of TDocVariantOption;

  /// pointer to a set of options for a TDocVariant storage
  PDocVariantOptions = ^TDocVariantOptions;


/// 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
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(var Value: TVarData);
  {$ifdef HASINLINE}inline;{$endif}

/// 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: TDocVariantOptions=[dvoValueCopiedByReference]);
  {$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 (i.e. the RecordLoad/RecordSave layout)
// - 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: TDocVariantOptions=[dvoValueCopiedByReference]): 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: TDocVariantOptions=[dvoValueCopiedByReference]): variant; overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariantJSON() 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): PUTF8Char; overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariantJSON() 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); overload;

/// retrieve a variant value from a JSON number or string
// - follows TTextWriter.AddVariantJSON() 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): variant; overload;

/// save a variant value into a JSON content
// - follows the TTextWriter.AddVariantJSON() 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.AddVariantJSON() 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.AddVariantJSON() 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 unesceped 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 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
procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions=nil);

/// 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 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 cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
procedure VarRecToVariant(const V: TVarRec; var result: variant); overload;

/// convert an open array (const Args: array of const) argument to a variant
// - note that cardinal values should be type-casted to Int64() (otherwise
// the integer mapped value will be transmitted, therefore wrongly)
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); 

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

/// guess the correct TSQLDBFieldType from a variant value
function VariantTypeToSQLDBFieldType(const V: Variant): TSQLDBFieldType;

var
  /// the internal custom variant type used to register TDocVariant
  DocVariantType: TSynInvokeableVariantType = nil;

type
  /// pointer to a TDocVariant storage
  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)
  // - you can use _Obj() _Arr() and _Json()/_JsonFast() functions to create
  // instances of this kind of variants
  // - 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
    /// fast getter/setter implementation
    procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
    procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
    // this implementation will write the content as JSON object or array
    procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); 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 some document-based content
    // - same as New(aValue,JSON_OPTIONS[true]);
    class procedure NewFast(out aValue: variant); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// initialize several variant instances to store document-based content
    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 either the function _Obj() or _Arr()
    // which is a wrapper around this class method
    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.InitJSON() 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
    // - 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);

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

  {$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 transtype such an allocated variant into TDocVariantData
  // to access directly to its internals (like Count or Values[]/Names[]):
  // ! with TDocVariantData(aVariantObject) do
  // !   for i := 0 to Count-1 do
  // !     writeln(Names[i],'=',Values[i]); // for an object
  // ! 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
  // - you can use _Obj() _Arr() and _Json()/_JsonFast() or
  // _JsonFmt()/_JsonFastFmt() functions to create instances of such variants
  {$ifdef UNICODE}
  TDocVariantData = record
  private
  {$else}
  TDocVariantData = object
  protected
  {$endif}
    VType: TVarType;
    VOptions: TDocVariantOptions;
    VKind: TDocVariantKind;
    (* 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);
    procedure InternalAddValue(const aName: RawUTF8; const aValue: variant);
    procedure SetCapacity(aValue: integer);
    function GetCapacity: integer;
      {$ifdef HASINLINE}inline;{$endif}
    /// add some properties to a TDocVariantData dvObject
    // - data is supplied two by two, as Name,Value pairs
    // - caller should ensure that VKind=dvObject
    procedure AddNameValuesToObject(const NameValuePairs: array of const);
  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 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
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitArrayFromVariants(const Items: TVariantDynArray;
      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
    // - 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 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
    // - 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;
    /// 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
    // - if you call Init*() methods in a row, ensure you call Clear in-between
    procedure InitCopy(const SourceDocVariant: variant; aOptions: TDocVariantOptions);

    /// 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
    procedure Reset;
    /// force a number of items
    // - could be used to fast add items to the internal Values[]/Names[] arrays
    // - just set VCount, do not resize the arrays: caller should ensure that
    // Capacity is big enough
    procedure SetCount(aCount: 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: 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);

    /// 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: integer; 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 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
    function GetVarData(const aName: RawUTF8; var aValue: TVarData): boolean; overload;
    /// 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
    function GetVarData(const aName: RawUTF8): PVarData; overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// 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
    function GetAsInteger(const aName: RawUTF8; out aValue: integer): 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
    function GetAsInt64(const aName: RawUTF8; out aValue: Int64): 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
    function GetAsDouble(const aName: RawUTF8; out aValue: double): 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
    function GetAsRawUTF8(const aName: RawUTF8; out aValue: RawUTF8): 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 not match the data
    function GetValueByPath(const aPath: RawUTF8): variant; 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;
    /// 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 dvoReturnNullForOutOfRangeIndex 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 dvoReturnNullForOutOfRangeIndex 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 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;
    /// 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;
    /// search a property match in this document, handled as array
    // - {aPropName:aPropValue} will be searched within the stored array,
    // and the corresponding item index will be returned, on match
    // - returns -1 if no match is found
    function SearchItemByProp(const aPropName,aPropValue: RawUTF8;
      aCaseSensitive: boolean): integer;
    /// 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
    function SearchItemByValue(const aValue: Variant): 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
    procedure SortByName(Compare: TUTF8Compare=nil);

    /// how this document will behave
    // - those options are set when creating the instance
    property Options: TDocVariantOptions read VOptions;
    /// returns the instance 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
    property Kind: TDocVariantKind read VKind;
    /// 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
    // dvoReturnNullForOutOfRangeIndex 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, you can use:
    // !  Doc.GetValueOrRaiseException('arr').Add(4); // won't work
    property Value[const aNameOrIndex: Variant]: Variant read GetValueOrItem
      write SetValueOrItem; default;
  end;
  {$A+} { packet object not allowed since Delphi 2009 :( }

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

/// 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
function DocVariantDataSafe(const DocVariant: variant): PDocVariantData; 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)
// - will check the supplied document kind, i.e. either dvObject or dvArray and
// raise a EDocVariant exception if it does not match 
function DocVariantDataSafe(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 the Obj is a TDocVariant object, will add the Name/Value pairs
// - if the Obj is not a TDocVariant, will create a new fast document,
// initialized with 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 the Document and Obj are a TDocVariant object, then all Document's
// properties will be added at the root level of Obj
// - if Document or Obj are not a TDocVariant object, will do nothing 
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;

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

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

/// 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 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
// - 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
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
// - 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
function _CopyFast(const DocVariant: variant): variant;
  {$ifdef HASINLINE}inline;{$endif}


const
  /// some convenient TDocVariant options
  // - 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]);

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

{$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);

/// change the Windows console text writing color
// - call this procedure to initialize internal console process, if you manually
// intialized the Windows console, e.g. via the following code:
// ! AllocConsole;
// ! TextColor(ccLightGray);
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;

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

var
  /// low-level handle used for console writing
  // - may be overriden when console is redirected
  StdOut: THandle;


{ ******************* cross-cutting classes and functions ***** }

type
  /// 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: 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
  TPrecisionTimer = {$ifndef UNICODE}object{$else}record{$endif}
  private
    iStart,iStop,iResume,iLast: Int64;
    iFreq: Int64;
    /// contains the time elapsed in micro seconds between Start and Stop
    iTime: QWord;
    /// contains the time elapsed in micro seconds between Resume and Pause
    iLastTime: QWord;
    fPauseCount: cardinal;
  public
    /// initialize the timer
    // - not necessary if created on the heap (e.g. as class member)
    // - will set all fields to 0
    procedure Init;
    /// start the high resolution timer
    procedure Start;
    /// stop the timer, setting the Time elapsed since last Start
    procedure ComputeTime;
    /// stop the timer, returning the time elapsed as text with time resolution
    // (us,ms,s)
    // - is just a wrapper around ComputeTime + GetTime
    function Stop: RawUTF8;
    /// 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
    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
    // - warning: Start, Stop, Pause and Resume methods are then disallowed
    procedure FromExternalQueryPerformanceCounters(const CounterDiff: Int64);
    /// 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): RawUTF8;
    /// 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: RawUTF8;
    /// time elapsed in micro seconds after counter stopped
    // - not to be used in normal code, but e.g. for custom performance analysis
    property TimeInMicroSec: QWord read iTime write iTime;
    /// 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: RawUTF8;
    /// timing in micro seconds of the last process
    // - not to be used in normal code, but e.g. for custom performance analysis
    property LastTimeInMicroSec: QWord read iLastTime write iLastTime;
    /// how many times the Pause method was called
    property PauseCount: cardinal 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: RawUTF8;
    /// 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: RawUTF8;
    /// 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;

  {$M+}
  /// able to serialize any timing as raw micro-seconds number or text
  TSynMonitorTime = class
  protected
    fMicroSeconds: QWord;
    function GetAsText: RawUTF8;
  public
    /// compute a number per second, of the current value
    function PerSecond(const aValue: QWord): QWord;
      {$ifdef HASINLINE}inline;{$endif}
  published
    /// micro seconds time elapsed, as raw number
    property MicroSec: QWord read fMicroSeconds write fMicroSeconds;
    /// micro seconds time elapsed, as '... us-ns-ms-s' text
    property Text: RawUTF8 read GetAsText;
  end;

  /// able to serialize any size as bytes number
  TSynMonitorSize = class
  protected
    fBytes: QWord;
    function GetAsText: RawUTF8;
  published
    /// number of bytes, as raw number
    property Bytes: QWord read fBytes write fBytes;
    /// number of bytes, as '... B-KB-MB-GB' text
    property Text: RawUTF8 read GetAsText;
  end;

  /// able to serialize any bandwith as bytes count per second
  TSynMonitorThroughput = class
  protected
    fBytesPerSec: QWord;
    function GetAsText: RawUTF8;
  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: RawUTF8 read GetAsText;
  end;
  {$M-}


{$ifdef MSWINDOWS}
{$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(TObject,IUnknown)
  protected
    fExpected8087, fSaved8087: word;
    fRefCount: integer;
    {$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
    /// internal constructor
    // - do not call this constructor directly, but rather use
    // ForLibraryCode/ForDelphiCode class methods
    // - flags are $1332 for Delphi, or $133F for library (mask all exceptions)
    constructor Create(Expected8087Flag: word); reintroduce;
    /// 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
    // - 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)
    // - you have to put this e.g. before running an external libray
    // - this method is thread-safe and re-entrant (by reference-counting)
    class function ForDelphiCode: IUnknown;
  end;

{$endif DELPHI5OROLDER}
{$endif MSWINDOWS}

  /// 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
  {$else}
  /// an interface used by TAutoLocker to protect multi-thread execution
  IAutoLocker = interface
    ['{97559643-6474-4AD3-AF72-B9BB84B4955D}']
    /// will enter the mutex until the IUnknown reference is released
    // - i.e. until you left the method block
    // - using an IUnknown interface to let the compiler auto-generate a
    // try..finally block statement to release the lock
    // - warning: under FPC, you should assign the result of this method to a local
    // IUnknown variable - see bug http://bugs.freepascal.org/view.php?id=26602
    function ProtectMethod: IUnknown;
    /// enter the mutex
    // - any call to Enter should be ended with a call to Leave
    procedure Enter;
    /// leave the mutex
    // - any call to Leave should be preceded with a call to Enter
    procedure Leave;
  end;

  /// reference counted block code locker
  // - you can use one instance of this to protect multi-thread 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
  TAutoLocker = class(TInterfacedObjectWithCustomCreate,IAutoLocker)
  {$endif DELPHI5OROLDER}
  protected
    fLock: TRTLCriticalSection;
    fLocked: boolean;
  public
    /// initialize the mutex
    constructor Create; {$ifndef DELPHI5OROLDER} override; {$endif}
    /// will enter the mutex until the IUnknown reference is released
    // - warning: under FPC, you should assign its result to a local lockFPC:
    // IUnknown variable - see bug http://bugs.freepascal.org/view.php?id=26602
    function ProtectMethod: IUnknown;
    /// enter the mutex
    procedure Enter;
    /// leave the mutex
    procedure Leave;
    /// finalize the mutex
    destructor Destroy; override;
  end;

{$ifndef DELPHI5OROLDER} // internal error C3517 under Delphi 5 :(
{$ifndef NOVARIANTS}
  /// ref-counted interface for thread-safe access to a TDocVariant document
  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
    function Exists(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.Exists('prop',local) then
    // !   cache.Replace('prop',newValue,local);
    procedure Replace(const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
    /// add an existing property value to the given TDocVariant document object
    // - could be used as such, for implementing a thread-safe cache:
    // ! if not cache.AddExistingProp('Articles',Scope) then
    // !   cache.AddNewProp('Articles',GetArticlesFromDB,Scope);
    function AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object
    procedure AddNewProp(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// delete all stored properties
    procedure Clear;
    /// the document fields would be safely accessed via this property
    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 IAutoLocker 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
    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;
    /// set a value by property name, and set a local copy
    procedure Replace(const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
    /// add an existing property value to the given TDocVariant document object
    function AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
    /// add a property value to the given TDocVariant document object
    procedure AddNewProp(const Name: RawUTF8; const Value: variant; var Obj: variant);
    /// delete all stored properties
    procedure Clear;
    /// the document fields would be safely accessed via this property
    // - 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}

  /// class-reference type (metaclass) of an authentication class
  TSynAuthenticationClass = class of TSynAuthenticationAbstract;

  /// abstract authentication class, implementing safe token/challenge security
  // and a list of active sessions
  // - do not use this class, but plain TSynAuthentication
  TSynAuthenticationAbstract = class
  protected
    fLock: TAutoLocker;
    fSessions: TIntegerDynArray;
    fSessionsCount: Integer;
    fSessionGenerator: integer;
    fTokenSeed: Int64;
    function ComputeCredential(previous: boolean; const UserName,PassWord: RawUTF8): cardinal; virtual;
    function GetPassword(const UserName: RawUTF8; out Password: RawUTF8): boolean; virtual; abstract;
    function GetUsersCount: integer; virtual; abstract;
  public
    /// initialize the authentication scheme
    constructor Create;
    /// finalize the authentation
    destructor Destroy; override;
    /// register one credential for a given user
    // - this abstract method would raise an exception: inherited classes should
    // implement them as expected
    procedure AuthenticateUser(const aName, aPassword: RawUTF8); virtual;
    /// unregister one credential for a given user
    // - this abstract method would raise an exception: inherited classes should
    // implement them as expected
    procedure DisauthenticateUser(const aName: RawUTF8); virtual;
    /// create a new session
    // - should return 0 on authentication error, or an integer session ID
    // - this method will check the User name and password, and create a new session
    function CreateSession(const User: RawUTF8; Hash: cardinal): integer; virtual;
    /// check if the session exists in the internal list
    function SessionExists(aID: integer): boolean;
    /// delete a session
    procedure RemoveSession(aID: integer);
    /// returns the current identification token
    // - to be sent to the client for its authentication challenge
    function CurrentToken: Int64;
    /// the number of current opened sessions
    property SessionsCount: integer read fSessionsCount;
    /// the number of registered users
    property UsersCount: integer read GetUsersCount;
    /// to be used to compute a Hash on the client, for a given Token
    // - the token should have been retrieved from the server, and the client
    // should compute and return this hash value, to perform the authentication
    // challenge and create the session
    class function ComputeHash(Token: Int64; const UserName,PassWord: RawUTF8): cardinal; virtual;
  end;

  /// simple authentication class, implementing safe token/challenge security
  // - maintain a list of user / name credential pairs, and a list of sessions
  // - is not meant to handle authorization, just plain user access validation
  // - used e.g. by TSQLDBConnection.RemoteProcessMessage (on server side) and
  // TSQLDBProxyConnectionPropertiesAbstract (on client side) in SynDB.pas
  TSynAuthentication = class(TSynAuthenticationAbstract)
  protected
    fCredentials: TSynNameValue;
    function GetPassword(const UserName: RawUTF8; out Password: RawUTF8): boolean; override;
    function GetUsersCount: integer; override;
  public
    /// initialize the authentication scheme
    // - you can optionally register one user credential
    constructor Create(const aUserName: RawUTF8=''; const aPassword: RawUTF8=''); reintroduce;
    /// register one credential for a given user
    procedure AuthenticateUser(const aName, aPassword: RawUTF8); override;
    /// unregister one credential for a given user
    procedure DisauthenticateUser(const aName: RawUTF8); override;
  end;


/// convert a size to a human readable value
// - append MB, KB or B symbol
// - for MB and KB, add one fractional digit
function KB(bytes: Int64): RawUTF8;

/// convert a micro seconds elapsed time into a human readable value
// - append us, ms or s symbol
// - for us and ms, add two fractional digits
function MicroSecToString(Micro: QWord): RawUTF8;

/// 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: RawUTF8=','): RawUTF8;

/// return the Delphi Compiler Version
// - returns 'Delphi 2007' or 'Delphi 2010' 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;

/// compress a memory bufer using the SynLZ algorithm and crc32c hashing
function SynLZCompress(const Data: RawByteString; CompressionSizeTrigger: integer=100): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compress a memory bufer using the SynLZ algorithm and crc32c hashing
procedure SynLZCompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  CompressionSizeTrigger: integer=100); overload;

/// uncompress a memory bufer using the SynLZ algorithm and crc32c hashing
function SynLZDecompress(const Data: RawByteString): RawByteString; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// uncompress a memory bufer using the SynLZ algorithm and crc32c hashing
procedure SynLZDecompress(P: PAnsiChar; PLen: integer; out Result: RawByteString); overload;

/// compress a memory bufer using the SynLZ algorithm and crc32c hashing
function SynLZCompressToBytes(const Data: RawByteString;
  CompressionSizeTrigger: integer=100): TByteDynArray; overload;
  {$ifdef HASINLINE}inline;{$endif}

/// compress a memory bufer using the SynLZ algorithm and crc32c hashing
function SynLZCompressToBytes(P: PAnsiChar; PLen: integer;
  CompressionSizeTrigger: integer=100): TByteDynArray; overload;

/// uncompress a memory bufer using the SynLZ algorithm and crc32c hashing
function SynLZDecompress(const Data: TByteDynArray): RawByteString; overload; 


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}
  SynFPCLinux, BaseUnix, Unix, dynlibs,
  {$ifndef Darwin}
  SysCall,
  {$endif}
  {$endif}
  SynFPCTypInfo; // small wrapper unit around FPC's TypInfo.pp
{$endif}


{ ************ 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);


{ TSynAnsiConvert }

const
  DefaultChar: AnsiChar = '?';

function TSynAnsiConvert.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal): 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);
    Dest^ := WideChar(ord(Source^));
    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);
    move(Pointer(tmp)^,Dest^,length(tmp)*2);
    result := Dest+SourceChars;
    {$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;
  result^ := #0;
end;

function TSynAnsiConvert.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
var tmp: array[0..256*3] 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) else begin
      GetMem(U,SourceChars*3+2);
      result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,U,
        AnsiBufferToUnicode(U,Source,SourceChars)-U);
      FreeMem(U);
    end;
  result^ := #0;
end;

function TSynAnsiConvert.AnsiToRawUnicode(const AnsiText: RawByteString): RawUnicode;
begin
  result := AnsiToRawUnicode(pointer(AnsiText),length(AnsiText));
end;

procedure FastNewRawUTF8(var s: RawUTF8; len: integer);
{$ifdef FPC} inline;
begin
  SetString(s,nil,len);
end;
{$else}
{$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif}
begin
  if len<>0 then
    if (PtrUInt(s)=0) or                   // s=''
       (PInteger(PtrUInt(s)-8)^<>1) or     // s.refcount<>1
       (PInteger(PtrUInt(s)-4)^<>len) then // s.length<>len
      SetString(s,nil,len) else
      exit else
    if s='' then
      exit else
      s := '';
end;
{$else}
asm // eax=s edx=len
     test edx,edx
     mov ecx,[eax]
     jz System.@LStrClr
     test ecx,ecx
     jz @set
     cmp dword ptr [ecx-8],1
     jne @set
     cmp dword ptr [ecx-4],edx
     je @out
@set:mov ecx,edx
     xor edx,edx
{$ifdef UNICODE}
     push CP_UTF8 // UTF-8 code page for Delphi 2009+
     call  System.@LStrFromPCharLen // we need a call, not a jmp here
{$else}
     jmp System.@LStrFromPCharLen
{$endif}
@out:
end;
{$endif PUREPASCAL}
{$endif FPC}

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;
begin
  result := '';
  if SourceChars<>0 then begin
    SetLength(result,SourceChars);
    SetLength(result,AnsiBufferToUnicode(pointer(result),Source,SourceChars)-pointer(result));
  end;
end;

function TSynAnsiConvert.AnsiToUnicodeString(const Source: RawByteString): SynUnicode;
{$ifndef MSWINDOWS}
var P: PAnsiChar;
{$endif}
begin
  result := '';
  if Source<>'' then begin
    SetLength(result,length(Source)*3);
    {$ifdef MSWINDOWS}
    SetLength(result,AnsiBufferToUnicode(pointer(result),pointer(Source),length(Source))-pointer(result));
    {$else} // FPC/Linux workaround by ALF
    P := @result;
    SetLength(result,PAnsiChar(AnsiBufferToUnicode(PWideChar(result),PAnsiChar(Source),length(Source)))-P);
    {$endif}
  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 tmpU8: array[0..256*3] of AnsiChar;
    U8: PUTF8Char;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else
  if SourceChars<SizeOf(tmpU8)div 3 then
    SetString(result,tmpU8,AnsiBufferToUTF8(tmpU8,Source,SourceChars)-tmpU8) else begin
    Getmem(U8,SourceChars*3+1);
    SetString(result,U8,AnsiBufferToUTF8(U8,Source,SourceChars)-U8);
    FreeMem(U8);
  end;
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);
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}
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,@DefaultChar,nil);
    {$else}
    {$ifdef ISDELPHIXE} // use cross-platform wrapper for WideCharToMultiByte()
    result := Dest+System.LocaleCharsFromUnicode(
      fCodePage,0,Source,SourceChars,Dest,SourceChars*3,@DefaultChar,nil);
    {$else}
    {$ifdef FPC}
    widestringmanager.Unicode2AnsiMoveProc(Source,tmp,
      {$ifdef ISFPC27}fCodePage,{$endif}SourceChars);
    move(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*3] 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 tmpA: array[byte] of AnsiChar;
    A: PAnsiChar;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    if SourceChars<SizeOf(tmpA)shr fAnsiCharShift then
      SetString(result,tmpA,Utf8BufferToAnsi(tmpA,Source,SourceChars)-tmpA) else begin
      Getmem(A,(SourceChars+1) shl fAnsiCharShift);
      SetString(result,A,Utf8BufferToAnsi(A,Source,SourceChars)-A);
      FreeMem(A);
    end;
    {$ifdef UNICODE}
    PWord(PtrInt(result)-12)^ := fCodePage; // force set code page
    {$endif}
  end;
end;

function TSynAnsiConvert.UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
begin
  UTF8BufferToAnsi(pointer(UTF8),length(UTF8),result);
end;

function TSynAnsiConvert.UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString;
var tmpA: array[byte] of AnsiChar;
    A: PAnsiChar;
begin
  if (Source=nil) or (SourceChars=0) then
    result := '' else begin
    if SourceChars<SizeOf(tmpA)shr fAnsiCharShift then
      SetString(result,tmpA,UnicodeBufferToAnsi(tmpA,Source,SourceChars)-tmpA) else begin
      Getmem(A,(SourceChars+1) shl fAnsiCharShift);
      SetString(result,A,UnicodeBufferToAnsi(A,Source,SourceChars)-A);
      FreeMem(A);
    end;
    {$ifdef UNICODE}
    PWord(PtrInt(result)-12)^ := fCodePage; // force set code page
    {$endif}
  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
    SetString(result,Source,SourceChars) 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): PWideChar;
var i: Integer;
begin
  for i := 1 to SourceChars shr 2 do begin
    Dest[0] := WideChar(fAnsiToWide[Ord(Source[0])]);
    Dest[1] := WideChar(fAnsiToWide[Ord(Source[1])]);
    Dest[2] := WideChar(fAnsiToWide[Ord(Source[2])]);
    Dest[3] := WideChar(fAnsiToWide[Ord(Source[3])]);
    inc(Source,4);
    inc(Dest,4);
  end;
  for i := 1 to SourceChars and 3 do begin
    Dest^ := WideChar(fAnsiToWide[Ord(Source^)]);
    inc(Dest);
    inc(Source);
  end;
  Dest^ := #0;
  result := Dest;
end;

function TSynAnsiFixedWidth.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal): 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
    // first 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 else
        if Source<endSource then continue else break;
      end
      else begin // no surrogate is expected in TSynAnsiFixedWidth charsets
        c := fAnsiToWide[c]; // convert WinAnsi 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 else
          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 else
          if Source<endSource then continue else break;
        end;
      end;
    until false;
  end;
  Dest^ := #0;
  Result := Dest;
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 if 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: integer;
    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 then begin // do not trust the Windows API :(
    for i := 0 to 255 do
      fAnsiToWide[i] := i;
    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);
    fillchar(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]);
    move(U256[0],fAnsiToWide[0],512);
  end;
  SetLength(fWideToAnsi,65536);
  for i := 1 to 126 do
    fWideToAnsi[i] := i;
  fillchar(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: integer;
    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: cardinal;
    i, extra: integer;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^);
      inc(UTF8Text);
      if c=0 then break else
      if c and $80=0 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: Cardinal;
    i, extra: integer;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^);
      inc(UTF8Text);
      if c=0 then break else
      if c and $80=0 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) and $80=0 then begin
        Dest^ := AnsiChar(c);
        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 := 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 else
        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): PWideChar;
begin                           
  result := Dest+(UTF8ToWideChar(Dest,PUTF8Char(Source),SourceChars) shr 1);
  result^ := #0;
end;

function TSynAnsiUTF8.AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
  SourceChars: Cardinal): PUTF8Char;
begin
  move(Source^,Dest^,SourceChars);
  result := Dest+SourceChars;
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.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
begin
  result := Dest+RawUnicodeToUTF8(PUTF8Char(Dest),SourceChars,Source,SourceChars);
end;

function TSynAnsiUTF8.UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char;
  SourceChars: Cardinal): PAnsiChar;
begin
  move(Source^,Dest^,SourceChars);
  result := Dest+SourceChars;
end;

procedure TSynAnsiUTF8.UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal;
  var result: RawByteString);
begin
  SetString(Result,Source,SourceChars);
end;

function TSynAnsiUTF8.UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
begin
  result := UTF8;
end;

function TSynAnsiUTF8.AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
begin
  result := AnsiText;
end;

function TSynAnsiUTF8.AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8;
begin
  SetString(Result,Source,SourceChars);
end;


{ TSynAnsiUTF16 }

function TSynAnsiUTF16.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal): PWideChar;
begin
  move(Source^,Dest^,SourceChars);
  result := Pointer(PtrUInt(Dest)+SourceChars);
  result^ := #0;
end;

function TSynAnsiUTF16.AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar;
  SourceChars: Cardinal): PUTF8Char;
begin
  SourceChars := SourceChars shr 1; // from byte count to WideChar count
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,PWideChar(Source),SourceChars);
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
  move(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);
end;


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 UNICODE}var CodePage: Cardinal;{$endif}
begin
  if s='' then
    result := '' else begin
    {$ifdef UNICODE}
    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; overload;
begin
  result := IsAnsiCompatible(PAnsiChar(pointer(Text)),length(Text));
end;

function IsAnsiCompatible(PW: PWideChar): boolean; overload;
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; overload;
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
  SetString(result,PAnsiChar(@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 and $80=0 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
  SetRawUTF8(result,P,StrLen(P));
end;

function UTF8ToWideChar(dest: PWideChar; source: PUTF8Char; MaxDestChars, sourceBytes: PtrInt): 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 and $80=0 then begin
      dest^ := WideChar(c);
      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
      dest^ := WideChar(c);
      inc(dest);
      if (source<endsource) and (dest<endDest) then
        continue else
        break;
    end;
    dec(c,$10000); // store as UTF-16 surrogates
    dest[0] := WideChar(c shr 10  +UTF16_HISURROGATE_MIN);
    dest[1] := WideChar(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:
  dest^ := #0; // always append a WideChar(0) to the end of the buffer
end;

function UTF8ToWideChar(dest: pWideChar; source: PUTF8Char; sourceBytes: PtrInt=0): PtrInt;
// faster than System.UTF8Decode()
var c: cardinal;
    begd: pWideChar;
    endSource: PUTF8Char;
    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;
  begd := dest;
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  endSource := source+sourceBytes-4;
  if source<=endSource then
  repeat
    c := pCardinal(source)^;
    if c and $80808080<>0 then
      break; // 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>endSource;
  // generic loop, handling one UTF-8 code per iteration
  inc(endSource,4);
  if source<endSource then
  repeat
    c := byte(source^);
    inc(source);
    if c and $80=0 then begin
      dest^ := WideChar(c);
      inc(dest);
      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
      dest^ := WideChar(c);
      inc(dest);
      if source<endsource then
        continue else
        break;
    end;
    dec(c,$10000); // store as UTF-16 surrogates
    dest[0] := WideChar(c shr 10  +UTF16_HISURROGATE_MIN);
    dest[1] := WideChar(c and $3FF+UTF16_LOSURROGATE_MIN);
    inc(dest,2);
    if source>=endsource then
      break;
  until false;
Quit:
  result := PtrUInt(dest)-PtrUInt(begd); // dest-begd return char length
NoSource:
  dest^ := #0; // always append a WideChar(0) to the end of the buffer
end;

function Utf8ToUnicodeLength(source: PUTF8Char): PtrUInt;
var c: byte;
    extra,i: integer;
begin
  result := 0;
  if source<>nil then
  repeat
    c := byte(source^);
    inc(source);
    if c=0 then break else
    if c and $80=0 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: byte;
    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 and $80=0 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; maxUTF8: cardinal): boolean;
var L: cardinal;
begin
  L := length(text);
  if L<maxUTF8 then begin
    result := false;
    exit; // nothing to truncate
  end;
  while (L>0) and (ord(Text[L]) and $c0=$80) do dec(L);
  SetLength(text,L);
  result := true;
end;

function Utf8FirstLineToUnicodeLength(source: PUTF8Char): PtrInt;
var c: byte;
    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 and $80=0 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; overload;
var short: array[0..256*3] 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; overload;
begin
  if S='' then
    result := '' else
    result := Utf8DecodeToRawUnicode(pointer(S),PInteger(PtrInt(S)-sizeof(integer))^);
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; overload;
begin
  Dest := ''; // somewhat faster if Dest is freed before any SetLength()
  if S='' then begin
    result := 0;
    exit;
  end;
  result := PInteger(PtrInt(S)-sizeof(integer))^;
  SetLength(Dest,result*2+2);
  result := UTF8ToWideChar(pointer(Dest),Pointer(S),result);
end;

function RawUnicodeToUtf8(Dest: PUTF8Char; DestLen: PtrInt; Source: PWideChar; SourceLen: PtrInt): PtrInt; overload;
var c: Cardinal;
    Tail: PWideChar;
    i,j: integer;
begin
  result := PtrInt(Dest);
  if (Source<>nil) and (Dest<>nil) then begin
    // first handle 7 bit ASCII WideChars, by pairs (Sha optimization)
    SourceLen := SourceLen*2+PtrInt(Source);
    Tail := PWideChar(SourceLen)-2;
    if 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;
    // generic loop, handling one UCS4 char per iteration
    Inc(DestLen,PtrInt(Dest));
    if (PtrInt(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then
    repeat
      // inlined UTF16CharToUtf8()
      c := cardinal(Source^);
      inc(Source);
      case c of
      0..$7f: begin
        Dest^ := AnsiChar(c);
        inc(Dest);
        if (PtrInt(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then continue else break;
      end;
      UTF16_HISURROGATE_MIN..UTF16_HISURROGATE_MAX: begin
        if PtrInt(Source)>=SourceLen then break;
        c := ((c-$D7C0)shl 10)+(ord(Source^) xor UTF16_LOSURROGATE_MIN);
        inc(Source);
      end;
      UTF16_LOSURROGATE_MIN..UTF16_LOSURROGATE_MAX: begin
        if PtrInt(Source)>=SourceLen then break;
        c := ((cardinal(ord(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(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(Dest)<DestLen) and (PtrInt(Source)<SourceLen) then continue else break;
    until false;
    Dest^ := #0;
  end;
  result := PtrInt(Dest)-result;
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/458259 -> WideCharCount*3 below

procedure RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer; var result: RawUTF8);
var L,LW: integer;
    U8: array[0..511] of AnsiChar;
begin
  if (WideChar=nil) or (WideCharCount=0) then begin
    result := '';
    exit;
  end;
  LW := WideCharCount*3; // maximum resulting length
  if LW<SizeOf(U8) then begin // faster computation without temporary heap allocation
    SetRawUTF8(Result,@U8,RawUnicodeToUtf8(U8,sizeof(U8),WideChar,WideCharCount));
    exit;
  end;
  FastNewRawUTF8(result,LW);
  L := RawUnicodeToUtf8(pointer(result),LW+1,WideChar,WideCharCount);
  if L<=0 then
    result := '' else
    if L<>LW then
      SetLength(result,L);
end;

function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer): RawUTF8;
begin
  RawUnicodeToUTF8(WideChar,WideCharCount,result);
end;

function RawUnicodeToUtf8(WideChar: PWideChar; WideCharCount: integer; out UTF8Length: integer): RawUTF8; overload;
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);
  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; overload;
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; overload;
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;
{$endif}

{$ifdef UNICODE}
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}

{$ifdef UNICODE}
function Ansi7ToString(const Text: RawByteString): string;
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}
function Ansi7ToString(const Text: RawByteString): string;
begin
  result := Text; // if we are SURE this text is 7 bit Ansi -> direct assign
end;
{$endif}

{$ifdef UNICODE}
function Ansi7ToString(Text: PWinAnsiChar; Len: integer): string;
begin
  Ansi7ToString(Text,Len,result);
end;
{$else}
function Ansi7ToString(Text: PWinAnsiChar; Len: integer): string;
begin
  SetString(result,PAnsiChar(Text),Len);
end;
{$endif}

{$ifdef UNICODE}
procedure Ansi7ToString(Text: PWinAnsiChar; Len: integer; var result: string);
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}
procedure Ansi7ToString(Text: PWinAnsiChar; Len: integer; var result: string);
begin
  SetString(result,PAnsiChar(Text),Len);
end;
{$endif}

{$ifdef UNICODE}
function StringToAnsi7(const Text: string): RawByteString;
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}
function StringToAnsi7(const Text: string): RawByteString;
begin
  result := Text; // if we are SURE this text is 7 bit Ansi -> direct assign
end;
{$endif}

{$ifdef UNICODE}
function StringToWinAnsi(const Text: string): WinAnsiString;
begin
  result := RawUnicodeToWinAnsi(Pointer(Text),length(Text));
end;
{$else}
function StringToWinAnsi(const Text: string): WinAnsiString;
begin
  result := WinAnsiConvert.AnsiToAnsi(CurrentAnsiConvert,Text);
end;
{$endif}

{$ifdef UNICODE}
function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char;
begin
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,PWideChar(Source),SourceChars);
end;
{$else}
function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char;
begin
  result := CurrentAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);
end;
{$endif}

{$ifdef UNICODE}
function StringToUTF8(const Text: string): RawUTF8;
begin
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
end;
{$else}
function StringToUTF8(const Text: string): RawUTF8;
begin
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
end;
{$endif}

{$ifdef UNICODE}
procedure StringToUTF8(const Text: string; var result: RawUTF8);
begin
  RawUnicodeToUtf8(pointer(Text),length(Text),result);
end;
{$else}
procedure StringToUTF8(const Text: string; var result: RawUTF8);
begin
  result := CurrentAnsiConvert.AnsiToUTF8(Text);
end;
{$endif}

procedure Int32ToUTF8(Value : integer; var result: RawUTF8);
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[15],Value);
  SetRawUTF8(result,P,@tmp[15]-P);
end;

procedure Int64ToUtf8(Value: Int64; var result: RawUTF8);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt64(@tmp[23],Value);
  SetRawUTF8(result,P,@tmp[23]-P);
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:   value := V.VInt64^;
    else begin
      result := false;
      exit;
    end;
  end;
  result := true;
end;

procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8; wasString: PBoolean=nil);
var isString: boolean;
begin
  isString := not (V.VType in [vtBoolean,vtInteger,vtInt64,vtCurrency,vtExtended]);
  with V do
  case V.VType of
    vtString:
      result := VString^;
    vtAnsiString:
      result := RawUTF8(VAnsiString); // expect UTF-8 content
    {$ifdef UNICODE}
    vtUnicodeString:
      result := UnicodeStringToUtf8(string(VUnicodeString));
    {$endif}
    vtWideString:
      RawUnicodeToUtf8(VWideString,length(WideString(VWideString)),result);
    vtPChar:
      result := VPChar;
    vtChar:
      SetRawUTF8(result,PAnsiChar(@VChar),1);
    vtPWideChar:
      RawUnicodeToUtf8(VPWideChar,StrLenW(VPWideChar),result);
    vtWideChar:
      RawUnicodeToUtf8(@VWideChar,1,result);
    vtBoolean:
      if VBoolean then result := '1' else result := '0';
    vtInteger:
      Int32ToUtf8(VInteger,result);
    vtInt64:
      Int64ToUtf8(VInt64^,result);
    vtCurrency:
      Curr64ToStr(VInt64^,result);
    vtExtended:
      ExtendedToStr(VExtended^,DOUBLE_PRECISION,result);
    vtPointer:
      PointerToHex(VPointer,result);
    vtClass:
      if VClass<>nil then
        result := PShortString(PPointer(PtrInt(VClass)+vmtClassName)^)^ else
        result := '';
    vtObject:
       if VObject<>nil then
         result := PShortString(PPointer(PPtrInt(VObject)^+vmtClassName)^)^ else
         result := '';
    vtInterface:
      {$ifdef ISDELPHI2010}
      if VInterface<>nil then 
        result := PShortString(PPointer(PPtrInt(IInterface(VInterface) as TObject)^+vmtClassName)^)^ else
        result := '';
      {$else}
      {$ifdef FPC}
      if VInterface<>nil then
        result := PShortString(PPointer(PPtrInt(IInterface(VInterface) as TObject)^+vmtClassName)^)^ else
        result := '';
      {$else}
      PointerToHex(VInterface,result);
      {$endif}
      {$endif}
    {$ifndef NOVARIANTS}
    vtVariant:
      VariantToUTF8(VVariant^,result,isString);
    {$endif}
    else begin
      isString := false;
      result := '';
    end;
  end;
  if wasString<>nil then
    wasString^ := isString;
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; overload;
begin
  SetString(result,P,L);
end;
{$else}
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);
end;
{$endif}

{$ifdef UNICODE}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;
begin
  SetString(result,P,L);
end;
{$else}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;
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}
  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); overload;
var short: array[0..256*3] 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); overload;
begin
  UTF8ToSynUnicode(pointer(Text),length(Text),result);
end;

procedure UTF8ToSynUnicode(Text: PUTF8Char; Len: integer; var result: SynUnicode); overload;
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 CPU64DELPHI}
asm // rcx=P, rdx=val
    .NOFRAME
    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,TwoDigitLookupW
@s: cmp rax,100
    lea rcx,rcx-2
    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}
{$ifdef PUREPASCAL}
begin // this code is faster than the Borland's original str() or IntToStr()
  if val<0 then begin
    result := StrUInt32(P,PtrUInt(-val))-1;
    result^ := '-';
  end else
    result := StrUInt32(P,val);
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
    nop; nop           // for loop alignment
@s: cmp eax,100
    lea edi,[edi-2]
    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 [TwoDigitLookupW+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
    lea eax,[eax+ecx] // includes '-' if val<0
    ret
@2: movzx eax,word ptr [TwoDigitLookupW+eax*2]
    mov byte ptr [edi-1],'-'
    mov [edi],ax
    mov eax,edi
    pop edi
    pop ecx
    lea eax,[eax+ecx] // includes '-' if val<0
    ret
@3: dec eax
    pop ecx
    or dl,'0'
    mov byte ptr [eax-1],'-'
    mov [eax],dl
    lea eax,[eax+ecx] // includes '-' if val<0
end;
{$endif CPU64}
{$endif PUREPASCAL}

function StrUInt32(P: PAnsiChar; val: PtrUInt): PAnsiChar;
{$ifdef CPU64DELPHI}
asm // rcx=P, rdx=val
    .NOFRAME
    cmp rdx,10; jb @3           // direct process of common val<10
    mov rax,rdx
    lea r8,TwoDigitLookupW
@s: cmp rax,100
    lea rcx,rcx-2
    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: 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}
{$ifdef PUREPASCAL}
var c100: PtrUInt;
begin // this code is faster than the Borland's original str() or IntToStr()
  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)^ := TwoDigitLookupW[val];
      break;
    end;
    dec(P,2);
    c100 := val div 100;
    dec(val,c100*100);
    PWord(P)^ := TwoDigitLookupW[val];
    val := c100;
    if c100=0 then break;
  until false;
  result := P;
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           // for loop alignment
@s: cmp eax,100
    lea edi,[edi-2]
    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 [TwoDigitLookupW+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 [TwoDigitLookupW+eax*2]
    mov [edi],ax
    mov eax,edi
    pop edi
    ret
@3: dec eax
    or dl,'0'
    mov [eax],dl
end;
{$endif CPU64}
{$endif PUREPASCAL}

function StrUInt64(P: PAnsiChar; const val: QWord): PAnsiChar;
{$ifdef CPU64}
begin // StrUInt32 aldready implemented PtrUInt=UInt64
  result := StrUInt32(P,val);
end;
{$else}
var c,c100: QWord;
begin
  if Int64Rec(val).Hi=0 then
    P := StrUInt32(P,Int64Rec(val).Lo) else begin
    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)^ := TwoDigitLookupW[c];
      c := c100;
      if Int64Rec(c).Hi=0 then begin
        if Int64Rec(c).Lo<>0 then
          P := StrUInt32(P,Int64Rec(c).Lo);
        break;
      end;
    until false;
  end;
  result := P;
end;
{$endif}

function StrInt64(P: PAnsiChar; const val: Int64): PAnsiChar;
begin
  if val<0 then begin
    P := StrUInt64(P,-val)-1;
    P^ := '-';
  end else
    P := StrUInt64(P,val);
  result := P;
end;


// some minimal RTTI const and types

{$ifdef CPU64}
procedure Exchg16(P1,P2: PInt64Array);
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: integer);
{$ifdef PUREPASCAL}
var i,c: integer;
    u: AnsiChar;
begin
  for i := 1 to count shr 2 do begin
    c := PInteger(P1)^;
    PInteger(P1)^ := PInteger(P2)^;
    PInteger(P2)^ := c;
    inc(P1,4);
    inc(P2,4);
  end;
  if count and 3<>0 then
    for i := 0 to (count and 3)-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:dec ecx
   mov ebx,[eax]
   mov esi,[edx]
   mov [eax],esi
   mov [edx],ebx
   lea eax,eax+4
   lea edx,edx+4
   jnz @4
@2:pop ecx
   and ecx,3
   jz @0
@1:dec ecx
   mov bl,[eax]
   mov bh,[edx]
   mov [eax],bh
   mov [edx],bl
   lea eax,eax+1
   lea edx,edx+1
   jnz @1
@0:pop esi
   pop ebx
end;
{$endif}

{$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);

const
   // all potentially managed types
   tkManagedTypes = [tkLStringOld,tkLString,tkWstring,tkUstring,tkArray,
                     tkObject,tkRecord,tkDynArray,tkInterface,tkVariant];
   // maps record or object types
   tkRecordTypes = [tkObject,tkRecord];

{$else}

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

{$endif}

type
  TOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
  TFloatType = (ftSingle,ftDoub,ftExtended,ftComp,ftCurr);
  PTypeKind = ^TTypeKind;
  
  PStrRec = ^TStrRec;
  /// map the Delphi string header, as defined in System.pas
  TStrRec =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    {$ifdef FPC}
    {$ifdef ISFPC27}
    codePage: Word;
    elemSize: Word;
    {$endif}
    {$ifdef CPU64}
    _Padding: LongInt;
    {$endif}
    refCnt: SizeInt;
    length: SizeInt;
{$else}
{$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 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 2009
    elemSize: Word;
{$endif UNICODE}
    /// string reference count (basic garbage memory mechanism)
    refCnt: Longint;
    /// length in characters
    // - size in bytes = length*elemSize
    length: Longint;
{$endif FPC}
  end;

  /// map the Delphi dynamic array header (stored before each instance)
  TDynArrayRec =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    {$ifdef CPUX64}
    _Padding: LongInt; // Delphi XE2+ expects 16 byte alignment
    {$endif}
    /// dynamic array reference count (basic garbage memory mechanism)
    {$ifdef FPC}
    refCnt: PtrInt;
    high: tdynarrayindex;
    function GetLength: sizeint; inline;
    procedure SetLength(len: sizeint); inline;
    property length: sizeint read GetLength write SetLength;
    {$else}
    refCnt: Longint;
    /// length in element count
    // - size in bytes = length*ElemSize
    length: PtrInt;
    {$endif}
  end;
  PDynArrayRec = ^TDynArrayRec;

  {$ifdef FPC}
  {$PACKRECORDS C}
  {$endif}

  /// map the Delphi dynamic array RTTI
  PDynArrayTypeInfo = ^TDynArrayTypeInfo;
  TDynArrayTypeInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    kind: TTypeKind;
    NameLen: Byte;
    {$ifdef FPC}
    elSize: SizeUInt;
    elType2: PDynArrayTypeInfo;
    varType: LongInt;
    elType: PDynArrayTypeInfo;
    //DynUnitName: ShortStringBase;
    {$else}
    // storage byte count for this field
    elSize: Longint;
    // nil for unmanaged field
    elType: ^PDynArrayTypeInfo;
    // OleAuto compatible type
    varType: Integer;
    // also unmanaged field
    elType2: ^PDynArrayTypeInfo;
    {$endif}
  end;

  /// map the Delphi static array RTTI
  PArrayTypeInfo = ^TArrayTypeInfo;
  TArrayTypeInfo =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    Size: Integer;
    // product of lengths of all dimensions
    elCount: Integer;
    elType: ^PDynArrayTypeInfo;
    dimCount: Byte;
    dims: array[0..255 {DimCount-1}] of ^PDynArrayTypeInfo;
  end;


  /// map the Delphi record field RTTI
  TFieldInfo =
    //{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    //{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    {$ifdef FPC}
    TypeInfo: PDynArrayTypeInfo;
    Offset: sizeint;
    {$else}
    TypeInfo: ^PDynArrayTypeInfo;
    Offset: PtrUInt;
    {$endif FPC}
  end;

  {$ifdef ISDELPHI2010}
  /// map the Delphi record field enhanced RTTI (available since Delphi 2010)
  TEnhancedFieldInfo = packed record
    TypeInfo: ^PDynArrayTypeInfo;
    Offset: PtrUInt;
    Flags: Byte;
    NameLen: byte; // = Name[0] = length(Name)
  end;
  PEnhancedFieldInfo = ^TEnhancedFieldInfo;
  {$endif}

  /// map the Delphi record RTTI
  TFieldTable =
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    Kind: TTypeKind;
    NameLen: byte; // = Name[0] = length(Name)
    Size: cardinal;
    ManagedCount: integer;
    ManagedFields: array[0..0] of TFieldInfo;
    {$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}
  end;
  PFieldTable = ^TFieldTable;

const
  /// codePage offset = string header size
  // - used to calc the beginning of memory allocation of a string
  STRRECSIZE = SizeOf(TStrRec);

procedure SetRawUTF8(var Dest: RawUTF8; text: pointer; len: integer);
{$ifdef FPC}inline;
begin
  if (len>128) or (len=0) or (text<>pointer(Dest)) then
    SetString(Dest,PAnsiChar(text),len) else
    SetLength(Dest,len);
end;
{$else}
{$ifdef PUREPASCAL}
var P: PStrRec;
begin
  if (len>128) or (len=0) or (PtrInt(Dest)=0) or     // Dest=''
    (PStrRec(PtrInt(Dest)-STRRECSIZE)^.refCnt<>1) then 
    SetString(Dest,PAnsiChar(text),len) else begin
    if PStrRec(Pointer(PtrInt(Dest)-STRRECSIZE))^.length<>len then begin
      P := Pointer(PtrInt(Dest)-STRRECSIZE);
      ReallocMem(P,len+(STRRECSIZE+1));
      P^.length := len;
      pointer(Dest) := pointer(PAnsiChar(P)+STRRECSIZE);
      PByteArray(Dest)[len] := 0;
    end;
    Move(pointer(text)^,pointer(Dest)^,len);
  end;
end;
{$else}
asm // eax=@Dest text=edx len=ecx
    cmp ecx,128 // avoid huge move() in ReallocMem()
{$ifdef UNICODE}
    ja @3
{$else}
    ja System.@LStrFromPCharLen
{$endif}
    or ecx,ecx // len=0
{$ifdef UNICODE}
    jz @3
{$else}
    jz System.@LStrFromPCharLen
{$endif}
    push ebx
    mov ebx,[eax]
    test ebx,ebx
    jnz @2
@0: pop ebx
{$ifdef UNICODE}
@3: push CP_UTF8 // UTF-8 code page for Delphi 2009+
    call System.@LStrFromPCharLen // we need a call, not a jmp here
    ret
{$else}
    jmp System.@LStrFromPCharLen
{$endif}
@2: cmp dword ptr [ebx-8],1
    jne @0
    cmp dword ptr [ebx-4],ecx
    je @1
    sub ebx,STRRECSIZE
    push edx
    push eax
    push ecx
    push ebx
    mov eax,esp // ReallocMem() over ebx pointer on stack
    lea edx,ecx+STRRECSIZE+1
    call System.@ReallocMem
    pop ebx
    pop ecx
    add ebx,STRRECSIZE
    pop eax
    pop edx
    mov [eax],ebx
    mov dword ptr [ebx-4],ecx
    mov byte ptr [ebx+ecx],0
@1: mov eax,edx
    mov edx,ebx
    call Move
    pop ebx
end;
{$endif}
{$endif}

function UniqueRawUTF8(var UTF8: RawUTF8): pointer;
begin
  {$ifdef FPC}
  UniqueString(UTF8); // @UTF8[1] won't call UniqueString() under FPC :(
  {$endif}
  result := @UTF8[1];
end;

{$ifdef FPC}
function TDynArrayRec.GetLength: sizeint;
begin
  result := high+1;
end;

procedure TDynArrayRec.SetLength(len: sizeint);
begin
  high := len-1;
end;
{$endif}

function DynArrayLength(Value: Pointer): integer;
  {$ifdef HASINLINE}inline;{$endif}
begin
  if Value=nil then
    result := 0 else begin
    dec(PtrUInt(Value),SizeOf(TDynArrayRec));
    result := PDynArrayRec(Value)^.length;
  end;
end;

function TypeInfoToRecordInfo(aDynArrayTypeInfo: pointer;
  aDataSize: PInteger=nil): pointer;
var Typ: PDynArrayTypeInfo absolute aDynArrayTypeInfo;
begin
  result := nil;
  if (aDynArrayTypeInfo<>nil) and (Typ^.kind=tkDynArray) then begin
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    Typ := GetFPCAlignPtr(Typ);
    {$else}
    inc(PtrUInt(Typ),Typ^.NameLen);
    {$endif}
    if Typ^.elType<>nil then
      result := Typ^.elType{$ifndef FPC}^{$endif};
    if aDataSize<>nil then
      aDataSize^ := Typ^.elSize;
  end;
end;

procedure TypeInfoToName(aTypeInfo: pointer; var result: RawUTF8;
  const default: RawUTF8='');
var Typ: PDynArrayTypeInfo absolute aTypeInfo;
begin
  if Typ<>nil then
    SetRawUTF8(result,PAnsiChar(@Typ.NameLen)+1,Typ.NameLen) else
    result := default;
end;

function TypeInfoToName(aTypeInfo: pointer): RawUTF8;
begin
  TypeInfoToName(aTypeInfo,Result,'');
end;

function RecordTypeInfoFieldTable(aRecordTypeInfo: Pointer): PFieldTable;
  {$ifdef HASINLINE}inline;{$endif}
begin
  result := aRecordTypeInfo;
  if (result=nil) or not(result^.Kind in tkRecordTypes) then begin
    result := nil;
    exit;
  end;
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  result := GetFPCAlignPtr(result);
  {$else}
  inc(PtrUInt(result),result^.NameLen);
  {$endif}
end;

function RecordTypeInfoSize(aRecordTypeInfo: Pointer): integer;
var FieldTable: PFieldTable;
begin
  FieldTable := RecordTypeInfoFieldTable(aRecordTypeInfo);
  if FieldTable=nil then
    result := 0 else
    result := FieldTable^.Size;
end;

function TypeInfoSize(aTypeInfo: pointer): integer;
begin
  if aTypeInfo=nil then
    result := 0 else begin
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    aTypeInfo := GetFPCAlignPtr(aTypeInfo);
    {$else}
    inc(PtrUInt(aTypeInfo),PFieldTable(aTypeInfo)^.NameLen);
    {$endif}
    result := PFieldTable(aTypeInfo)^.Size;
  end;
end;


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

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:  Value := ord(VBoolean);
  varSmallint: Value := VSmallInt;
  {$ifndef DELPHI5OROLDER}
  varShortInt: Value := VShortInt;
  varWord:     Value := VWord;
  varLongWord:
    if (VLongWord>=cardinal(Low(integer))) and (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
    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 VariantToInt64(const V: Variant; var Value: Int64): boolean;
var tmp: TVarData;
begin
  with TVarData(V) do
  case VType of
  varNull,
  varEmpty:    Value := 0;
  varBoolean:  Value := ord(VBoolean);
  varSmallint: Value := VSmallInt;
  {$ifndef DELPHI5OROLDER}
  varShortInt: Value := VShortInt;
  varWord:     Value := VWord;
  varLongWord: Value := VLongWord;
  {$endif}
  varByte:     Value := VByte;
  varInteger:  Value := VInteger;
  varWord64,
  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}

procedure VariantToInlineValue(const V: Variant; var result: RawUTF8);
var wasString: boolean;
begin
  VariantToUTF8(V,result,wasString);
  if wasString then
    result := QuotedStr(pointer(result),'"');
end;

procedure VariantToUTF8(const V: Variant; var result: RawUTF8;
  var wasString: boolean); overload;
var tmp: TVarData;
begin
  wasString := false;
  with TVarData(V) do
  case VType of
  varEmpty,
  varNull:
    result := 'null';
  varSmallint:
    Int32ToUTF8(VSmallInt,result);
  {$ifndef DELPHI5OROLDER}
  varShortInt:
    Int32ToUTF8(VShortInt,result);
  varWord:
    UInt32ToUTF8(VWord,result);
  varLongWord:
    UInt32ToUTF8(VLongWord,result);
  {$endif}
  varByte,
  varBoolean:
    UInt32ToUTF8(VByte,result);
  varInteger:
    Int32ToUTF8(VInteger,result);
  varInt64,
  varWord64:
    Int64ToUTF8(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 UNICODE}
    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 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(UnicodeString(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;

procedure VariantDynArrayClear(var Value: TVariantDynArray);
var p: PDynArrayRec;
    V: PVarData;
    i: integer;
    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;
  if (V^.VType>varNativeString) and
     FindCustomVariantType(V^.VType,handler) then begin
    for i := 1 to p^.length do begin
      // faster clear of custom variant uniformous array
      if V^.VType=handler.VarType then
        handler.Clear(V^) else
      if not (V^.VType in VTYPE_STATIC) then
        VarClear(variant(V^));
      inc(V);
    end;
  end else
  for i := 1 to p^.length do begin
    if not (V^.VType in VTYPE_STATIC) then
      VarClear(variant(V^));
    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..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[15],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[15]-P,result);
end;

function IntToString(Value: cardinal): string;
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[15],Value);
  Ansi7ToString(PWinAnsiChar(P),@tmp[15]-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}

function IntToString(Value: integer): string;
{$ifdef PUREPASCAL}
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[15],Value);
  SetString(result,P,@tmp[15]-P);
end;
{$else}
asm
  jmp Int32ToUTF8
end;
{$endif}

function IntToString(Value: cardinal): string;
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[15],Value);
  SetString(result,P,@tmp[15]-P);
end;

function IntToString(Value: Int64): string;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt64(@tmp[31],Value);
  SetString(result,P,@tmp[31]-P);
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}

{$ifdef CPU64}
function bswap32(a: cardinal): cardinal; {$ifdef FPC}nostackframe; assembler;{$endif}
asm
  {$ifdef FPC} // see function SwapEndian() in x86_64.inc
  {$ifdef win64}
  mov %eax,%ecx
  {$else}
  mov %eax,%edi
  {$endif win64}
  bswap %eax
  {$else}
  .NOFRAME
  mov eax,ecx
  bswap eax
  {$endif}
end;
{$else}
{$ifdef PUREPASCAL}
function bswap32(a: cardinal): cardinal; {$ifdef HASINLINE}inline;{$endif}
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;
{$else}
function bswap32(a: cardinal): cardinal;
asm
  bswap eax
end;
{$endif}
{$endif CPU64}

{$ifndef ENHANCEDRTL} { our Enhanced Runtime (or LVCL) library contain fast asm versions }

{ code below was extracted from our Enhanced Runtime (or LVCL) library
   and increases the framework performance
  - not compiled with FPC, since does call some low-level system.pas functions  }

{$ifndef PUREPASCAL} { these functions are implemented in asm }
{$ifndef LVCL} { don't define these functions twice }
{$ifndef FPC}  { these asm function use some low-level system.pas calls }

{$define OWNI2S}

function Int32ToUTF8(Value : integer): RawByteString; // 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 Digits 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=Digits (Including Sign Character)}
  mov    ecx,[edx]              {result}
  test   ecx,ecx
  je     @@NewStr               {Create New string for result}
  cmp    dword ptr [ecx-8], 1
  jne    @@ChangeStr            {Reference Count <> 1}
  cmp    esi,[ecx-4]
  je     @@LengthOk             {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    @@LengthOk
@@ChangeStr:
  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)}
@@LengthOk:
  mov    byte ptr [ecx],'-'      {Store '-' Character (May be Overwritten)}
  add    esi,ebx                 {Digits (Excluding Sign Character)}
  sub    ecx,ebx                 {Destination of 1st Digit}
  sub    esi,2                   {Digits (Excluding Sign Character) - 2}
  jle    @@FinalDigits           {1 or 2 Digit Value}
  cmp    esi,8                   {10 Digit Value?}
  jne    @@SetResult             {Not a 10 Digit Value}
  sub    eax,2000000000          {Digit 10 must be either '1' or '2'}
  mov    dl,'2'
  jnc    @@SetDigit10            {Digit 10 = '2'}
  mov    dl,'1'                  {Digit 10 = '1'}
  add    eax,1000000000
@@SetDigit10:
  mov    [ecx],dl                {Save Digit 10}
  mov    esi,7                   {9 Digits Remaining}
  add    ecx,1                   {Destination of 2nd Digit}
@@SetResult:
  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 Digits Remaining}
@@FinalDigits:
  pop    esi
  pop    edi
  pop    ebx
  jnz    @@LastDigit
  movzx  eax,word ptr [TwoDigitLookup+eax*2]
  mov    [ecx],ax                {Save Final 2 Digits}
  ret
@@LastDigit:
  or     al,'0'                  {Ascii Adjustment}
  mov    [ecx],al                {Save Final Digit}
end;

function Int64ToUTF8(Value: Int64): RawByteString;
// from IntToStr64_JOH_IA32_6_b, adapted for Delphi 2009+ 
asm
  push   ebx
  mov    ecx, [ebp+8]            {Low Integer of Value}
  mov    edx, [ebp+12]           {High Integer of Value}
  xor    ebp, ebp                {Clear Sign Flag (EBP Already Pushed)}
  mov    ebx, ecx                {Low Integer of Value}
  test   edx, edx
  jnl    @@AbsValue
  mov    ebp, 1                  {EBP = 1 for -ve Value or 0 for +ve Value}
  neg    ecx
  adc    edx, 0
  neg    edx
@@AbsValue:                      {EDX:ECX = Abs(Value)}
  jnz    @@Large
  test   ecx, ecx
  js     @@Large
  mov    edx, eax                {@Result}
  mov    eax, ebx                {Low Integer of Value}
  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
@@Test15:                        {Test for 15 or More Digits}
  cmp    edx, $00005af3          {100000000000000 div $100000000}
  jne    @@Check15
  cmp    ecx, $107a4000          {100000000000000 mod $100000000}
@@Check15:
  jb     @@Test13
@@Test17:                        {Test for 17 or More Digits}
  cmp    edx, $002386f2          {10000000000000000 div $100000000}
  jne    @@Check17
  cmp    ecx, $6fc10000          {10000000000000000 mod $100000000}
@@Check17:
  jb     @@Test15or16
@@Test19:                        {Test for 19 Digits}
  cmp    edx, $0de0b6b3          {1000000000000000000 div $100000000}
  jne    @@Check19
  cmp    ecx, $a7640000          {1000000000000000000 mod $100000000}
@@Check19:
  jb     @@Test17or18
  mov    al, 19
  jmp    @@SetLength
@@Test17or18:                    {17 or 18 Digits}
  mov    bl, 18
  cmp    edx, $01634578          {100000000000000000 div $100000000}
  jne    @@SetLen
  cmp    ecx, $5d8a0000          {100000000000000000 mod $100000000}
  jmp    @@SetLen
@@Test15or16:                    {15 or 16 Digits}
  mov    bl, 16
  cmp    edx, $00038d7e          {1000000000000000 div $100000000}
  jne    @@SetLen
  cmp    ecx, $a4c68000          {1000000000000000 mod $100000000}
  jmp    @@SetLen
@@Test13:                        {Test for 13 or More Digits}
  cmp    edx, $000000e8          {1000000000000 div $100000000}
  jne    @@Check13
  cmp    ecx, $d4a51000          {1000000000000 mod $100000000}
@@Check13:
  jb     @@Test11
@@Test13or14:                    {13 or 14 Digits}
  mov    bl, 14
  cmp    edx, $00000918          {10000000000000 div $100000000}
  jne    @@SetLen
  cmp    ecx, $4e72a000          {10000000000000 mod $100000000}
  jmp    @@SetLen
@@Test11:                        {10, 11 or 12 Digits}
  cmp    edx, $02                {10000000000 div $100000000}
  jne    @@Check11
  cmp    ecx, $540be400          {10000000000 mod $100000000}
@@Check11:
  mov    bl, 11
  jb     @@SetLen                {10 Digits}
@@Test11or12:                    {11 or 12 Digits}
  mov    bl, 12
  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
@@SetLength:                     {Abs(Value) in EDX:ECX, Digits in EAX}
  push   ecx                     {Save Abs(Value)}
  push   edx
  lea    edx, [eax+ebp]          {Digits Needed (Including Sign Character)}
  mov    ecx, [edi]              {@Result}
  mov    esi, edx                {Digits Needed (Including Sign Character)}
  test   ecx, ecx
  je     @@NewStr                {Create New AnsiString for Result}
  cmp    dword ptr [ecx-8], 1
  jne    @@ChangeStr             {Reference Count <> 1}
  cmp    esi, [ecx-4]
  je     @@LengthOk              {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 AnsiString}
  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    @@LengthOk
@@ChangeStr:
  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(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)}
@@LengthOk:
  mov    edi, [edi]              {@Result}
  sub    esi, ebp                {Digits Needed (Excluding Sign Character)}
  mov    byte ptr [edi], '-'     {Store '-' Character (May be Overwritten)}
  add    edi, ebp                {Destination of 1st Digit}
  pop    edx                     {Restore Abs(Value)}
  pop    eax
  cmp    esi, 17
  jl     @@LessThan17Digits      {Digits < 17}
  je     @@SetDigit17            {Digits = 17}
  cmp    esi, 18
  je     @@SetDigit18            {Digits = 18}
  mov    cl, '0' - 1
  mov    ebx, $a7640000          {1000000000000000000 mod $100000000}
  mov    ebp, $0de0b6b3          {1000000000000000000 div $100000000}
@@CalcDigit19:
  add    ecx, 1
  sub    eax, ebx
  sbb    edx, ebp
  jnc    @@CalcDigit19
  add    eax, ebx
  adc    edx, ebp
  mov    [edi], cl
  add    edi, 1
@@SetDigit18:
  mov    cl, '0' - 1
  mov    ebx, $5d8a0000          {100000000000000000 mod $100000000}
  mov    ebp, $01634578          {100000000000000000 div $100000000}
@@CalcDigit18:
  add    ecx, 1
  sub    eax, ebx
  sbb    edx, ebp
  jnc    @@CalcDigit18
  add    eax, ebx
  adc    edx, ebp
  mov    [edi], cl
  add    edi, 1
@@SetDigit17:
  mov    cl, '0' - 1
  mov    ebx, $6fc10000          {10000000000000000 mod $100000000}
  mov    ebp, $002386f2          {10000000000000000 div $100000000}
@@CalcDigit17:
  add    ecx, 1
  sub    eax, ebx
  sbb    edx, ebp
  jnc    @@CalcDigit17
  add    eax, ebx
  adc    edx, ebp
  mov    [edi], cl
  add    edi, 1                  {Update Destination}
  mov    esi, 16                 {Set 16 Digits Left}
@@LessThan17Digits:              {Process Next 8 Digits}
  mov    ecx, 100000000          {EDX:EAX = Abs(Value) = Dividend}
  div    ecx
  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 Digits}
  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 Digits}
  mov    eax, ebp                {Remainder}
  sub    esi, 10                 {Digits Left - 2}
  jz     @@Last2Digits
@@SmallLoop:                     {Process Remaining Digits}
  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     @@SmallLoop             {Repeat Until Less than 2 Digits Remaining}
  jz     @@Last2Digits
  or     al , '0'                {Ascii Adjustment}
  mov    [edi], al               {Save Final Digit}
  jmp    @@Done
@@Last2Digits:
  movzx  eax, word ptr [TwoDigitLookup+eax*2]
  mov    [edi], ax               {Save Final 2 Digits}
@@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  @@TrimLeft                {Yes, Trim Leading Spaces}
  cmp  byte ptr [edx+ecx-1],' '  {S[Length(S)] <= ' '?}
  jbe  @@TrimRight               {Yes, Trim Trailing Spaces}
  jmp  System.@LStrLAsg          {No, Result := S (which occurs most time)}
@@TrimLeft:                      {Strip Leading Whitespace}
  dec  ecx
  jle  System.@LStrClr           {All Whitespace}
  inc  edx
  cmp  byte ptr [edx],' '
  jbe  @@TrimLeft
@@CheckDone:
  cmp  byte ptr [edx+ecx-1],' '
{$ifdef UNICODE}
  jbe  @@TrimRight
  push CP_UTF8 // UTF-8 code page for Delphi 2009+
  call  System.@LStrFromPCharLen // we need a call, not a jmp here
  ret
{$else}
  ja   System.@LStrFromPCharLen
{$endif}
@@TrimRight:                     {Strip Trailing Whitespace}
  dec  ecx
  jmp  @@CheckDone
end;

function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
asm // eax=P1 edx=P2 ecx=Length
    cmp eax,edx
    push  ebx
    je    @@True                { P1=P2 }
    sub   ecx, 8
    jl    @@Small
    mov   ebx, [eax]         {Compare First 4 Bytes}
    cmp   ebx, [edx]
    jne   @@False
    lea   ebx, [eax+ecx]     {Compare Last 8 Bytes}
    add   edx, ecx
    mov   eax, [ebx]
    cmp   eax, [edx]
    jne   @@False
    mov   eax, [ebx+4]
    cmp   eax, [edx+4]
    jne   @@False
    sub   ecx, 4
    jle   @@True             {All Bytes already Compared}
    neg   ecx                {-(Length-12)}
    add   ecx, ebx           {DWORD Align Reads}
    and   ecx, -4
    sub   ecx, ebx
@@LargeLoop:               {Compare 8 Bytes per Loop}
    mov   eax, [ebx+ecx]
    cmp   eax, [edx+ecx]
    jne   @@False
    mov   eax, [ebx+ecx+4]
    cmp   eax, [edx+ecx+4]
    jne   @@False
    add   ecx, 8
    jl    @@LargeLoop
@@True:
    mov   al, 1
    pop   ebx
    ret
@Table:
    dd @@true, @1, @2, @3, @4, @5, @6, @7
@@Small: // ecx=0..7
    add   ecx, 8
    jle   @@True             {Length <= 0}
    jmp dword ptr [ecx*4+@Table]
@7: mov bl,[eax+6]; cmp bl,[edx+6]; jne @@False
@6: mov bh,[eax+5]; cmp bh,[edx+5]; jne @@False
@5: mov cl,[eax+4]; cmp cl,[edx+4]; jne @@False
@4: mov ch,[eax+3]; cmp ch,[edx+3]; jne @@False
@3: mov bl,[eax+2]; cmp bl,[edx+2]; jne @@False
@2: mov bh,[eax+1]; cmp bh,[edx+1]; jne @@False
@1: mov al,[eax];   cmp al,[edx];   je @@True
@@False:
  xor   eax, eax
  pop   ebx
end;
{$endif FPC}  { these asm function had some low-level system.pas calls }

{$ifndef ISDELPHI2007ANDUP}
{$endif ISDELPHI2007ANDUP}

{$endif LVCL}
{$endif PUREPASCAL}
{$endif ENHANCEDRTL}

{$ifdef PUREPASCAL} // from Aleksandr Sharahov's PosEx_Sha_Pas_2()
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt = 1): Integer;
var len, lenSub: PtrInt;
    ch: AnsiChar;
    p, pSub, pStart, pStop: PUTF8Char;
label Loop0, Loop4, TestT, Test0, Test1, Test2, Test3, Test4,
      AfterTestT, AfterTest0, Ret, Exit;
begin;
  pSub := pointer(SubStr);
  p := pointer(S);
  if (p=nil) or (pSub=nil) or (Offset<1) then begin
    Result := 0;
    goto Exit;
  end;
  lenSub := pinteger(pSub-4)^;
  dec(lenSub);
  len := pinteger(p-4)^;
  if (len<lenSub+Offset) or (lenSub<0) then begin
    Result := 0;
    goto Exit;
  end;
  pStop := p+len;
  p := p+lenSub;
  pSub := pSub+lenSub;
  pStart := p;
  p := p+Offset+3;
  ch := pSub[0];
  lenSub := -lenSub;
  if p<pStop then goto Loop4;
  p := p-4;
  goto Loop0;
Loop4:
  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;
Loop0:
  if ch=p[0] then goto Test0;
AfterTest0:
  if ch=p[1] then goto TestT;
AfterTestT:
  p := p+6;
  if p<pStop then goto Loop4;
  p := p-4;
  if p<pStop then goto Loop0;
  Result := 0;
  goto Exit;
Test3: p := p-2;
Test1: p := 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;
    len := len+2;
  until len>=0;
  p := p+2;
  if p<=pStop then goto Ret;
  Result := 0;
  goto Exit;
Test4: p := p-2;
Test2: p := p-2;
Test0: len := lenSub;
  if lenSub<>0 then
  repeat
    if (psub[len]<>p[len]) or (psub[len+1]<>p[len+1]) then
      goto AfterTest0;
    len := len+2;
  until len>=0;
  inc(p);
Ret:
  Result := p-pStart;
Exit:
end;
{$else}
function PosEx(const SubStr, S: RawUTF8; Offset: PtrUInt = 1): Integer;
asm  // eax=SubStr, edx=S, ecx=Offset
  push    ebx
  push    esi
  push    edx                 // @Str
  test    eax,eax
  jz      @@NotFound          // Exit if SubStr = ''
  test    edx,edx
  jz      @@NotFound          // Exit if Str = ''
  mov     esi,ecx             
  mov     ecx,[edx-4]         // Length(Str)
  mov     ebx,[eax-4]         // Length(Search string)
  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      @@NotFound          // StartPos > Max Start Pos
  cmp     ebx,1               // Length(SubStr)
  jle     @@SingleChar        // Length(SubStr) <= 1
  push    edi
  push    ebp
  lea     edi,[ebx-2]         // edi = Length(Search string) - 2
  mov     esi,eax             // esi = Search string
  movzx   ebx,byte ptr [eax]  // bl = Search Character
@@Loop:                       // Compare 2 Characters per Loop
  cmp     bl,[edx]
  je      @@Char1Found
@@NotChar1:
  cmp     bl,[edx+1]
  je      @@Char2Found
@@NotChar2:
  lea     edx,[edx+2]
  cmp     edx,ecx             // Next Start Position <= Max Start Position
  jle     @@Loop
  pop     ebp
  pop     edi
@@NotFound:
  xor     eax,eax            // returns 0 if not found
  pop     edx
  pop     esi
  pop     ebx
  ret
@@Char1Found:
  mov     ebp,edi             // ebp = Length(Search string) - 2
@@Char1Loop:
  movzx   eax,word ptr [esi+ebp]
  cmp     ax,[edx+ebp]       // Compare 2 Chars per Char1Loop (may include #0)
  jne     @@NotChar1
  sub     ebp,2
  jnc     @@Char1Loop
  pop     ebp
  pop     edi
  jmp     @@SetResult
@@Char2Found:
  mov     ebp,edi             // ebp = Length(Search string) - 2
@@Char2Loop:
  movzx   eax,word ptr [esi+ebp]
  cmp     ax,[edx+ebp+1]     // Compare 2 Chars per Char2Loop (may include #0)
  jne     @@NotChar2
  sub     ebp,2
  jnc     @@Char2Loop
  pop     ebp
  pop     edi
  jmp     @@CheckResult
@@SingleChar:
  jl      @@NotFound          // Needed for Zero-Length Non-NIL Strings
  movzx   eax,byte ptr [eax]  // Search Character
@@CharLoop:
  cmp     al,[edx]
  je      @@SetResult
  cmp     al,[edx+1]
  je      @@CheckResult
  lea     edx,[edx+2]
  cmp     edx,ecx
  jle     @@CharLoop
  jmp     @@NotFound
@@CheckResult:                // Check within AnsiString
  cmp     edx,ecx
  jge     @@NotFound
  add     edx,1
@@SetResult:
  pop     ecx                 // @Str
  pop     esi
  pop     ebx
  neg     ecx
  lea     eax,[edx+ecx+1]
end;
{$endif PUREPASCAL}

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; overload;
begin
  Split(Str,SepStr,LeftStr,result,ToUpperCase);
end;

function StringReplaceAll(const S, OldPattern, NewPattern: RawUTF8): RawUTF8;
procedure Process(j: integer);
var i: integer;
begin
  Result := '';
  i := 1;
  repeat
    Result := Result+Copy(S,i,j-i)+NewPattern;
    i := j+length(OldPattern);
    j := PosEx(OldPattern, S, i);
    if j=0 then begin
      Result := Result+Copy(S, i, maxInt);
      break;
    end;
  until false;
end;
var j: integer;
begin
  j := PosEx(OldPattern, S, 1); // our PosEx() is faster than Pos()
  if j=0 then
    result := S else
    Process(j);
end;

function PosChar(Str: PUTF8Char; Chr: AnsiChar): PUTF8Char;
{$ifdef PUREPASCAL}
begin
  Result := Str;
  while Result^<>Chr do begin
    if Result^=#0 then begin
      Result := nil;
      Exit;
    end;
    Inc(Result);
  end;
end;
{$else}
asm // faster version by AB - eax=Str dl=Chr
    or eax,eax
    jz @z
@1: mov cl,[eax]
    cmp cl,dl
    jz @z
    inc eax
    or cl,cl
    jnz @1
    xor eax,eax
@z:
end;
{$endif}

function StringReplaceChars(const Source: RawUTF8; OldChar, NewChar: AnsiChar): RawUTF8;
var i,j,n: integer;
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
        SetString(result,PAnsiChar(pointer(Source)),n);
        for j := i to n-1 do
          if PAnsiChar(pointer(Source))[j]=OldChar then
            PAnsiChar(pointer(result))[j] := NewChar;
        exit;
      end;
  end;
  result := Source;
end;

function PosI(uppersubstr: PUTF8Char; const str: RawUTF8): Integer;
var C: AnsiChar;
begin
  if uppersubstr<>nil then begin
    C := uppersubstr^;
    for result := 1 to Length(str) do
      if NormToUpperAnsi7[str[result]]=C then
        if IdemPChar(@PUTF8Char(pointer(str))[result],PAnsiChar(uppersubstr)+1) then
          exit;
  end;
  result := 0;
end;

function StrPosI(uppersubstr,str: PUTF8Char): PUTF8Char;
var C: AnsiChar;
begin
  if (uppersubstr<>nil) and (str<>nil) then begin
    C := uppersubstr^;
    result := str;
    while result^<>#0 do begin
      if NormToUpperAnsi7[result^]=C then
        if IdemPChar(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 AppendBufferToRawUTF8(var Text: RawUTF8; Buffer: pointer; BufferLen: PtrInt);
var L: PtrInt;
begin
  if BufferLen<=0 then
    exit;
  L := PtrInt(Text);
  if L<>0 then
    L := pInteger(L-sizeof(integer))^; // L := length(Text)
  SetLength(Text,L+BufferLen);
  move(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
    move(Buffers[i]^,P^,lens[i]);
    inc(P,lens[i]);
  end;
end;

function AppendRawUTF8ToBuffer(Buffer: PUTF8Char; const Text: RawUTF8): PUTF8Char;
var L: PtrInt;
begin
  L := PtrInt(Text);
  if L<>0 then begin
    L := pInteger(L-sizeof(integer))^; // L := length(Text)
    Move(Pointer(Text)^,Buffer^,L);
    inc(Buffer,L);
  end;
  result := Buffer;
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;
  FastNewRawUTF8(result,L+n+2);
  P := pointer(Result);
  P^ := Quote;
  inc(P);
  if n=0 then begin
    Move(Text^,P^,L);
    inc(P,L);
  end else begin
    Move(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^='"' 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);
var i: integer;
begin
  for i := 1 to length(aText) do
    case aText[i] of
    #0..#31,'\','"':
      with TTextWriter.CreateOwnedStream do
      try
        Add('"');
        AddJSONEscape(pointer(aText));
        Add('"');
        SetText(result);
        exit;
      finally
        Free;
      end;
    end;
  // if we reached here, no character needs to be escaped in this string
  result := '"'+aText+'"';
end;

function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
begin // P^='"' at function call
  inc(P);
  repeat
    if P^=#0 then
      break else
    if P^<>'\' then
      if P^<>'"' 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
  if P^ in [#1..' '] then
    repeat
      inc(P)
    until not(P^ in [#1..' ']);
  result := P;
end;

function NextNotSpaceCharIs(var P: PUTF8Char; ch: AnsiChar): boolean;
begin
  if P^ in [#1..' '] then
    repeat
      inc(P)
    until not(P^ in [#1..' ']);
  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^;
  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
    SetRawUTF8(Value,PAnsiChar(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(PS);
      inc(P);
    until false;
  end;
  result := P+1;
end;

function UnQuoteSQLString(const Value: RawUTF8): RawUTF8;
begin
  UnQuoteSQLStringVar(pointer(Value),result);
end;

function isSelect(P: PUTF8Char): boolean;
begin
  if P<>nil then begin
    P := SQLBegin(P);
    result :=
      ((IdemPChar(P,'SELECT') or IdemPChar(P,'VACUUM') or IdemPChar(P,'PRAGMA')) and
       (P[6] in [#0..' ',';'])) or IdemPChar(P,'EXPLAIN ') or
      (((IdemPChar(P,'WITH') ) and (P[4] in [#0..' ',';'])) and
        not (ContainsUTF8(P,'INSERT') or ContainsUTF8(P,'UPDATE') or
             ContainsUTF8(P,'DELETE')));
  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);
begin // '\uFFF0base64encodedbinary' decode into binary (input shall have been checked)
  ParamValue := Base64ToBin(PAnsiChar(pointer(ParamValue))+3,length(ParamValue)-3);
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 begin
      Blob := Base64ToBin(PAnsiChar(Value)+3,ValueLen);
      result := true;
    end 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 begin
    Blob := Base64ToBin(PAnsiChar(Value)+3,ValueLen-3);
    result := true;
  end;
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'];


function SQLParamContent(P: PUTF8Char; out ParamType: TSQLParamType; out ParamValue: RawUTF8;
  out wasNull: boolean): PUTF8Char;
var PBeg: PAnsiChar;
    L: integer;
    c: cardinal;
begin
  ParamType := sptUnknown;
  wasNull := false;
  result := nil;
  if P=nil then
    exit;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  case P^ of
  '''','"': begin
    P := UnQuoteSQLStringVar(P,ParamValue);
    if P=nil then
      exit; // not a valid quoted string (e.g. unexpected end in middle of it)
    ParamType := sptText;
    L := length(ParamValue)-3;
    if L>0 then begin
      c := PInteger(ParamValue)^ and $00ffffff;
      if c=JSON_BASE64_MAGIC then begin
        // ':("\uFFF0base64encodedbinary"):' format -> decode
        Base64MagicDecode(ParamValue); // wrapper function to avoid temp. string
        ParamType := sptBlob;
      end else
      if (c=JSON_SQLDATE_MAGIC) and // handle ':("\uFFF112012-05-04"):' format
         IsIso8601(PUTF8Char(pointer(ParamValue))+3,L) then begin
        ParamValue := copy(ParamValue,4,L); // return ISO-8601 text
        ParamType := sptDateTime;           // identified as Date/Time
      end;
    end;
  end;
  '-','+','0'..'9': begin // allow 0 or + in SQL
    // check if P^ is a true numerical value
    PBeg := pointer(P);
    ParamType := sptInteger;
    repeat inc(P) until not (P^ in ['0'..'9']); // check digits
    if P^='.' then begin
      inc(P);
      if P^ in ['0'..'9'] then begin
        ParamType := sptFloat;
        repeat inc(P) until not (P^ in ['0'..'9']); // check fractional digits
      end else begin
        ParamType := sptUnknown; // invalid '23023.' value
        exit;
      end;
    end;
    if byte(P^) and $DF=ord('E') then begin
      ParamType := sptFloat;
      inc(P);
      if P^='+' then inc(P) else
      if P^='-' then inc(P);
      while P^ in ['0'..'9'] do inc(P);
    end;
    SetRawUTF8(ParamValue,PBeg,P-PBeg);
  end;
  'n':
  if PInteger(P)^=NULL_LOW then begin
    inc(P,4);
    wasNull := true;
  end else
    exit; // invalid content (only :(null): expected)
  else
    exit; // invalid content
  end;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  if PWord(P)^<>Ord(')')+Ord(':')shl 8 then
    // we expect finishing with P^ pointing at '):'
    ParamType := sptUnknown else
    // result<>nil only if value content in P^
    result := P+2;
end;


function ExtractInlineParameters(const SQL: RawUTF8;
  var Types: TSQLParamTypeDynArray; var Values: TRawUTF8DynArray;
  var maxParam: integer; var Nulls: TSQLFieldBits): RawUTF8;
var ppBeg: integer;
    P, Gen: PUTF8Char;
    wasNull: boolean;
begin
  maxParam := 0;
  fillchar(Nulls,sizeof(Nulls),0);
  ppBeg := PosEx(RawUTF8(':('),SQL,1);
  if (ppBeg=0) or (PosEx(RawUTF8('):'),SQL,ppBeg+2)=0) then begin
    // SQL code with no valid :(...): internal parameters -> leave maxParam=0
    result := SQL;
    exit;
  end;
  SetString(result,PAnsiChar(pointer(SQL)),length(SQL));
  // compute GenericSQL from SQL, converting :(...): into ?
  Gen := PUTF8Char(pointer(result))+ppBeg-1; // Gen^ just before :(
  P := PUTF8Char(pointer(SQL))+ppBeg+1; // P^ just after :(
  repeat
    Gen^ := '?'; // replace :(...): by ?
    inc(Gen);
    if length(Values)<=maxParam then
      SetLength(Values,maxParam+16);
    if length(Types)<=maxParam then
      SetLength(Types,maxParam+64);
    P := SQLParamContent(P,Types[maxParam],Values[maxParam],wasNull);
    if P=nil then begin
      maxParam := 0;
      result := SQL;
      exit; // any invalid parameter -> try direct SQL
    end;
    if wasNull then
      include(Nulls,maxParam);
    while (P^<>#0) and (PWord(P)^<>Ord(':')+Ord('(')shl 8) do begin
      Gen^ := P^;
      inc(Gen);
      inc(P);
    end;
    if P^=#0 then
      Break;
    inc(P,2);
    inc(maxParam);
  until false;
  // return the correct SQL statement, with params in Values[]
  SetLength(result,Gen-pointer(result));
  inc(maxParam);
end;


{$ifndef OWNI2S}

function Int32ToUTF8(Value : integer): RawByteString; // faster than SysUtils.IntToStr
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt32(@tmp[15],Value);
  SetString(result,P,@tmp[15]-P);
end;

function Int64ToUtf8(Value: Int64): RawByteString; // faster than SysUtils.IntToStr
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrInt64(@tmp[23],Value);
  SetString(result,P,@tmp[23]-P);
end;

{$endif}

function UInt32ToUTF8(Value: Cardinal): RawByteString; // faster than SysUtils.IntToStr
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[15],Value);
  SetString(result,P,@tmp[15]-P);
end;

procedure UInt32ToUtf8(Value: cardinal; var result: RawUTF8);
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[15],Value);
  SetRawUTF8(result,P,@tmp[15]-P);
end;

{$ifndef EXTENDEDTOSTRING_USESTR}
var // standard FormatSettings (US)
    SettingsUS: TFormatSettings;
{$endif}

function ExtendedToString(var S: ShortString; Value: TSynExtended;
  Precision: integer): integer;
{$ifdef EXTENDEDTOSTRING_USESTR}
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+ don't like
    '.': 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
            Move(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;
{$else}
{$ifdef UNICODE}
var i: integer;
{$endif}
begin
  // use ffGeneral: see http://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}
{$endif EXTENDEDTOSTRING_USESTR}
end;

function ExtendedToStr(Value: TSynExtended; Precision: integer): RawUTF8;
var tmp: ShortString;
begin
  SetString(result,PAnsiChar(@tmp[1]),ExtendedToString(tmp,Value,Precision));
end;

procedure ExtendedToStr(Value: TSynExtended; Precision: integer;
  var result: RawUTF8);
var tmp: ShortString;
begin
  SetRawUTF8(result,PAnsiChar(@tmp[1]),ExtendedToString(tmp,Value,Precision));
end;

function DoubleToStr(Value: Double): RawUTF8;
var tmp: ShortString;
begin
  if Value=0 then
    result := '0' else
    SetString(result,PAnsiChar(@tmp[1]),ExtendedToString(tmp,Value,DOUBLE_PRECISION));
end;

function FormatUTF8(const Format: RawUTF8; const Args: array of const): RawUTF8;
// only supported token is %, with any const arguments
var i, blocksN, L, argN: PtrInt;
    blocks: array of record
      Text: PUTF8Char;
      Len: integer;
    end;
    Arg: TRawUTF8DynArray;
    F,FDeb: PUTF8Char;
procedure Add(aText: PUTF8Char; aLen: Integer);
begin
  if aLen>0 then begin
    inc(L,aLen);
    assert(blocksN<length(blocks));
    with blocks[blocksN] do begin // add inbetween text
      Text := aText;
      Len := aLen;
    end;
    inc(blocksN);
  end;
end;
begin
  if (Format='') or (high(Args)<0) then begin
    result := Format; // no formatting to process
    exit;
  end;
  if Format='%' then begin
    VarRecToUTF8(Args[0],result); // optimize raw conversion
    exit;
  end;
  result := '';
  SetLength(Arg,length(Args));
  SetLength(blocks,length(Args)*2+1);
  blocksN := 0;
  argN := 0;
  L := 0;
  F := pointer(Format);
  while F^<>#0 do begin
    if F^<>'%' then begin
      FDeb := F;
      while (F^<>'%') and (F^<>#0) do inc(F);
      Add(FDeb,F-FDeb);
    end;
    if F^=#0 then break;
    inc(F); // jump '%'
    if argN<=high(Args) then begin
      VarRecToUTF8(Args[argN],arg[argN]);
      Add(pointer(arg[argN]),length(arg[argN]));
      inc(argN);
    end else
    if F^<>#0 then begin // no more available Args -> add all remaining text
      Add(F,StrLen(F));
      break;
    end;
  end;
  if L=0 then
    exit;
  SetLength(result,L);
  F := pointer(result);
  for i := 0 to blocksN-1 do
  with blocks[i] do begin
    move(Text^,F^,Len);
    inc(F,Len);
  end;
end;

function FormatUTF8(const Format: RawUTF8; const Args, Params: array of const; JSONFormat: boolean): RawUTF8; overload;
// supports both % and ? tokens
var i, tmpN, L, A, P, len: PtrInt;
    isParam: AnsiChar;
    tmp: TRawUTF8DynArray; 
    inlin: set of 0..255; 
    F,FDeb: PUTF8Char;
    wasString: Boolean;
const QUOTECHAR: array[boolean] of AnsiChar = ('''','"');
      NOTTOQUOTE: array[boolean] of set of 0..31 = (
        [vtBoolean,vtInteger,vtInt64,vtCurrency,vtExtended],
        [vtBoolean,vtInteger,vtInt64,vtCurrency,vtExtended,vtVariant]);
label Txt;
begin
  if (Format='') or ((high(Args)<0)and(high(Params)<0)) then begin
    result := Format; // no formatting to process
    exit;
  end;
  if Format='%' then begin
    VarRecToUTF8(Args[0],result); // optimize raw conversion
    exit;
  end;
  result := '';
  tmpN := 0;
  FillChar(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);
        SetString(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 := PInteger(PtrInt(tmp[i])-sizeof(integer))^;
    move(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 RawByteStringArrayConcat(const Values: array of RawByteString): RawByteString;
var i, L: integer;
    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]);
    move(pointer(Values[i])^,P^,L);
    inc(P,L);
  end;
end;

function StrIComp(Str1, Str2: pointer): PtrInt;
{$ifdef PUREPASCAL}
var C1, C2: AnsiChar;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    repeat
      C1 := PAnsiChar(Str1)^;
      C2 := PAnsiChar(Str2)^;
      if C1 in ['a'..'z'] then dec(C1,32);
      if C2 in ['a'..'z'] then dec(C2,32);
      if (C1<>C2) or (C1=#0) then
        break;
      Inc(PtrUInt(Str1));
      Inc(PtrUInt(Str2));
    until false;
    Result := Ord(C1) - Ord(C2);
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;
{$else}
asm // faster version by AB
        mov     ecx,eax
        xor     eax,eax
        cmp     ecx,edx
        je      @exit2  // same string or both nil
        or      ecx,ecx
        mov     al,1
        jz      @exit2  // str1=''
        or      edx,edx
        je      @min
@1:     mov     al,[ecx]
        inc     ecx
        test    al,al
        mov     ah,[edx]
        lea     edx,[edx+1]
        je      @exit
        cmp     al,ah
        je      @1
        sub     al,'a'
        sub     ah,'a'
        cmp     al,'z'-'a'
        ja      @@2
        sub     al,20h
@@2:    cmp     ah,'z'-'a'
        ja      @@3
        sub     ah,20h
@@3:    cmp     al,ah
        je      @1
@exit:  xor     edx,edx
        xchg    ah,dl
        sub     eax,edx
@exit2: ret
@min:   or      eax,-1
end;
{$endif}

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

function StrComp(Str1, Str2: pointer): PtrInt;
{$ifdef PUREPASCAL}
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then begin
    if PAnsiChar(Str1)^=PAnsiChar(Str2)^ then
    repeat
      if (pByte(Str1)^=0) or (pByte(Str2)^=0) then break;
      inc(PtrUInt(Str1));
      inc(PtrUInt(Str2));
    until pByte(Str1)^<>pByte(Str2)^;
    result := pByte(Str1)^-pByte(Str2)^;
    exit;
  end else
  result := 1 else  // Str2=''
  result := -1 else // Str1=''
  result := 0;      // Str1=Str2
end;
{$else}
asm // faster version by AB
        mov     ecx,eax
        xor     eax,eax
        cmp     ecx,edx
        je      @exit2  // same string or both nil
        or      ecx,ecx
        mov     al,1
        jz      @exit2  // Str1=''
        or      edx,edx
        je      @min
@1:     mov     al,[ecx]
        mov     ah,[edx]
        test    al,al
        lea     ecx,[ecx+1]
        je      @exit
        cmp     al,ah
        lea     edx,[edx+1]
        je      @1
@exit:  xor     edx,edx
        xchg    ah,dl
        sub     eax,edx
@exit2: ret
@min:   or      eax,-1
end;
{$endif}


function IdemPropNameU(const P1,P2: RawUTF8): boolean;
{$ifdef PUREPASCAL}
var i,j,L: integer;
begin
  result := false;
  if P1='' then begin
    if P2='' then
      result := P2='';
    exit;
  end else
    if P2='' then
      exit;
  L := PStrRec(PtrInt(P1)-STRRECSIZE)^.length;
  if L<>PStrRec(PtrInt(P2)-STRRECSIZE)^.length then
    exit;
  j := 1;
  for i := 1 to L shr 2 do
    if (PCardinal(@P1[j])^ xor PCardinal(@P2[j])^) and $dfdfdfdf<>0 then
      exit else
      inc(j,4);
  for i := j to L do
    if (ord(P1[i]) xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;
{$else}
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]
        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:
        test eax,eax
        jz @nil1
        test edx,edx
        jnz @notnil
        cmp [eax-4],edx
        setz al
        ret
@nil1:  cmp eax,[edx-4]
        setz al
end;
{$endif}

function IdemPropName(const P1,P2: shortstring): boolean; overload;
var i,j: integer;
begin
  result := false;
  if P1[0]<>P2[0] then
    exit;
  j := 1;
  for i := 1 to ord(P1[0]) shr 2 do
    if (PCardinal(@P1[j])^ xor PCardinal(@P2[j])^) and $dfdfdfdf<>0 then
      exit else
      inc(j,4);
  for i := j to ord(P1[0]) do
    if (ord(P1[i]) xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;

function IdemPropName(const P1: shortstring; P2: PUTF8Char; P2Len: integer): boolean; overload;
var i,j: integer;
begin
  result := false;
  if ord(P1[0])<>P2Len then
    exit;
  dec(P2);
  j := 1;
  for i := 1 to P2Len shr 2 do
    if (PCardinal(@P1[j])^ xor PCardinal(@P2[j])^) and $dfdfdfdf<>0 then
      exit else
      inc(j,4);
  for i := j to P2Len do
    if (ord(P1[i]) xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;

function IdemPropName(P1,P2: PUTF8Char; P1Len,P2Len: integer): boolean; overload;
var i,j: integer;
begin
  result := false;
  if P1Len<>P2Len then
    exit;
  dec(P1);
  dec(P2);
  j := 1;
  for i := 1 to P2Len shr 2 do
    if (PCardinal(@P1[j])^ xor PCardinal(@P2[j])^) and $dfdfdfdf<>0 then
      exit else
      inc(j,4);
  for i := j to P2Len do
    if (ord(P1[i]) xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;

function IdemPropNameU(const P1: RawUTF8; P2: PUTF8Char; P2Len: integer): boolean;
var i,j: integer;
begin
  result := false;
  if length(P1)<>P2Len then
    exit;
  j := 0;
  for i := 1 to P2Len shr 2 do
    if (PCardinal(PtrInt(P1)+j)^ xor PCardinal(@P2[j])^) and $dfdfdfdf<>0 then
      exit else
      inc(j,4);
  for i := j to P2Len-1 do
    if (PByteArray(P1)^[i] xor ord(P2[i])) and $df<>0 then
      exit;
  result := true;
end;

{$ifdef MSWINDOWS}
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}

function GetSystemTimeMillisecondsForXP: Int64; stdcall;
var fileTime: TFileTime;
begin 
   GetSystemTimeAsFileTime(fileTime); // very fast, with 100 ns unit  
   {$ifdef CPU64} // 64 bit XP ? not very likely - but who knows :)
   // http://msdn.microsoft.com/en-us/library/windows/desktop/ms724284 states:
   // do not cast a pointer to a FILETIME structure to either a int64* value
   // because it can cause alignment faults on 64-bit Windows -> manual compute
   result := fileTime.dwHighDateTime;
   result := (result shl 32)+fileTime.dwLowDateTime;
   result := result div 10000;
   {$else}
   result := trunc(PInt64(@fileTime)^/10000); // 100 ns unit
   {$endif}
end;

{$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;
begin
  Kernel := GetModuleHandle(kernel32);
  GetTickCount64 := GetProcAddress(Kernel,'GetTickCount64');
  if not Assigned(GetTickCount64) then
    GetTickCount64 := @GetSystemTimeMillisecondsForXP;
  IsWow64Process := GetProcAddress(Kernel,'IsWow64Process');
  Res := false;
  IsWow64 := Assigned(IsWow64Process) and
    IsWow64Process(GetCurrentProcess,Res) and Res;
  fillchar(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
  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: begin
    case dwMinorVersion of
     0: Vers := wVista;
     1: Vers := wSeven;
     2: Vers := wEight;
     3: Vers := wEightOne;
     4: Vers := wTen;
    end;
    if Vers<>wUnknown then begin
      if wProductType<>VER_NT_WORKSTATION then
        inc(Vers,2); // e.g. wEight -> wServer2012
      if SystemInfo.wProcessorArchitecture=PROCESSOR_ARCHITECTURE_AMD64 then
        inc(Vers);   // e.g. wEight -> wEight64
    end;
    end;
    10: Vers := wTen;
  end;
  OSVersion := Vers;
end;

{$else}

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


{$ifndef FPC}
{$ifdef PUREPASCAL}

function InterlockedIncrement(var I: Integer): Integer;
begin
  result := AtomicIncrement(I);
end;

function InterlockedDecrement(var I: Integer): Integer;
begin
  result := AtomicDecrement(I);
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}

procedure SoundExComputeAnsi(var p: PAnsiChar; var result: cardinal; Values: PSoundExValues);
var n,v,old: cardinal;
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): cardinal; // here U^>=#80
var extra,i: integer;
    c: cardinal;
begin
  result := 0;
  c := byte(U^);
  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): cardinal;
begin
  result := ord(U^);
  if result=0 then
    exit;
  if result and $80=0 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: TSynSoundExPronunciation): boolean;
begin
  fValues := SOUNDEXVALUES[Lang];
  Search := SoundExAnsi(UpperValue,nil,Lang);
  if Search=0 then
    result := false else begin
    FirstChar := SoundExComputeFirstCharAnsi(UpperValue);
    result := true;
  end;
end;

function SoundExAnsi(A: PAnsiChar; next: PPAnsiChar;
  Lang: TSynSoundExPronunciation): cardinal;
begin
  result := SoundExComputeFirstCharAnsi(A);
  if result<>0 then begin
    dec(result,ord('A')-1);   // first Soundex char is first char
    SoundExComputeAnsi(A,result,SOUNDEXVALUES[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 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;
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;
begin
  if Str1<>Str2 then
  if Str1<>nil then
  if Str2<>nil then
  repeat
    result := NormToUpperByte[ord(Str1^)]-NormToUpperByte[pByte(Str2)^];
    if result<>0 then exit;
    if (Str1^=#0) or (Str2^=#0) then break;
    inc(Str1);
    inc(Str2);
  until false 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]
    or 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
@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]
    or 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?
    pop ebx
    jz @2
@4: or eax,-1 // return -1 (S1<S2)
end;
{$endif}

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 and $80=0 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);
      Move(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);
  SetString(result,PAnsiChar(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);
  SetString(result,PAnsiChar(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;
    b: byte;
begin // fast UTF-8 comparaison using the NormToUpper[] array for all 8 bits values
  if u1<>u2 then
  if u1<>nil then
  if u2<>nil then
  repeat
    result := pbyte(u1)^;
    if result and $80=0 then
      if result<>0 then begin
        result := NormToUpperByte[result];
        inc(u1);
        b := pByte(u2)^;
        if b and $80=0 then begin
          if b=0 then exit; // u1>u2 -> return u1^
          dec(result,NormToUpperByte[b]);
          inc(u2);
          if result<>0 then exit;
          continue;
        end;
      end else begin // u1^=#0 -> end of u1 reached
        if u2^<>#0 then    // end of u2 reached -> u1=u2 -> return 0
          result := -1;    // u1<u2
        exit;
      end else begin
        result := GetHighUTF8UCS4(u1);
        if result and $ffffff00=0 then
          result := NormToUpperByte[result]; // 8 bits to upper, 32 bits as is
      end;
    c2 := pbyte(u2)^; 
    if c2 and $80=0 then begin
      inc(u2);
      if c2=0 then exit; // u1>u2 -> return u1^
      dec(result,NormToUpperByte[c2]);
      if result<>0 then exit;
    end else begin
      c2 := GetHighUTF8UCS4(u2);
      if c2 and $ffffff00=0 then
        dec(result,NormToUpperByte[c2]) else // 8 bits to upper
        dec(result,c2); // 32 bits 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;
label neg,pos,eq;
begin // fast UTF-8 comparaison using the NormToUpper[] array for all 8 bits values
  if u1<>u2 then
  if (u1<>nil) and (L1<>0) then
  if (u2<>nil) and (L2<>0) then
  repeat
    result := pByte(u1)^;
    inc(u1);
    dec(L1);
    if result and $80=0 then begin
      result := NormToUpperByte[result];
      if pByte(u2)^ and $80=0 then begin
        dec(result,NormToUpperByte[pByte(u2)^]);
        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 := NormToUpperByte[result]; // 8 bits to upper, 32 bits as is
    end;
    // here result=NormToUpper[u1^]
    c2 := pByte(u2)^;
    inc(u2);
    dec(L2);
    if c2 and $80=0 then begin
      dec(result,NormToUpperByte[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,NormToUpperByte[c2]) else // 8 bits to upper
        dec(result,c2); // returns 32 bits 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
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: cardinal;
    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 and $80=0 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 and $80=0 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;
    // find beginning of next word
Next:
{$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^) and $80=0 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;
{$endif}
    // find beginning of next word
    U := FindNextUTF8WordBegin(U);
  until U=nil;
end;

function HexDisplayToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: integer): boolean;
var B,C: byte;
    i: integer;
begin
  result := false; // return false if any invalid char
  if (Hex=nil) or (Bin=nil) then
    exit;
  inc(Bin,BinBytes-1);
  for i := 1 to BinBytes do begin
    B := ConvertHexToBin[Ord(Hex^)];
    inc(Hex);
    if B>15 then exit;
    C := ConvertHexToBin[Ord(Hex^)];
    Inc(Hex);
    if C>15 then exit;
    Bin^ := B shl 4+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));
end;

function HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean;
var I: Integer;
    B,C: byte;
begin
  result := false; // return false if any invalid char
  if Hex=nil then
    exit;
  if Bin<>nil then
  for I := 1 to BinBytes do begin
    B := ConvertHexToBin[Ord(Hex^)];
    inc(Hex);
    if B>15 then exit;
    C := ConvertHexToBin[Ord(Hex^)];
    Inc(Hex);
    if C>15 then exit;
    Bin^ := B shl 4+C;
    Inc(Bin);
  end else
  for I := 1 to BinBytes do begin // no Bin^ -> just validate Hex^ Stream format
    B := ConvertHexToBin[Ord(Hex^)];
    inc(Hex);
    if B>15 then exit;
    C := ConvertHexToBin[Ord(Hex^)];
    Inc(Hex);
    if C>15 then exit;
  end;
  result := true; // conversion OK
end;

const
  b64: array[0..63] of AnsiChar =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function Base64EncodeMain(rp, sp: PAnsiChar; len: cardinal): integer;
{$ifdef PUREPASCAL}
  {$ifdef HASINLINE}inline;{$endif}
var i: integer;
    c: cardinal;
begin
  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] := b64[(c shr 18) and $3f];
    rp[1] := b64[(c shr 12) and $3f];
    rp[2] := b64[(c shr 6) and $3f];
    rp[3] := b64[c and $3f];
    inc(rp,4);
    inc(sp,3);
  end;
end;
{$else}
asm // eax=rp edx=sp ecx=len - pipeline optimized version by AB 
    push ebx
    push esi
    push edi
    push ebp
    mov ebx,edx
    xor edx,edx
    mov esi,eax
    mov eax,ecx
    lea ecx,[edx+3]
    mov edi,offset b64
    div ecx
    or eax,eax
    mov ebp,eax
    push eax
    jz @z
    // edi=b64 ebx=sp esi=rp ebp=len div 3
    xor eax,eax
    nop
@1: // read 3 bytes from sp
    movzx edx,byte ptr [ebx]
    shl edx,16
    mov al,[ebx+2]
    mov ah,[ebx+1]
    lea ebx,[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
    dec ebp
    mov [esi],ecx
    lea esi,[esi+4]
    jnz @1
@z: pop eax // result := len div 3
    pop ebp
    pop edi
    pop esi
    pop ebx
end;

{$endif}

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] := b64[(c shr 6) and $3f];
      rp[1] := b64[c and $3f];
      rp[2] := '=';
      rp[3] := '=';
    end;
    2: begin
      c := ord(sp[0]) shl 10 + ord(sp[1]) shl 2;
      rp[0] := b64[(c shr 12) and $3f];
      rp[1] := b64[(c shr 6) and $3f];
      rp[2] := b64[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): RawByteString;
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): RawByteString;
begin
  result := '';
  if BinBytes=0 then
    exit;
  SetLength(result,BinToBase64Length(BinBytes));
  Base64Encode(pointer(result),Bin,BinBytes);
end;

procedure Base64ToURI(var base64: RawByteString);
var P: PUTF8Char;
begin
  {$ifdef FPC}
  UniqueString(base64); // @base64[1] won't call UniqueString() under FPC :(
  {$endif}
  P := @base64[1];
  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;

procedure Base64FromURI(var base64: RawByteString);
var P: PUTF8Char;
    len,i,append: integer;
begin
  len := length(base64);
  if len=0 then
    exit;
  {$ifdef FPC}
  UniqueString(base64); // @base64[1] won't call UniqueString() under FPC :(
  {$endif}
  P := @base64[1];
  repeat
    case P^ of
    #0: break;
    '-': P^ := '+';
    '_': P^ := '/';
    end;
    inc(P);
  until false;
  append := 4-(len and 3);
  if append<>4 then begin // add unsignificant trailing '=' characters
    SetLength(base64,len+append);
    for i := len+1 to len+append do
      base64[i] := '=';
  end;
end;

function BinToBase64URI(Bin: PAnsiChar; BinBytes: integer): RawByteString;
begin
  result := BinToBase64(Bin,BinBytes);
  Base64ToURI(result);
end;

function BinToBase64WithMagic(const s: RawByteString): RawByteString;
var len: integer;
begin
  result:='';
  len := length(s);
  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(s),len);
end;

function BinToBase64WithMagic(Data: pointer; DataLen: integer): RawByteString; overload;
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;

var
  /// a conversion table from Base64 text into binary data
  // - used by Base64ToBin function
  ConvertBase64ToBin: array of shortint;

procedure InitConvertBase64ToBin;
var i: integer;
begin
  SetLength(ConvertBase64ToBin,256);
  fillchar(ConvertBase64ToBin[0],256,255); // invalid value set to -1
  for i := 0 to high(b64) do
    ConvertBase64ToBin[ord(b64[i])] := i;
  ConvertBase64ToBin[ord('=')] := -2; // special value for '='
end;

type
  TConvertBase64ToBinTable = array[AnsiChar] of shortint;

function IsBase64(sp: PAnsiChar; len: PtrInt): boolean;
var i: PtrInt;
    Table: ^TConvertBase64ToBinTable;
begin
  result := false;
  if ConvertBase64ToBin=nil then
    InitConvertBase64ToBin;
  if (len=0) or (len and 3<>0) then
    exit;
  Table := pointer(ConvertBase64ToBin);
  for i := 0 to len-5 do
    if Table[sp[i]]<0 then
      exit;
  inc(sp,len-4);
  if (Table[sp[0]]=-1) or // -2 = '=' is allowed here
     (Table[sp[1]]=-1) or (Table[sp[2]]=-1) or (Table[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 Base64ToBinLength(sp: PAnsiChar; len: PtrInt): PtrInt;
var Table: ^TConvertBase64ToBinTable absolute ConvertBase64ToBin;
begin
  if (len=0) or (len and 3<>0) then begin
    result := 0;
    exit;
  end;
  if ConvertBase64ToBin=nil then
    InitConvertBase64ToBin;
  if Table[sp[len-2]]>=0 then
    if Table[sp[len-1]]>=0 then
      result := 0 else
      result := 1 else
      result := 2;
  result := (len shr 2)*3-result;
end;

procedure Base64Decode(sp,rp: PAnsiChar; len: PtrInt);
{$ifdef PUREPASCAL}
var i: PtrInt;
    c, ch: PtrInt;
    Table: ^TConvertBase64ToBinTable;
begin
  Table := pointer(ConvertBase64ToBin);
  for i := 1 to len do begin
    c := Table[sp[0]];
    if c>=0 then begin
      c := c shl 6;
      ch := Table[sp[1]];
      if ch>=0 then begin
        c := (c or ch) shl 6;
        ch := Table[sp[2]];
        if ch>=0 then begin
          c := (c or ch) shl 6;
          ch := Table[sp[3]];
          if ch>=0 then begin
            c := c or ch;
            rp[2] := AnsiChar(c);
            c := c shr 8;
            rp[1] := AnsiChar(c);
            c := c shr 8;
            rp[0] := AnsiChar(c);
            inc(rp,3);
            inc(sp,4);
            continue;
          end else begin
            c := c shr 8;
            rp[1] := AnsiChar(c);
            rp[0] := AnsiChar(c shr 8);
            //assert(resultlen=len*3-1);
            exit;
          end;
        end;
      end;
    end;
    rp[0] := AnsiChar(c shr 10);
    //assert(resultlen=len*3-2);
    exit;
  end;
end;
{$else}
asm // eax=sp edx=rp ecx=len - pipeline optimized version by AB
     push ebx
     push esi
     push edi
     push ebp
     push eax
     or ecx,ecx
     mov ebp,edx
     mov edi,dword ptr [ConvertBase64ToBin]
     mov [esp],ecx
     jz @4
     xor edx,edx
     xor ebx,ebx
@0:  mov dl,[eax]
     mov bl,[eax+$01]
     movsx ecx,byte ptr [edi+edx]
     movsx esi,byte ptr [edi+ebx]
     test ecx,ecx
     jl @1
     shl ecx,$06
     test esi,esi
     jl @1
     or ecx,esi
     mov dl,[eax+$02]
     mov bl,[eax+$03]
     shl ecx,$06
     movsx esi,byte ptr [edi+edx]
     movsx edx,byte ptr [edi+ebx]
     test esi,esi
     jl @1
     or ecx,esi
     shl ecx,$06
     test edx,edx
     jl @2
     or ecx,edx
     lea eax,[eax+4]
     mov [ebp+2],cl
     mov [ebp+1],ch
     shr ecx,16
     dec dword ptr [esp]
     mov [ebp],cl
     lea ebp,[ebp+3]
     jnz @0
@4:  pop eax
     pop ebp
     pop edi
     pop esi
     pop ebx
     ret
@2:  shr ecx,$08
     mov [ebp+$01],cl
     mov [ebp],ch
     jmp @4
@1:  shr ecx,$0a
     mov [ebp],cl
     jmp @4
end;
{$endif}

function Base64ToBin(const s: RawByteString): RawByteString;
var len, resultLen: PtrInt;
begin
  len := length(s);
  resultLen := Base64ToBinLength(pointer(s),len);
  if resultLen=0 then
    result := '' else begin
    SetString(result,nil,resultLen);
    Base64Decode(pointer(s),pointer(result),len shr 2);
  end;
end;

function Base64ToBin(sp: PAnsiChar; len: PtrInt): RawByteString;
var resultLen: PtrInt;
begin
  resultLen := Base64ToBinLength(sp,len);
  if resultLen=0 then
    result := '' else begin
    SetString(result,nil,resultLen);
    Base64Decode(sp,pointer(result),len shr 2);
  end;
end;

function DateToSQL(Date: TDateTime): RawUTF8;
begin
  if Date<=0 then
    result := '' else begin
    SetLength(result,13);
    PCardinal(pointer(result))^ := JSON_SQLDATE_MAGIC;
    DateToIso8601PChar(Date,PUTF8Char(pointer(result))+3,True);
  end;
end;

function DateToSQL(Year,Month,Day: Cardinal): RawUTF8; overload;
begin
  if (Year=0) or (Month-1>11) or (Day-1>30) then
    result := '' else begin
    SetLength(result,13);
    PCardinal(pointer(result))^ := JSON_SQLDATE_MAGIC;
    DateToIso8601PChar(PUTF8Char(pointer(result))+3,True,Year,Month,Day);
  end;
end;

function DateTimeToSQL(DT: TDateTime): RawUTF8;
begin
  if DT<=0 then
    result := '' else begin
    SetLength(result,3);
    PCardinal(pointer(result))^ := JSON_SQLDATE_MAGIC;
    if frac(DT)=0 then
      result := result+DateToIso8601(DT,true) else
    if trunc(DT)=0 then
      result := result+TimeToIso8601(DT,true,'T') else
      result := result+DateTimeToIso8601(DT,true,'T');
  end;
end;

function TimeLogToSQL(const TimeStamp: TTimeLog): RawUTF8;
begin
  if TimeStamp=0 then
    result := '' else begin
    SetLength(result,3);
    PCardinal(pointer(result))^ := JSON_SQLDATE_MAGIC;
    result := result+PTimeLogBits(@TimeStamp)^.Text(true);
  end;
end;

function SQLToDateTime(const ParamValueWithMagic: RawUTF8): TDateTime;
begin
  result := Iso8601ToDateTimePUTF8Char(PUTF8Char(pointer(ParamValueWithMagic))+3,
    length(ParamValueWithMagic)-3);
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 UpperCase(const S: RawUTF8): RawUTF8;
var L, i: PtrInt;
begin
  L := length(S);
  SetString(Result,PAnsiChar(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
  SetRawUTF8(result,PAnsiChar(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);
  SetRawUTF8(Dest,PAnsiChar(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;

function LowerCase(const S: RawUTF8): RawUTF8;
var L, i: PtrInt;
begin
  L := length(S);
  SetString(result,PAnsiChar(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;

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);
  SetString(result,PAnsiChar(pointer(S)),i);
end;

const
  /// fast lookup table for converting hexadecimal numbers from 0 to 15
  // into their ASCII equivalence
  // - our enhanced SysUtils.pas (normal and LVCL) contains the same array
  // - should be local for better code generation
  HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';
  HexCharsLower: array[0..15] of AnsiChar = '0123456789abcdef';

procedure BinToHex(Bin, Hex: PAnsiChar; BinBytes: integer);
var j, v: cardinal;
begin
  for j := 1 to BinBytes do begin
    v := byte(Bin^);
    Hex[0] := HexChars[v shr 4];
    Hex[1] := HexChars[v and $F];
    inc(Hex,2);
    inc(Bin);
  end;
end;

function BinToHex(const Bin: RawByteString): RawUTF8; overload;
var L: integer;
begin
  L := length(Bin);
  FastNewRawUTF8(result,L*2);
  SynCommons.BinToHex(pointer(Bin),pointer(Result),L);
end;

procedure BinToHexDisplay(Bin, Hex: PAnsiChar; BinBytes: integer);
var j, v: cardinal;
begin
  for j := BinBytes-1 downto 0 do begin
    v := byte(Bin^);
    Hex[j*2] := HexChars[v shr 4];
    Hex[j*2+1] := HexChars[v and $F];
    inc(Bin);
  end;
end;

procedure PointerToHex(aPointer: Pointer; var result: RawUTF8);
begin
  FastNewRawUTF8(result,sizeof(Pointer)*2);
  BinToHexDisplay(aPointer,pointer(Result),sizeof(Pointer));
end;

function PointerToHex(aPointer: Pointer): RawUTF8;
begin
  FastNewRawUTF8(result,sizeof(Pointer)*2);
  BinToHexDisplay(aPointer,pointer(Result),sizeof(Pointer));
end;

function CardinalToHex(aCardinal: Cardinal): RawUTF8;
begin
  FastNewRawUTF8(result,sizeof(Cardinal)*2);
  BinToHexDisplay(@aCardinal,pointer(Result),sizeof(Cardinal));
end;

function Int64ToHex(aInt64: Int64): RawUTF8;
begin
  FastNewRawUTF8(result,sizeof(Int64)*2);
  BinToHexDisplay(@AInt64,pointer(Result),sizeof(Int64));
end;

procedure YearToPChar(Y: Word; P: PUTF8Char);
{$ifdef PUREPASCAL}
begin
  PWord(P  )^ := TwoDigitLookupW[Y div 100];
  PWord(P+2)^ := TwoDigitLookupW[Y mod 100];
end;
{$else}
asm
  mov cl,100
  div cl // ah=remainder=Y mod 100, al=quotient=Year div 100
  movzx ecx,al // al=quotient=Y div 100
  mov cx,word ptr [TwoDigitLookup+ecx*2]
  mov [edx],cx
  movzx ecx,ah // ah=remainder=Y mod 100
  mov cx,word ptr [TwoDigitLookup+ecx*2]
  mov [edx+2],cx
end;
{$endif}

function SameValue(const A, B: Double; DoublePrec: double): Boolean;
var AbsA,AbsB: double;
begin // faster than the Math unit version
  AbsA := Abs(A);
  AbsB := Abs(B);
  if AbsA<AbsB then
    AbsA := AbsA*DoublePrec else
    AbsA := AbsB*DoublePrec; // AbsA := Min(Abs(A),Abs(B))*DoublePrec
  // AbsA is the allowed Epsilon value
  if AbsA<DoublePrec then
    Result := Abs(A-B)<=DoublePrec else
    Result := Abs(A-B)<=AbsA;
end;

function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended): Boolean; 
var AbsA,AbsB: TSynExtended;
begin // faster than the Math unit version
  AbsA := Abs(A);
  AbsB := Abs(B);
  if AbsA<AbsB then
    AbsA := AbsA*DoublePrec else
    AbsA := AbsB*DoublePrec; // AbsA := Min(Abs(A),Abs(B))*DoublePrec
  // AbsA is the allowed Epsilon value
  if AbsA<DoublePrec then
    Result := Abs(A-B)<=DoublePrec else
    Result := Abs(A-B)<=AbsA;
end;

/// return the index of Value in Values[], -1 if not found
function FindRawUTF8(const Values: TRawUTF8DynArray; 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: 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;

/// true if Value was added successfully in Values[]
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;

procedure AddRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8);
var capacity: integer;
begin
  capacity := Length(Values);
  if ValuesCount=capacity then begin
    inc(capacity,64+capacity shr 3);
    SetLength(Values,capacity);
  end;
  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;

{ TPropNameList }

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;

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;

/// find the position of the SEARCH] section in source
// - return true if SEARCH] was found, and store line after it in source
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
    or 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;
// 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(NormToUpperByte[ord(p^)])) then
      exit;
    inc(up);
    inc(p);
  end;
  result := true;
end;
{$else}
function IdemPCharW(p: pWideChar; up: PUTF8Char): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
// eax=p edx=up
asm
  or eax,eax
  jz @e // P=nil -> false
  or 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^
  or bh,bh     // p^ > #255 -> FALSE
  jnz @n
  test cl,cl
  mov bl,[ebx+esi] // bl=NormToUpper[p^]
  jz @z // up^=#0 -> OK
  lea edx,[edx+1] // = inc edx without changing flags
  cmp bl,cl
  lea eax,[eax+2]
  je @1
@n:
  pop esi
  pop ebx
  xor eax,eax
@e:
  ret
@z:
  mov al,1 // up^=#0 -> OK
  pop esi
  pop ebx
end;
{$endif}
{$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}

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
    or 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);
    lea ecx,[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
    lea ecx,[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}

function FindIniNameValue(P: PUTF8Char; UpperName: PAnsiChar): RawUTF8;
var PBeg: PUTF8Char;
    i: integer;
begin // expect UpperName as 'NAME='
  PBeg := nil;
  if (P<>nil) and (P^<>'[') and (UpperName<>nil) then
  repeat
    if P^=' ' then repeat inc(P) until P^<>' ';   // trim left ' '
    if NormToUpperAnsi7[P[0]]=UpperName[0] then
      PBeg := P;
    repeat
      if P^>#13 then
        inc(P) else
      if P^ in [#0,#10,#13] then
        break else
        inc(P);
    until false;
    if PBeg<>nil then begin
      i := 1;
      repeat
        if UpperName[i]<>#0 then
          if NormToUpperAnsi7[PBeg[i]]<>UpperName[i] then
            break else
            inc(i) else begin
          inc(PBeg,i);
          SetString(result,PBeg,P-PBeg);
          exit;
        end;
      until false;
      PBeg := nil;
    end;
    if P^=#13 then inc(P);
    if P^=#10 then inc(P);
  until P^ in [#0,'['];
  result := '';
end;

function ExistsIniName(P: PUTF8Char; UpperName: PAnsiChar): boolean;
var PBeg: PUTF8Char;
begin
  result := true;
  while (P<>nil) and (P^<>'[') do begin
    PBeg := GetNextLineBegin(P,P); // since PBeg=P, we have PBeg<>nil
    if PBeg^=' ' then repeat inc(PBeg) until PBeg^<>' ';   // trim left ' '
    if IdemPChar(PBeg,UpperName) then
      exit;
  end;
  result := false;
end;

function ExistsIniNameValue(P: PUTF8Char; const UpperName: RawUTF8;
  const UpperValues: array of RawUTF8): boolean;
var PBeg: PUTF8Char;
    i: integer;
begin
  result := true;
  if high(UpperValues)>=0 then
    while (P<>nil) and (P^<>'[') do begin
      PBeg := GetNextLineBegin(P,P); // since PBeg=P, we have PBeg<>nil
      if PBeg^=' ' then repeat inc(PBeg) until PBeg^<>' ';   // trim left ' '
      if IdemPChar(PBeg,pointer(UpperName)) then begin
        inc(PBeg,length(UpperName));
        for i := 0 to high(UpperValues) do
          if IdemPChar(PBeg,pointer(UpperValues[i])) then
            exit; // found one value
        break;
      end;
    end;
  result := false;
end;

function FindWinAnsiIniNameValue(P: PUTF8Char; UpperName: PAnsiChar): RawUTF8;
begin
  result := WinAnsiToUtf8(RawByteString(FindIniNameValue(P,UpperName)));
end;

function GetSectionContent(SectionFirstLine: PUTF8Char): RawUTF8;
var PBeg: PUTF8Char;
begin
  PBeg := SectionFirstLine;
  while (SectionFirstLine<>nil) and (SectionFirstLine^<>'[') do
    GetNextLineBegin(SectionFirstLine,SectionFirstLine);
  if SectionFirstLine=nil then
    result := PBeg else
    SetString(result,PBeg,SectionFirstLine-PBeg);
end;

function GetSectionContent(const Content, SectionName: RawUTF8): RawUTF8; overload;
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
    GetNextLineBegin(PEnd,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); overload;
var PEnd: PUTF8Char;
    IndexBegin: PtrInt;
begin
  if SectionFirstLine=nil then
    exit;
  // delete existing [Section] content
  PEnd := SectionFirstLine;
  while (PEnd<>nil) and (PEnd^<>'[') do
    GetNextLineBegin(PEnd,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): integer;
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;

procedure UpdateIniEntry(var Content: RawUTF8; const Section,Name,Value: RawUTF8);
const CRLF = #13#10;
var P: PUTF8Char;
    PBeg: PUTF8Char;
    SectionFound: boolean;
    i, UpperNameLength: PtrInt;
    V: RawUTF8;
    UpperSection, UpperName: array[byte] of AnsiChar;
    // possible GPF if length(Section/Name)>255, but should be short const in code
label Sec;
begin
  PWord(UpperCopy255(UpperName,Name))^ := ord('=');
  UpperNameLength := length(Name)+1;
  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;
    while (P<>nil) and (P^<>'[') do begin
      PBeg := GetNextLineBegin(P,P); // since PBeg=P, we have PBeg<>nil
      while PBeg^=' ' do inc(PBeg);   // trim left ' '
      if IdemPChar(PBeg,UpperName) then begin
        // update Name=Value entry
        inc(PBeg,UpperNameLength);
        i := (PBeg-pointer(Content))+1;
        if (i=length(Value)) and CompareMem(PBeg,pointer(Value),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(V,Content,i); // set new value
        exit;
      end;
    end;
    // 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): RawByteString;
var F: THandle;
    Size: integer;
begin
  result := '';
  if FileName='' then
    exit;
  F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(F)>=0 then begin
    Size := GetFileSize(F,nil);
    SetLength(result,Size);
    if FileRead(F,pointer(Result)^,Size)<>Size then
      result := '';
    FileClose(F);
  end;
end;

function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean=false): boolean;
var F: THandle;
    L: integer;
begin
  result := false;
  F := FileCreate(FileName);
  if PtrInt(F)<0 then
    exit;
  if pointer(Content)<>nil then
    L := FileWrite(F,pointer(Content)^,length(Content)) else
    L := 0;
  result := (L=length(Content));      
{$ifdef MSWINDOWS}
  if FlushOnDisk then
    FlushFileBuffers(F);
{$endif}
  FileClose(F);
end;

type
  TTextFileKind = (isUnicode, isUTF8, isAnsi);

function TextFileKind(const Map: TMemoryMap): TTextFileKind;
begin
  result := isAnsi;
  if 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(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      UTF8ToSynUnicode(PUTF8Char(pointer(PtrInt(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(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1,Result);
    isUTF8:
      SetString(result,PAnsiChar(pointer(PtrInt(Map.Buffer)+3)),Map.Size-3);
    isAnsi:
      if AssumeUTF8IfNoBOM then
        SetString(result,PAnsiChar(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(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      UTF8DecodeToString(pointer(PtrInt(Map.Buffer)+3),Map.Size-3,result);
    isAnsi:
      result := CurrentAnsiConvert.AnsiToUnicodeString(Map.Buffer,Map.Size);
{$else}
    isUnicode:
      result := CurrentAnsiConvert.UnicodeBufferToAnsi(PWideChar(PtrInt(Map.Buffer)+2),(Map.Size-2) shr 1);
    isUTF8:
      result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(PtrInt(Map.Buffer)+3),Map.Size-3);
    isAnsi:
      SetString(result,PAnsiChar(Map.Buffer),Map.Size);
{$endif}
    end;
  finally
    Map.UnMap;
  end;
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;

procedure WriteStringToStream(S: TStream; const Text: RawUTF8);
var L: integer;
begin
  L := length(Text);
  if L=0 then
    S.Write(L,4) else
    S.Write(pointer(PtrInt(Text)-sizeof(integer))^,L+4);
end;

function GetFileNameWithoutExt(const FileName: TFileName): TFileName;
var i, max: PtrInt;
begin
  i := length(FileName);
  max := i-8;
  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
    result := FileName else
    SetString(result,PChar(pointer(FileName)),i-1);
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 LINUX}
begin
  result := GetLargeFileSize(FileName);
end;
{$else}
var F: THandle;
begin
  F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(F)>=0 then begin
    PInt64Rec(@result)^.Lo := GetFileSize(F,@PInt64Rec(@result)^.Hi);
    FileClose(F);
  end else
    result := 0;
end;
{$endif}

function FileAgeToDateTime(const FileName: TFileName): TDateTime;
{$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}
    result := 0;
end;

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 DirectoryDelete(const Directory: TFileName; const Mask: TFileName='*.*';
  DeleteOnlyFilesNotDirectory: Boolean=false): Boolean;
var F: TSearchRec;
    Dir: TFileName;
begin
  result := true;
  if not DirectoryExists(Directory) then
    exit;
  Dir := IncludeTrailingPathDelimiter(Directory);
  if FindFirst(Dir+Mask,faAnyFile-faDirectory,F)=0 then begin
    repeat
      {$ifndef DELPHI5OROLDER}
      {$WARN SYMBOL_DEPRECATED OFF} // for faVolumeID
      {$endif}
      if (F.Attr and (faDirectory+faVolumeID+faSysFile+faHidden)=0) and
         (F.Name[1]<>'.') then
        if not DeleteFile(Dir+F.Name) then
          result := false;
      {$ifndef DELPHI5OROLDER}
      {$WARN SYMBOL_DEPRECATED ON}
      {$endif}
    until FindNext(F)<>0;
    FindClose(F);
  end;
  if (not DeleteOnlyFilesNotDirectory) and (not RemoveDir(Dir)) then
    result := false;
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',[Directory]);
end;

{$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;
var Code: Integer;
begin
  Code := GetFileAttributes(pointer(Directory));
  result := (Code<>-1) and (FILE_ATTRIBUTE_DIRECTORY and Code<>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;

{$endif DELPHI5OROLDER}

function FileSetDateFrom(const Dest: TFileName; SourceHandle: integer): boolean;
{$ifdef MSWINDOWS}
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}
begin
  result := FileSetDate(Dest,FileGetDate(SourceHandle))=0;
end;
{$endif}

{$ifdef FPC}
function Trim(const S: RawUTF8): RawUTF8; inline;
var I,L: Integer;
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}

{$IFDEF PUREPASCAL}
{$IFDEF UNICODE}
function Trim(const S: RawUTF8): RawUTF8;
var I,L: Integer;
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;

{$ELSE}

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;

function IntegerScanExists(P: PCardinalArray; Count: PtrInt; Value: cardinal): boolean;
{$ifdef PUREPASCAL}
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(PtrUInt(P),16);
    for i := 0 to (Count and 3)-1 do // last 0..3 DWORD
      if P^[i]=Value then
        exit;
  end;
  result := false;
end;
{$else}
asm // eax=P, edx=Count, Value=ecx
  test eax,eax
  jz @end // avoid GPF
  cmp edx,8
  jae @s1
  jmp dword ptr [edx*4+@Table]
  nop // align @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
  cmp edx,8
  lea eax,[eax+32] // preserve flags during 'cmp edx,8' computation
@s2:
  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
@end:
  ret
@ok:
  mov al,1
end;
{$endif}

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 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(PtrUInt(P),16);
    for i := 0 to (Count and 3)-1 do // last 0..3 DWORD
      if P^[i]=Value then
        exit;
  end;
  result := false;
end;

function IntegerScan(P: PCardinalArray; Count: PtrInt; Value: cardinal): PCardinal;
{$ifdef PUREPASCAL}
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(PtrUInt(P),16) 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;
{$else}
asm // eax=P, edx=Count, Value=ecx
       or 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
       cmp edx,8
       lea eax,[eax+32]  // preserve flags during 'cmp edx,8' computation
       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
@ok0:  ret
@ok28: lea eax,[eax+28]; ret
@ok24: lea eax,[eax+24]; ret
@ok20: lea eax,[eax+20]; ret
@ok16: lea eax,[eax+16]; ret
@ok12: lea eax,[eax+12]; ret
@ok8:  lea eax,[eax+8];  ret
@ok4:  lea eax,[eax+4]
end;
{$endif}

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 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(PtrUInt(P),16) 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 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;

function AddInteger(var Values: TIntegerDynArray; var ValuesCount: integer;
  Value: integer; NoDuplicates: boolean=false): boolean; overload;
begin
  if NoDuplicates and IntegerScanExists(pointer(Values),ValuesCount,Value) then begin
    result := false;
    exit;
  end;
  if ValuesCount=length(Values) then
    SetLength(Values,ValuesCount+256+ValuesCount shr 3);
  Values[ValuesCount] := Value;
  inc(ValuesCount);
  result := true
end;

procedure AddInt64(var Values: TInt64DynArray; var ValuesCount: integer; Value: Int64);
begin
  if ValuesCount=length(Values) then
    SetLength(Values,ValuesCount+256+ValuesCount shr 3);
  Values[ValuesCount] := Value;
  inc(ValuesCount);
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
    move(Values[Index+1],Values[Index],(n-Index)*sizeof(Integer));
  SetLength(Values,n);
end;

procedure DeleteInteger(var Values: TIntegerDynArray; var ValuesCount: Integer; Index: PtrInt); overload;
var n: PtrInt;
begin
  n := ValuesCount;
  if PtrUInt(Index)>=PtrUInt(n) then
    exit; // wrong Index
  dec(n,Index+1);
  if n>0 then
    move(Values[Index+1],Values[Index],n*sizeof(Integer));
  dec(ValuesCount);
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;

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, Count: integer);
var i: integer;
begin
  for i := 0 to Count-1 do
    Values[i] := StartValue+i;
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);
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInteger(CSV);
  end;
end;

procedure CSVToInt64DynArray(CSV: PUTF8Char; var Result: TInt64DynArray);
begin
  while CSV<>nil do begin
    SetLength(Result,length(Result)+1);
    Result[high(Result)] := GetNextItemInt64(CSV);
  end;
end;

function IntegerDynArrayToCSV(const Values: array of integer; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''): 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;
begin
  result := '';
  if ValuesCount=0 then
    exit;
  GetMem(ints,ValuesCount*sizeof(ints[0])); // getmem is faster than a dynamic array
  try
     // compute whole result length at once
    dec(ValuesCount);
    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
      move(pointer(Prefix)^,P^,length(Prefix));
      inc(P,length(Prefix));
    end;
    for i := 0 to ValuesCount do begin
      Move(ints[i][1],P^,ord(ints[i][0]));
      inc(P,ord(ints[i][0]));
    end;
    if Suffix<>'' then
      move(pointer(Suffix)^,P^,length(Suffix));
  finally
    FreeMem(ints);
  end;
end;

function Int64DynArrayToCSV(const Values: array of Int64; ValuesCount: integer;
  const Prefix: RawUTF8=''; const Suffix: RawUTF8=''): RawUTF8;
type
  TInts23 = packed array[word] of string[23]; // shortstring are faster
var i, L, Len: PtrInt;
    tmp: array[0..23] of AnsiChar;
    ints: ^TInts23;
    P: PAnsiChar;
begin
  result := '';
  if ValuesCount=0 then
    exit;
  GetMem(ints,ValuesCount*sizeof(ints[0])); // getmem is faster than a dynamic array
  try
     // compute whole result length at once
    dec(ValuesCount);
    Len := length(Prefix)+length(Suffix);
    tmp[23] := ',';
    for i := 0 to ValuesCount do begin
      P := StrInt64(@tmp[23],Values[i]);
      L := @tmp[23]-P;
      if i<ValuesCount then
        inc(L); // append tmp[23]=','
      inc(Len,L);
      SetString(ints[i],P,L);
    end;
    // create result
    SetLength(result,Len);
    P := pointer(result);
    if Prefix<>'' then begin
      move(pointer(Prefix)^,P^,length(Prefix));
      inc(P,length(Prefix));
    end;
    for i := 0 to ValuesCount do begin
      Move(ints[i][1],P^,ord(ints[i][0]));
      inc(P,ord(ints[i][0]));
    end;
    if Suffix<>'' then
      move(pointer(Suffix)^,P^,length(Suffix));
  finally
    FreeMem(ints);
  end;
end;

function IntegerScanIndex(P: PCardinalArray; Count: PtrInt; Value: cardinal): PtrInt;
{$ifdef PUREPASCAL}
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(PtrUInt(P),16);
        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;
{$else}
asm
    push eax
    call IntegerScan
    or eax,eax
    pop edx
    jz @z
    sub eax,edx
    shr eax,2
    ret
@z: mov eax,-1
end;
{$endif}

function PtrUIntScanIndex(P: PPtrUIntArray; Count: PtrInt; Value: PtrUInt): PtrInt;
{$ifdef PUREPASCAL}
var i: PtrInt; // 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(PtrUInt(P),sizeof(PtrUInt)*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;
{$else}
asm
    push eax
    call IntegerScan
    or eax,eax
    pop edx
    jz @z
    sub eax,edx
    shr eax,2
    ret
@z: mov eax,-1
end;
{$endif}

function WordScanIndex(P: PWordArray; Count: PtrInt; Value: word): integer;
begin
  for result := 0 to Count-1 do
    if P^[result]=Value then
      exit;
  result := -1;
end;

procedure QuickSortInteger(ID: 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 := ID^[P];
      while ID[I]<pivot do inc(I);
      while ID[J]>pivot do dec(J);
      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 L < J then
      QuickSortInteger(ID,L,J);
    L := I;
  until I >= 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;
    pivot, Tmp: integer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := ID^[P];
      while ID[I]<pivot do inc(I);
      while ID[J]>pivot do dec(J);
      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 L < J then
      QuickSortInteger(ID,CoValues,L,J);
    L := I;
  until I >= R;
end;

procedure QuickSortInt64(ID: PInt64Array; L, R: PtrInt); overload;
var I, J, P: PtrInt;
    pivot, Tmp: Int64;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := ID^[P];
      while ID[I]<pivot do inc(I);
      while ID[J]>pivot do dec(J);
      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 L < J then
      QuickSortInt64(ID,L,J);
    L := I;
  until I >= R;
end;

procedure QuickSortInt64(ID,CoValues: PInt64Array; L, R: PtrInt); overload;
var I, J, P: PtrInt;
    pivot, Tmp: Int64;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := ID^[P];
      while ID[I]<pivot do inc(I);
      while ID[J]>pivot do dec(J);
      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 L < J then
      QuickSortInt64(ID,L,J);
    L := I;
  until I >= 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; overload;
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; overload;
begin
  {$ifdef CPU64}
  result := FastFindInt64Sorted(PInt64Array(P),R,Int64(Value));
  {$else}
  result := FastFindIntegerSorted(PIntegerArray(P),R,integer(Value));
  {$endif}
end;

procedure CopyAndSortInteger(Values: PIntegerArray; ValuesCount: integer;
  var Dest: TIntegerDynArray);
begin
  if ValuesCount>length(Dest) then
    SetLength(Dest,ValuesCount);
  move(Values^[0],Dest[0],ValuesCount*sizeof(Integer));
  QuickSortInteger(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
      L := result + 1 else
      R := result - 1;
  until (L > R);
  result := -1
end;

function FastFindInt64Sorted(P: PInt64Array; R: PtrInt; const Value: Int64): PtrInt; overload;
var L: PtrInt;
    cmp: Int64;
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
      L := result + 1 else
      R := result - 1;
  until (L > R);
  result := -1
end;

function FastFindIntegerSorted(const Values: TIntegerDynArray; Value: integer): PtrInt;
begin
  result := FastFindIntegerSorted(pointer(Values),length(Values)-1,Value);
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
    inc(n,256+n shr 3);
    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);
    move(Values[result],Values[result+1],n);
    if CoValues<>nil then
      move(CoValues^[result],CoValues^[result+1],n);
  end else
    result := n;
  Values[result] := Value;
  inc(ValuesCount);
end;

function GetInteger(P: PUTF8Char): PtrInt;
var c: PtrUInt;
    minus: boolean;
begin
  if P=nil then begin
    result := 0;
    exit;
  end;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  end;
  if minus then
    result := -result;
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;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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 GetCardinalDef(P: PUTF8Char; Default: PtrUInt): PtrUInt;
var c: PtrUInt;
begin
  if P=nil then begin
    result := Default;
    exit;
  end;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  Int64Rec(result).Lo := c;
  inc(P);
  repeat
    c := byte(P^)-48;
    if c>9 then
      break else
      Int64Rec(result).Lo := Int64Rec(result).Lo*10+c;
    inc(P);
    if Int64Rec(result).Lo>=high(cardinal)div 10 then begin
      repeat
        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}
function GetInt64(P: PUTF8Char): Int64;
begin // PtrInt is already int64 -> call previous version
  result := GetInteger(P);
end;
{$else}
function GetInt64(P: PUTF8Char): Int64;
var c: cardinal;
    minus: boolean;
begin
  result := 0;
  if P=nil then
    exit;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  Int64Rec(result).Lo := c;
  inc(P);
  repeat
    c := byte(P^)-48;
    if c>9 then
      break else
      Int64Rec(result).Lo := Int64Rec(result).Lo*10+c;
    inc(P);
    if Int64Rec(result).Lo>=high(cardinal)div 10 then begin
      repeat
        c := byte(P^)-48;
        if c>9 then
          break else
          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}

function GetInt64(P: PUTF8Char; var err: integer): Int64; overload;
{$ifdef ENHANCEDRTL}
begin
  val(PAnsiChar(P),result,err);
end;
{$else}
{$ifdef PUREPASCAL}
var c: cardinal;
    minus: boolean;
begin
  err := 0;
  result := 0;
  if P=nil then
    exit;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  Int64Rec(result).Lo := c;
  inc(P);
  repeat
    inc(err);
    if Byte(P^)=0 then begin
      err := 0; // conversion success without error
      Break;
    end;
    c := byte(P^)-48;
    if c>9 then
      break else
      {$ifdef CPU64}
      result := result*10;
      {$else}
      result := result shl 3+result+result;
      {$endif}
    inc(result,c);
    inc(P);
  until false;
  if minus then
    result := -result;
end;
{$else}
asm // enhanced John O'Harrow code
  test  eax,eax
  jz    @@Null
  push  ebx
  push  esi
  push  edi
  push  edx                 {Save Code Address}
  push  eax                 {Save String Pointer}
  mov   esi,eax             {String Pointer}
  xor   ebx,ebx             {Clear Valid Flag and Sign Flag}
  xor   eax,eax             {Clear Result}
  xor   edx,edx
  jmp   @@TrimEntry
@@Null:
  mov   [edx],eax
  inc   dword ptr [edx]               {Code = 1}
  xor   edx,edx             {Result = 0}
  ret
@@Trim:                     {Strip Leading Spaces}
  inc   esi
@@TrimEntry:
  movzx ecx,byte ptr [esi]
  cmp   cl,' '
  je    @@Trim
  cmp   cl,'0'
  jle   @@CheckFirstChar
@@CheckAlpha:
  test  cl,$87
  jz    @@CheckX            {May be 'x' or 'X'}
@@NumLoop:
  sub   ecx,'0'
  cmp   ecx,9
  ja    @@NumDone           {Not '0'..'9'}
  cmp   eax,MaxInt/10-9     {(MaxInt div 10)-9}
  ja    @@LargeNum
  lea   eax,[eax*4+eax]
  lea   eax,[eax*2+ecx]     {Result = Result * 10 + Digit}
  inc   esi
  mov   bl,1                {Valid := True}
  movzx ecx,byte ptr [esi]
  jmp   @@NumLoop
@@LargeNum:
  mov   bh,cl               {Save Digit}
  add   eax,eax
  adc   edx,edx
  mov   ecx,eax
  mov   edi,edx             {edi:ecx = Result * 2}
  shld  edx,eax,2
  add   eax,eax
  add   eax,eax             {edx:eax = Result * 8}
  add   eax,ecx
  adc   edx,edi             {Result = Result * 10}
  movzx ecx,bh              {Restore Digit}
  add   eax,ecx             {Add Digit to Result}
  adc   edx,0
  inc   esi
  movzx ecx,byte ptr [esi]
  sub   ecx,'0'
  cmp   ecx,9
  ja    @@NumDone           {Not '0'..'9'}
  cmp   edx,$0ccccccc       {May be Out of Range?}
  jb    @@LargeNum
  ja    @@SetSign           {Out of Range}
  cmp   eax,$cccccccc
  jna   @@LargeNum          {Within Range}
  jmp   @@SetSign
@@NumDone:
  cmp   edx,$80000000       {Check for Overflow}
  jb    @@SetSign
  jne   @@Overflow
  test  eax,eax
  jnz   @@Overflow
  test  ebx,ebx             {Sign Flag}
  js    @@Setsign           {Result is Valid (-MaxInt64-1)}
@@Overflow:
  dec   esi
  mov   bl,0               {Valid := False}
  jmp   @@SetSign
@@CheckFirstChar:
  cmp   cl,'-'
  je    @@PlusMinus
  cmp   cl,'+'
  jne   @@SignSet
@@PlusMinus:                {Starts with '+' or '-'}
  mov   bl,'+'+1
  sub   ebx,ecx             {Set Sign Flag: '+' -> +1, '-' -> -1}
  inc   esi
  mov   bl,0                {Valid := False}
  movzx ecx,byte ptr [esi]           {Character after '+' or '-'}
@@SignSet:
  cmp   cl,'$'
  je    @@Hex               {Hexadecimal}
  cmp   cl,'0'
  jne   @@CheckAlpha        {May start with 'x' or 'X'}
  inc   esi
  mov   bl,1                {Assume Valid = True}
  movzx ecx,byte ptr [esi]           {Character after '0'}
  jmp   @@CheckAlpha        {May start with '0x' or '0X'}
@@CheckX:
  mov   bh,cl
  or    bh,$20              {'X' -> 'x'}
  cmp   bh,'x'
  jne   @@NumLoop
@@Hex:
  mov   bl,0                {Valid := False}
@@HexLoop:
  inc   esi
  movzx ecx,byte ptr [esi]
  cmp   cl,'a'
  jb    @@CheckNum
  sub   cl,'a'-'A'          {'a' > 'A'}
@@CheckNum:
  sub   cl,'0'
  cmp   cl,9
  jna   @@CheckHexRange     {'0'..'9'}
  sub   cl,'A'-'0'
  cmp   cl,5                {Valid Hex Character?}
  ja    @@NotHex            {No: Invalid}
  add   cl,10               {Yes: Adjust Digit}
@@CheckHexRange:
  cmp   edx,$10000000
  jae   @@SetSign          {Overflow}
  shld  edx,eax,4          {Result := Result * 16}
  shl   eax,4
  add   eax,ecx            {Add Digit}
  adc   edx,0
  mov   bl,1               {Valid := True}
  jmp   @@HexLoop
@@NotHex:
  add   cl,'A'-'0'         {Restore Char-'0'}
@@SetSign:
  mov   ch,bl              {Save Valid Flag}
  sar   ebx,31             {Set Each Bit to Top Bit (Sign Flag)}
  xor   eax,ebx            {Negate Result if Necessary}
  xor   edx,ebx
  sub   eax,ebx
  sbb   edx,ebx
  dec   ch                  {0 if Valid,-1 if Invalid}
  or    cl,ch               {If Invalid, Force CL = -1}
  cmp   cl,-'0'
  jne   @@Error             {Not Valid or Not End of String}
  xor   esi,esi             {Code := 0}
  pop   ebx                 {Dump String Pointer}
@@Finished:
  pop   ecx
  mov   [ecx],esi           {Set Error Code}
  pop   edi
  pop   esi
  pop   ebx
  ret
@@Error:
  inc   esi
  pop   ecx                 {String Pointer}
  sub   esi,ecx
  jmp   @@Finished
end;
{$endif}
{$endif}

function GetExtended(P: PUTF8Char): TSynExtended;
var err: integer;
begin
  result := GetExtended(P,err);
  if err<>0 then
    result := 0;
end;

{$ifdef PUREPASCAL}
  {$define GETEXTENDEDPASCAL}
{$endif}
{$ifdef FPC}
  {$define GETEXTENDEDPASCAL}
{$endif}
{$ifdef PIC}
  {$define GETEXTENDEDPASCAL}
{$endif}

function GetExtended(P: PUTF8Char; out err: integer): TSynExtended;
// adapted from ValExt_JOH_PAS_8_a and ValExt_JOH_IA32_8_a by John O'Harrow
{$ifdef GETEXTENDEDPASCAL}
const POW10: array[0..31] of TSynExtended = (
  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);
function IntPower(Exponent: Integer): TSynExtended;
var Y: Cardinal;
    LBase: Int64;
begin
  Y := abs(Exponent);
  LBase := 10;
  result := 1.0;
  repeat
    while not odd(Y) do begin
      Y := Y shr 1;
      LBase := LBase*LBase
    end;
    dec(Y);
    result := result*LBase
  until Y=0;
  if Exponent<0 then
    result := 1.0/result;
end;
var Digits, ExpValue: Integer;
    Ch: AnsiChar;
    Neg, NegExp, Valid: Boolean;
begin
  result := 0.0;
  err := 0;
  if P=nil then begin
    inc(err);
    exit;
  end;
  Neg := False;
  NegExp := False;
  Valid := False;
  while P[err]=' ' do
    inc(err);
  Ch := P[err];
  if Ch in ['+','-'] then begin
    inc(err);
    Neg := (Ch='-');
  end;
  while true do begin
    Ch := P[err];
    inc(err);
    if not (Ch in ['0'..'9']) then
      break;
    result := (result*10.0)+Ord(Ch)-Ord('0');
    Valid := True;
  end;
  Digits := 0;
  if Ch='.' then begin
    while true do begin
      Ch := P[err];
      inc(err);
      if not (Ch in ['0'..'9']) then begin
        if not valid then // starts with '.'
          if Ch=#0 then
            dec(err); // P='.'
        break;
      end;
      result := (result*10.0)+Ord(Ch)-Ord('0');
      dec(Digits);
      Valid := true;
    end;
    end;
  ExpValue := 0;
  if Ch in ['E','e'] then begin
    Valid := false;
    Ch := P[err];
    if Ch in ['+','-'] then begin
      inc(err);
      NegExp := (Ch='-');
    end;
    while true do begin
      Ch := P[err];
      inc(err);
      if not (Ch in ['0'..'9']) then
        break;
      ExpValue := (ExpValue*10)+Ord(Ch)-Ord('0');
      Valid := true;
    end;
   if NegExp then
     ExpValue := -ExpValue;
  end;
  inc(Digits,ExpValue);
  case Digits of
  -high(POW10)..-1: result := result/POW10[-Digits];
  1..high(POW10):   result := result*POW10[Digits];
  0: ;
  else result := result*IntPower(Digits);
  end;
  if Neg then
    result := -result;
  if Valid and (ch=#0) then
    err := 0;
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:                 {Strip Leading Spaces}
  movzx ebx,byte ptr [esi]
  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    @@CheckSign     {Check for Sign Character}
@@FirstDigit:
  xor   edi,edi         {Zero Exponent Value}
@@DigitLoop:
  sub   bl,'0'
  cmp   bl,9
  ja    @@Fraction      {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   @@DigitLoop     {No,Get Next Digit}
  jmp   @@Finish        {Yes,Finished}
@@CheckSign:
  cmp   bl,'-'
  je    @@Minus
  cmp   bl,'+'
  je    @@SignSet
@@GetFirstDigit:
  test  bl,bl
  jz    @@Error         {No Digits Found}
  jmp   @@FirstDigit
@@Minus:
  mov   ch,1            {Set Sign Flag}
@@SignSet:
  movzx ebx,byte ptr [esi]  {Get Next Char}
  inc   esi
  jmp   @@GetFirstDigit
@@Fraction:
  cmp   bl,'.'-'0'
  jne   @@Exponent      {No Decimal Point}
  movzx ebx,byte ptr [esi]   {Get Next Char}
  test  bl,bl
  jz    @@DotEnd        {String Ends with '.'}
  inc   esi
@@FractionLoop:
  sub   bl,'0'
  cmp   bl,9
  ja    @@Exponent      {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   @@FractionLoop  {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}
@@Exponent:
  or    bl,$20
  cmp   bl,'e'-'0'
  jne   @@Error         {Not 'e' or 'E'}
@@GetExponent:
  movzx ebx,byte ptr [esi]  {Get Next Char}
  inc   esi
  mov   cl,0            {Clear Exponent Sign Flag}
  cmp   bl,'-'
  je    @@MinusExp
  cmp   bl,'+'
  je    @@ExpSignSet
  jmp   @@ExpLoop
@@MinusExp:
  mov   cl,1            {Set Exponent Sign Flag}
@@ExpSignSet:
  movzx ebx,byte ptr [esi]   {Get Next Char}
  inc   esi
@@ExpLoop:
  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   @@ExpLoop       {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    @@PowerDone     {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}
@@PowerDone:
  test  ch,ch           {Decimal Sign Flag Set?}
  jnz   @@Negate        {Yes,Negate Value}
@@Success:
  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   @@Success
@@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}

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 and $80=0 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): Boolean;
var ext: PUTF8Char;
begin
  if (p<>nil) and (extup<>nil) then begin
    ext := nil;
    repeat
      if p^='.' 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;

{$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)
begin
  result := false;
  if p=nil then
    exit;
  if up<>nil then
    while up^<>#0 do begin
      if up^<>NormToUpperAnsi7[p^] then
        exit;
      inc(up);
      inc(p);
    end;
  result := true;
end;
{$else}
function IdemPChar(p: PUTF8Char; up: PAnsiChar): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
// eax=p edx=up
asm
  or eax,eax
  jz @e // P=nil -> false
  or edx,edx
  push ebx
  push esi
  jz @z // up=nil -> true
  mov esi,offset NormToUpperAnsi7
  xor ebx,ebx
  xor ecx,ecx
@1:
  mov cl,[edx] // cl=up^
  mov bl,[eax] // bl=p^
  test cl,cl
  mov bl,[ebx+esi] // bl=NormToUpperAnsi7[p^]
  jz @z // up^=#0 -> OK
  lea edx,[edx+1] // = inc edx without changing flags
  cmp bl,cl
  lea eax,[eax+1]
  je @1
  pop esi
  pop ebx
  xor eax,eax
@e:
  ret
@z:
  mov al,1 // up^=#0 -> OK
  pop esi
  pop ebx
end;
{$endif}

function IdemPCharArray(p: PUTF8Char; const upArray: array of PAnsiChar): 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 high(upArray) do
      if (PWord(upArray[result])^=w) and IdemPChar(p+2,upArray[result]+2) 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);
    inc(p);
  end;
  result := true;
end;

function UpperCopy255(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
var 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
      dest[i] := AnsiChar(NormToUpperAnsi7Byte[PByteArray(source)[i]]);
  end else
    result := dest;
end;

function UpperCopyWin255(dest: PWinAnsiChar; const source: RawUTF8): PWinAnsiChar;
var 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
      dest[i] := AnsiChar(NormToUpperByte[PByteArray(source)[i]]);
  end else
    result := dest;
end;

function UTF8UpperCopy(Dest, Source: PUTF8Char; SourceChars: Cardinal): PUTF8Char;
var c: cardinal;
    endSource, endSourceBy4, S: PUTF8Char;
    extra,i: integer;
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[c and $ff]);
      Dest[1] := AnsiChar(NormToUpperByte[(c shr 8) and $ff]);
      Dest[2] := AnsiChar(NormToUpperByte[(c shr 16) and $ff]);
      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 ord(c) and $80=0 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);
        Move(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;


{$ifdef PUREPASCAL}
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;
{$else}
function UpperCopy(dest: PAnsiChar; const source: RawUTF8): PAnsiChar;
asm // eax=dest source=edx
    or edx,edx
    jz @z
    push esi
    mov esi,offset NormToUpperAnsi7
    xor ecx,ecx
@1: mov cl,[edx]
    inc edx
    or cl,cl
    mov cl,[esi+ecx]
    jz @2
    mov [eax],cl
    inc eax
    jmp @1
@2: pop esi
@z:
end;
{$endif}

{$ifdef PUREPASCAL}
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;
{$else}
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
    or 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;
{$endif}

function GetNextLine(source: PUTF8Char; out next: PUTF8Char): RawUTF8;
begin
  next := source;
  if source=nil then begin
    result := '';
    exit;
  end;
  while source^ in ANSICHARNOT01310 do inc(source);
  SetString(result,PAnsiChar(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;

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

function IdemPCharAndGetNextLine(var source: PUTF8Char; searchUp: PAnsiChar): boolean;
{$ifdef PUREPASCAL}
begin
  if source=nil then
    result := false else begin
    result := IdemPChar(source,searchUp);
    while source^ in ANSICHARNOT01310 do inc(source);
    while source^ in [#13,#10] do inc(source);
    if source^=#0 then
      source := nil;
  end;
end;
{$else}
asm // eax=source edx=searchUp
    push eax       // save source var
    mov eax,[eax]  // eax=source
    or 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;
{$endif}

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));
      Item := GetNextItem(source,Sep);
    end;
  end;
end;

function GetNextLineBegin(source: PUTF8Char; out next: PUTF8Char): PUTF8Char;
begin
  result := pointer(source);
  if source=nil then
    exit;
  while source^ in ANSICHARNOT01310 do inc(source);
  if source^=#13 then inc(source);
  if source^=#10 then inc(source);
  if source^=#0 then
    next := nil else
    next := source;
end;

function GetLineSize(P,PEnd: PUTF8Char): PtrUInt;
begin
  result := PtrUInt(P);
  if P<>nil then
    if PEnd=nil then
      while P^ in ANSICHARNOT01310 do
        inc(P) else
      while (P<PEnd) and (P^ in ANSICHARNOT01310) do
        inc(P);
  result := PtrUInt(P)-result;
end;

function GetNextItem(var P: PUTF8Char; Sep: AnsiChar= ','): RawUTF8;
var S: PUTF8Char;
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 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=#13#10);
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;
begin
  if P=nil then
    Dest[0] := #0 else begin
    S := P;
    while (S^<>#0) and (S^<>Sep) do
      inc(S);
    SetString(Dest,P,S-P);
    if S^<>#0 then
     P := S+1 else
     P := nil;
  end;
end;

function GetNextItemCardinal(var P: PUTF8Char; Sep: AnsiChar= ','): 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;
  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 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)='?,?,?'
  if Count=0 then begin
    result := '';
    exit;
  end;
  ValueLen := length(Value);
  SepLen := Length(Sep);
  Setlength(result,ValueLen*Count+SepLen*pred(Count));
  P := pointer(result);
  i := 1;
  repeat
    move(Pointer(Value)^,P^,ValueLen);
    inc(P,ValueLen);
    if i=Count then
      break;
    move(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
      SetBit(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
        SetBit(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 GetBit(Bits,i) then begin
    j := i;
    while (j+1<BitsCount) and GetBit(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 GetNextItemInt64(var P: PUTF8Char; Sep: AnsiChar= ','): Int64;
{$ifdef CPU64}
begin
  result := GetNextItemInteger(P,Sep);
end;
{$else}
var tmp: array[0..63] of AnsiChar;
    i: integer;
begin
  result := 0;
  if P=nil then
    exit;
  i := 0;
  while (P[i]<>#0) and (P[i]<>Sep) do begin
    tmp[i] := P[i];
    inc(i);
    if i>=sizeof(tmp) then
      exit;
  end;
  tmp[i] := #0;
  inc(P,i); // P[i]=Sep or #0
  if P^=#0 then
    P := nil else
    inc(P);
  SetInt64(tmp,result);
end;
{$endif}

function GetNextItemDouble(var P: PUTF8Char; Sep: AnsiChar= ','): double;
var tmp: array[0..63] of AnsiChar;
    i,err: integer;
begin
  result := 0;
  if P=nil then
    exit;
  i := 0;
  while (P[i]<>#0) and (P[i]<>Sep) do begin
    tmp[i] := P[i];
    inc(i);
    if i>=sizeof(tmp) then
      exit;
  end;
  tmp[i] := #0;
  inc(P,i); // P[i]=Sep or #0
  if P^=#0 then
    P := nil else
    inc(P);
  result := GetExtended(tmp,err);
  if err<>0 then
    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
      result := GetNextItem(P,Sep);
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
    s := GetNextItem(CSV,Sep);
    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);
var s: RawUTF8;
begin
  while CSV<>nil do begin
    s := GetNextItem(CSV,Sep);
    if s<>'' then begin
      SetLength(Result,length(Result)+1);
      Result[high(Result)] := s;
    end;
  end;
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
  result := GetNextItem(CSV,Sep);
  if result='' then
    exit;
  result := Prefix+result;
  while CSV<>nil do begin
    s := GetNextItem(CSV,Sep);
    if s<>'' then
      result := result+','+Prefix+s;
  end;
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
      move(pointer(Values[i])^,P^,L);
      inc(P,L);
    end;
    if i=high(Values) then
      Break;
    if seplen>0 then begin
      Move(pointer(Sep)^,P^,seplen);
      inc(P,seplen);
    end;
    inc(i);
  until false;
  Assert(P-pointer(result)=len);
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;

var
  DefaultTextWriterJSONClass: TTextWriterClass = TTextWriter;

function ObjectToJSON(Value: TObject; Options: TTextWriterWriteObjectOptions): RawUTF8;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream do
  try
    WriteObject(Value,Options);
    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);
      p^ := HexChars[c shr 4]; inc(p);
      p^ := HexChars[c and $F];
    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;
  function Invalid(P: PAnsiChar): boolean;
  begin
    result := true;
    if P<>nil then begin
      repeat // cf. rfc3986 2.3. Unreserved Characters
        if not (P^ in ['a'..'z','A'..'Z','0'..'9','_','.','~']) then
          exit else
          inc(P);
      until P^=#0;
      result := false;
    end;
  end;
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 Invalid(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 UrlEncodeJsonObject(const URIName: RawUTF8; ParametersJSON: PUTF8Char;
  const PropNamesToIgnore: array of RawUTF8): RawUTF8;
var i,j, NameLen: integer;
    sep: AnsiChar;
    Params: TNameValuePUTF8CharDynArray;
begin
  if ParametersJSON=nil then
    result := URIName else
    with TTextWriter.CreateOwnedStream do
    try
      AddString(URIName);
      if (JSONDecode(ParametersJSON,Params,true)<>nil) and (Params<>nil) then begin
        sep := '?';
        for i := 0 to High(Params) do begin
          NameLen := StrLen(Params[i].Name);
          for j := 0 to high(PropNamesToIgnore) do
            if IdemPropNameU(PropNamesToIgnore[j],Params[i].Name,NameLen) then begin
              NameLen := 0;
              break;
            end;
          if NameLen=0 then
            continue;
          Add(sep);
          AddNoJSONEscape(Params[i].Name,NameLen);
          Add('=');
          AddString(UrlEncode(Params[i].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 := PInteger(PtrInt(s)-sizeof(integer))^;
  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 HexToBin(PAnsiChar(pointer(s))+i+1,PByte(P),1) then
        P^ := s[i+1] else
        inc(i,2); // browsers do 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
  L := StrLen(U);
  if L=0 then begin
    result := '';
    exit;
  end;
  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 HexToBin(PAnsiChar(U+1),PByte(P),1) then
        P^ := U^ else
        inc(U,2); // browsers do 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
    SetString(result,PAnsiChar(@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
  // compute resulting length of value
  Beg := U;
  len := 0;
  while not(U^ in [#0,'&']) do begin
    if (U^='%') and HexToBin(PAnsiChar(U+1),nil,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 HexToBin(PAnsiChar(U+1),PByte(V),1) then begin
      inc(V);
      inc(U,3);
    end else begin
      if U^='+' then
        V^ := ' ' else
        V^ := U^;
      inc(V);
      inc(U);
    end;
  result := U;
end;

function UrlDecodeNextNameValue(U: PUTF8Char; var Name,Value: RawUTF8): PUTF8Char;
var Beg: PUTF8Char;
begin
  result := nil;
  if U=nil then
    exit;
  // get name
  Beg := U;
  while ord(U^) in IsURIUnreserved do
    inc(U);
  SetRawUTF8(Name,Beg,U-Beg);
  if U^<>'=' then
    if (U^='%') and (U[1]='3') and (U[2] in ['D','d']) then
      inc(U,3) else // jump %3d (which means = according to the RFC)
      exit else
    inc(U); // jump '='
  // decode value
  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; Upper: PAnsiChar; var Value: RawUTF8;
  Next: PPUTF8Char=nil): 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,Upper) then begin
    result := true;
    inc(U,StrLen(PUTF8Char(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; Upper: PAnsiChar;var Value: integer; Next: PPUTF8Char=nil): 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,Upper) then begin
    inc(U,StrLen(PUTF8Char(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; Upper: PAnsiChar;var Value: Cardinal; Next: PPUTF8Char=nil): 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,Upper) then begin
    inc(U,StrLen(PUTF8Char(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; Upper: PAnsiChar;
  var Value: Int64; Next: PPUTF8Char=nil): boolean;
var tmp: RawUTF8;
begin
  result := UrlDecodeValue(U, Upper, tmp, Next);
  if result then
    SetInt64(pointer(tmp),Value);
end;

function UrlDecodeExtended(U: PUTF8Char; Upper: PAnsiChar;
  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; Upper: PAnsiChar; 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[0..63] of AnsiChar;
    L: PtrInt;
    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 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
    if (PCardinalArray(P)^[0]<>0) or (PCardinalArray(P)^[1]<>0) or
       (PCardinalArray(P)^[2]<>0) or (PCardinalArray(P)^[3]<>0) then
      exit else
      inc(PtrUInt(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(PtrUInt(P),4);
  for i := 1 to Length and 3 do // remaining content
    if PByte(P)^<>0 then
      exit else
      inc(PtrUInt(P));
  result := true;
end;

{$WARNINGS OFF} // yes, we know there will be dead code below ;)
function IsZero(const Fields: TSQLFieldBits): boolean; overload;
begin
  if MAX_SQLFIELDS=64 then
    result := (PInt64(@Fields)^=0) else
  if MAX_SQLFields=128 then
    result := (PInt64Array(@Fields)^[0]=0) and (PInt64Array(@Fields)^[1]=0) else
  if MAX_SQLFields=192 then
    result := (PInt64Array(@Fields)^[0]=0) and (PInt64Array(@Fields)^[1]=0) and
      (PInt64Array(@Fields)^[2]=0) else
  if MAX_SQLFields=256 then
    result := (PInt64Array(@Fields)^[0]=0) and (PInt64Array(@Fields)^[1]=0) and
      (PInt64Array(@Fields)^[2]=0) and (PInt64Array(@Fields)^[3]=0) else
    result := IsZero(@Fields,sizeof(TSQLFieldBits))
end;

function IsEqual(const A,B: TSQLFieldBits): boolean;
begin
  if MAX_SQLFIELDS=64 then
    result := (PInt64(@A)^=PInt64(@B)^) else
  if MAX_SQLFields=128 then
    result := (PInt64Array(@A)^[0]=PInt64Array(@B)^[0]) and
              (PInt64Array(@A)^[1]=PInt64Array(@B)^[1]) else
  if MAX_SQLFields=192 then
    result := (PInt64Array(@A)^[0]=PInt64Array(@B)^[0]) and
              (PInt64Array(@A)^[1]=PInt64Array(@B)^[1]) and
              (PInt64Array(@A)^[2]=PInt64Array(@B)^[2]) else
  if MAX_SQLFields=256 then
    result := (PInt64Array(@A)^[0]=PInt64Array(@B)^[0]) and
              (PInt64Array(@A)^[1]=PInt64Array(@B)^[1]) and
              (PInt64Array(@A)^[2]=PInt64Array(@B)^[2]) and
              (PInt64Array(@A)^[3]=PInt64Array(@B)^[3]) else
    result := CompareMem(@A,@B,sizeof(TSQLFieldBits))
end;
{$WARNINGS ON}

procedure FieldBitsToIndex(const Fields: TSQLFieldBits; var Index: TSQLFieldIndexDynArray;
  MaxLength,IndexStart: integer);
var i,n: integer;
    sets: array[0..MAX_SQLFIELDS-1] of TSQLFieldIndex; // to avoid memory reallocation
begin
  n := 0;
  for i := 0 to MaxLength-1 do
    if i in Fields then begin
      sets[n] := i;
      inc(n);
    end;
  SetLength(Index,IndexStart+n);
  for i := 0 to n-1 do
    Index[IndexStart+i] := sets[i];
end;

function FieldBitsToIndex(const Fields: TSQLFieldBits;
  MaxLength: integer): TSQLFieldIndexDynArray;
begin
  FieldBitsToIndex(Fields,result,MaxLength);
end;

function AddFieldIndex(var Indexes: TSQLFieldIndexDynArray; Field: integer): integer;
begin
  result := length(Indexes);
  SetLength(Indexes,result+1);
  Indexes[result] := Field;
end;

function SearchFieldIndex(var Indexes: TSQLFieldIndexDynArray; Field: integer): integer;
begin
  for result := 0 to length(Indexes)-1 do
    if Indexes[result]=Field then
      exit;
  result := -1;
end;

procedure FieldIndexToBits(const Index: TSQLFieldIndexDynArray; var Fields: TSQLFieldBits);
var i: integer;
begin
  fillchar(Fields,sizeof(Fields),0);
  for i := 0 to Length(Index)-1 do
    if Index[i]>=0 then
      include(Fields,Index[i]);
end;

function FieldIndexToBits(const Index: TSQLFieldIndexDynArray): TSQLFieldBits;
begin
  FieldIndexToBits(Index,result);
end;


function Hash32(const Text: RawByteString): cardinal;
begin
  result := Hash32(pointer(Text),length(Text));
end;

function Hash32(Data: pointer; Len: integer): cardinal;
var s1,s2: cardinal;
    i: PtrInt;
begin
  if Data<>nil then begin
    s1 := 0;
    s2 := 0;
    for i := 1 to Len shr 4 do begin // 16 bytes (4 DWORD) by loop - aligned read
      inc(s1,PCardinalArray(Data)^[0]);
      inc(s2,s1);
      inc(s1,PCardinalArray(Data)^[1]);
      inc(s2,s1);
      inc(s1,PCardinalArray(Data)^[2]);
      inc(s2,s1);
      inc(s1,PCardinalArray(Data)^[3]);
      inc(s2,s1);
      inc(PtrUInt(Data),16);
    end;
    for i := 1 to (Len shr 2)and 3 do begin // 4 bytes (DWORD) by loop
      inc(s1,PCardinalArray(Data)^[0]);
      inc(s2,s1);
      inc(PtrUInt(Data),4);
    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;

function GetBit(const Bits; aIndex: PtrInt): boolean;
{$ifdef PUREPASCAL}
begin
{$ifdef CPU64}
  result := PInt64Array(@Bits)^[aIndex shr 6] and (Int64(1) shl (aIndex and 63)) <> 0;
{$else}
  result := PIntegerArray(@Bits)^[aIndex shr 5] and (1 shl (aIndex and 31)) <> 0;
{$endif}
end;
{$else}
asm
  bt [eax],edx // use very fast i386 bit statement
  sbb eax,eax
  and eax,1
end;
{$endif}

function GetAllBits(Bits: Cardinal; BitCount: Integer): boolean;
begin
  if BitCount in [low(ALLBITS_CARDINAL)..high(ALLBITS_CARDINAL)] then
    result := (Bits and ALLBITS_CARDINAL[BitCount])=ALLBITS_CARDINAL[BitCount] else
    result := false;
end;

procedure SetBit(var Bits; aIndex: PtrInt);
{$ifdef PUREPASCAL}
begin
{$ifdef CPU64}
  PInt64Array(@Bits)^[aIndex shr 6] := PInt64Array(@Bits)^[aIndex shr 6]
    or (Int64(1) shl (aIndex and 63));
{$else}
  PIntegerArray(@Bits)^[aIndex shr 5] := PIntegerArray(@Bits)^[aIndex shr 5]
    or (1 shl (aIndex and 31));
{$endif}
end;
{$else}
asm
  bts [eax],edx // use very fast i386 bit statement
end;
{$endif}

procedure UnSetBit(var Bits; aIndex: PtrInt);
{$ifdef PUREPASCAL} 
begin
  PIntegerArray(@Bits)^[aIndex shr 5] := PIntegerArray(@Bits)^[aIndex shr 5]
    and not (1 shl (aIndex and 31));
end;
{$else}
asm
  btr [eax],edx // use very fast i386 bit statement
end;
{$endif}

function GetBit64(const Bits; aIndex: PtrInt): boolean;
{$ifdef PUREPASCAL}
begin
  if PtrUInt(aIndex)>63 then
    result := false else
{$ifdef CPU64}
    result := PInt64(@Bits)^ and (Int64(1) shl (aIndex and 63)) <> 0;
{$else}
    result := PIntegerArray(@Bits)^[aIndex shr 5] and (1 shl (aIndex and 31)) <> 0;
{$endif}
end;
{$else}
asm
    cmp edx,64
    jae @z
    bt [eax],edx  // use very fast i386 bit statement
    sbb eax,eax
    and eax,1
    ret
@z: xor eax,eax
end;
{$endif}

procedure SetBit64(var Bits: Int64; aIndex: PtrInt);
{$ifdef PUREPASCAL}
begin
  if PtrUInt(aIndex)<=63 then
{$ifdef CPU64}
    PInt64Array(@Bits)^[aIndex shr 6] := PInt64Array(@Bits)^[aIndex shr 6]
      or (Int64(1) shl (aIndex and 63));
{$else}
    PIntegerArray(@Bits)^[aIndex shr 5] := PIntegerArray(@Bits)^[aIndex shr 5]
      or (1 shl (aIndex and 31));
{$endif}
end;
{$else}
asm
  cmp edx,64
  jae @z
  bts [eax],edx  // use very fast i386 bit statement
@z:
end;
{$endif}

procedure UnSetBit64(var Bits: Int64; aIndex: PtrInt);
{$ifdef PUREPASCAL}
begin
  if PtrUInt(aIndex)<=63 then
{$ifdef CPU64}
    PInt64Array(@Bits)^[aIndex shr 6] := PInt64Array(@Bits)^[aIndex shr 6]
      and not(Int64(1) shl (aIndex and 63));
{$else}
    PIntegerArray(@Bits)^[aIndex shr 5] := PIntegerArray(@Bits)^[aIndex shr 5]
      and not (1 shl (aIndex and 31));
{$endif}
end;
{$else}
asm
  cmp edx,64
  jae @z
  btr [eax],edx // use very fast i386 bit statement
@z:
end;
{$endif}

function GetBitsCount(const Bits; Count: PtrInt): integer;
{$ifdef PUREPASCAL}
begin
  result := 0;
  while Count>0 do begin
    dec(Count);
    if GetBit(Bits,Count) then
      inc(result);
  end;
end;
{$else}
asm
    xor ecx,ecx
@1: or edx,edx
    jz @n
    dec edx
    bt [eax],edx
    adc ecx,0
    jmp @1
@n: mov eax,ecx
end;
{$endif}

function fnv32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef PUREPASCAL}
var i: integer;
begin
  if buf<>nil then
    for i := 0 to len-1 do
      crc := (crc xor ord(buf[i]))*16777619;
  result := crc;
end;
{$else}
asm // eax=crc, edx=buf, ecx=len
    test edx,edx; jz @0
    neg ecx; jz @0
    push ebx
    sub edx,ecx
@1: movzx ebx,byte ptr [edx+ecx]
    xor eax,ebx
    imul eax,eax,16777619
    inc ecx
    jnz @1
    pop ebx
@0:
end; // we tried an unrolled version, but it was slower on our Core i7!
{$endif}

function kr32(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef PUREPASCAL}
var i: integer;
begin
  for i := 0 to len-1 do
    crc := ord(buf[i])+crc*31;
  result := crc;
end;
{$else}
asm // eax=crc, edx=buf, ecx=len
    or 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
    lea edx,[edx+4]
    mov esi,eax
    movzx edi,bl
    movzx ebp,bh
    shr ebx,16
    shl eax,5
    sub eax,esi
    lea eax,[eax+edi]
    mov esi,eax
    shl eax,5
    sub eax,esi
    lea esi,[eax+ebp]
    lea eax,[eax+ebp]
    movzx edi,bl
    movzx ebx,bh
    shl eax,5
    sub eax,esi
    lea ebp,[eax+edi]
    lea eax,[eax+edi]
    shl eax,5
    sub eax,ebp
    cmp ecx,8
    lea eax,[eax+ebx]
    lea ecx,[ecx-4]
    jae @8
    or ecx,ecx
    jz @z
@s: mov esi,eax
@1: shl eax,5
    movzx ebx,byte ptr [edx]
    lea edx,[edx+1]
    sub eax,esi
    dec ecx
    lea esi,[eax+ebx]
    lea eax,[eax+ebx]
    jnz @1
@z: pop ebp
    pop ebx
    pop esi
    pop edi
end;
{$endif}

type
 TRegisters = record
   eax,ebx,ecx,edx: cardinal;
 end;

{$ifdef CPU64DELPHI}
procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
asm
  .NOFRAME
  mov eax,ecx
  mov r9,rdx
  mov r10,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;

function crc32csse42(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
asm // ecx=crc, rdx=buf, r8=len
    mov eax,ecx
    not eax
    test r8,r8;   jz @0
    test rdx,rdx; jz @0
@7: test rdx,7;   jz @8 // align to 8 bytes boundary
    crc32 dword ptr eax,byte ptr [rdx]
    inc rdx
    dec r8;     jz @0
    test rdx,7; jnz @7
@8: mov rcx,r8
    shr r8,3
    jz @2
@1: crc32 dword ptr eax,dword ptr [rdx]
    crc32 dword ptr eax,dword ptr [rdx+4]
    dec r8
    lea rdx,rdx+8
    jnz @1
@2: and rcx,7; jz @0
    cmp rcx,4; jb @4
    crc32 dword ptr eax,dword ptr [rdx]
    sub rcx,4
    lea rdx,rdx+4
    jz @0
@4: crc32 dword ptr eax,byte ptr [rdx]
    dec rcx; jz @0
    crc32 dword ptr eax,byte ptr [rdx+1]
    dec rcx; jz @0
    crc32 dword ptr eax,byte ptr [rdx+2]
@0: not eax
end;
{$endif CPU64DELPHI}

procedure SymmetricEncrypt(key: cardinal; var data: RawByteString);
var i,len: integer;
    d: PCardinal;
begin
  UniqueString(AnsiString(data));
  len := length(data);
  d := pointer(data);
  key := key xor cardinal(len);
  for i := 0 to (len shr 2)-1 do begin
    key := key xor crc32ctab[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 crc32ctab[0,17 shl i];
end;

function crc32cfast(crc: cardinal; buf: PAnsiChar; len: cardinal): cardinal;
{$ifdef PUREPASCAL}
begin
  result := not crc;
  if (buf<>nil) and (len>0) then begin
   {$ifdef CPUARM} // circumvent FPC issue on ARM
    while len>0 do begin
      result := crc32ctab[0,(result xor PByte(buf)^) and $ff] xor (result shr 8);
      dec(len);
      inc(buf);
    end;
    {$else}
    repeat
      if PtrUInt(buf) and 3=0 then // align to 4 bytes boundary
        break;
      result := crc32ctab[0,byte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    until len=0;
    while len>=4 do begin
      result := result xor PCardinal(buf)^;
      inc(buf,4);
      result := crc32ctab[3,byte(result)] xor
                crc32ctab[2,byte(result shr 8)] xor
                crc32ctab[1,byte(result shr 16)] xor
                crc32ctab[0,result shr 24];
      dec(len,4);
    end;
    while len>0 do begin
      result := crc32ctab[0,byte(result xor ord(buf^))] xor (result shr 8);
      dec(len);
      inc(buf);
    end;
   {$endif CPUARM}
  end;
  result := not result;
end;
{$else}
// adapted from fast Aleksandr Sharahov version
asm
  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
@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;

procedure GetCPUID(Param: Cardinal; var Registers: TRegisters);
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
  {$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;
asm // eax=crc, edx=buf, ecx=len
    not eax
    test ecx,ecx; jz @0
    test edx,edx; jz @0
@7: test edx,7;   jz @8 // align to 8 bytes boundary
    {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,byte ptr [edx]
    {$else}
    db $F2,$0F,$38,$F0,$02
    {$endif}
    inc edx
    dec ecx;    jz @0
    test edx,7; jnz @7
@8: push ecx
    shr ecx,3
    jz @2
@1: {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,dword ptr [edx]
    crc32 dword ptr eax,dword ptr [edx+4]
    {$else}
    db $F2,$0F,$38,$F1,$02
    db $F2,$0F,$38,$F1,$42,$04
    {$endif}
    dec ecx
    lea edx,[edx+8]
    jnz @1
@2: pop ecx
    and ecx,7
    jz @0
    cmp ecx,4
    jb @4
    {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,dword ptr [edx]
    {$else}
    db $F2,$0F,$38,$F1,$02
    {$endif}
    sub ecx,4
    lea edx,[edx+4]
    jz @0
@4: {$ifdef ISDELPHI2010}
    crc32 dword ptr eax,byte ptr [edx]
    dec ecx; jz @0
    crc32 dword ptr eax,byte ptr [edx+1]
    dec ecx; jz @0
    crc32 dword ptr 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 PUREPASCAL}

function crc32cUTF8ToHex(const str: RawUTF8): RawUTF8;
begin
  result := CardinalToHex(crc32c(0,pointer(str),length(str)));
end;

type TWordRec = packed record YDiv100, YMod100: byte; end;

{$ifdef FPC_OR_PUREPASCAL} // Alf reported asm below fails with FPC/Linux32
function Div100(Y: PtrUInt): TWordRec; {$ifdef HASINLINE}inline;{$endif}
begin
  result.YDiv100 := Y div 100;
  result.YMod100 := Y-(result.YDiv100*100); // * is always faster than div
end;
{$else}
function Div100(Y: word): TWordRec;
asm
  mov cl,100
  div cl // ah=remainder=Y mod 100, al=quotient=Year div 100
end;
{$endif}

function UnixTimeToDateTime(const UnixTime: Int64): TDateTime;
begin
  result := (UnixTime / SecsPerDay + UnixDateDelta);
end;

function DateTimeToUnixTime(const AValue: TDateTime): Int64;
begin
  result := Round((AValue - UnixDateDelta) * SecsPerDay);
end;

function UnixMSTimeToDateTime(const UnixTime: Int64): TDateTime;
begin
  result := (UnixTime / MSecsPerDay + UnixDateDelta);
end;

function DateTimeToUnixMSTime(const AValue: TDateTime): Int64;
begin
  result := Round((AValue - UnixDateDelta) * MSecsPerDay);
end;

function NowUTC: TDateTime;
{$ifdef MSWINDOWS}
var SystemTime: TSystemTime;
begin
  GetSystemTime(SystemTime);
  with SystemTime do
    result := EncodeDate(wYear,wMonth,wDay)+
              EncodeTime(wHour,wMinute,wSecond,wMilliseconds);
end;
{$else}
begin
  Result := GetNowUTC;
end;
{$endif}

function Iso8601ToDateTimePUTF8Char(P: PUTF8Char; L: integer): TDateTime;
var tmp: TDateTime;
begin
  Iso8601ToDateTimePUTF8CharVar(P,L,tmp);
  result := tmp;
end;

function Iso8601CheckAndDecode(P: PUTF8Char; L: integer; var Value: TDateTime): boolean;
// handle 'YYYY-MM-DDThh:mm:ss' or 'YYYY-MM-DD' or 'Thh:mm:ss'
begin
  if P=nil then
    result := false else
    if ((L=9) and (P[0]='T') and (P[3]=':')) or // 'Thh:mm:ss'
       ((L=10) and (P[4]='-') and (P[7]='-')) or // 'YYYY-MM-DD'
       ((L=19) and (P[4]='-') and (P[10]='T')) then begin
        Iso8601ToDateTimePUTF8CharVar(P,L,Value);
        result := Value<>0;
      end else
      result := false;
end;

{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
type
  unaligned = Double;
{$endif}

procedure Iso8601ToDateTimePUTF8CharVar(P: PUTF8Char; L: integer; var result: TDateTime);
var i: integer;
    B: cardinal;
    Y,M,D, H,MI,SS: cardinal;
// we expect 'YYYYMMDDThhmmss' format but we handle also 'YYYY-MM-DDThh:mm:ss'
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
    dec(P,8) else begin
    B := ConvertHexToBin[ord(P[0])]; // first digit
    if B>9 then exit else Y := B; // fast check '0'..'9'
    for i := 1 to 3 do begin
      B := ConvertHexToBin[ord(P[i])]; // 3 other digits
      if B>9 then exit else Y := Y*10+B;
    end;
    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
        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
    with Div100(Y) do
      unaligned(result) := (146097*YDiv100) shr 2 + (1461*YMod100) shr 2 +
            (153*M+2) div 5+D-693900;
    if (L<15) or not(P[8] in [' ','T']) then
      exit;
  end;
  H := ord(P[9])*10+ord(P[10])-(48+480);
  if P[11]=':' then inc(P); // allow hh:mm:ss
  MI := ord(P[11])*10+ord(P[12])-(48+480);
  if P[13]=':' then inc(P); // allow hh:mm:ss
  SS := ord(P[13])*10+ord(P[14])-(48+480);
  if (H<24) and (MI<60) and (SS<60) then // inlined EncodeTime()
    result := result + (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
              MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec) / 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: cardinal;
begin
  if Iso8601ToTimePUTF8Char(P,L,H,MI,SS) then
    result := (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
              MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec) / MSecsPerDay else
    result := 0;
end;

function Iso8601ToTimePUTF8Char(P: PUTF8Char; L: integer; var H,M,S: cardinal): boolean;
begin
  result := false;
  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 inc(P); // allow hh:mm:ss
  M := ord(P[2])*10+ord(P[3])-(48+480);
  if P[4]=':' then inc(P); // allow hh:mm:ss
  S := ord(P[4])*10+ord(P[5])-(48+480);
  if (H<24) and (M<60) and (S<60) 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
  Iso8601ToDateTimePUTF8CharVar(pointer(S),length(S),result);
end;

function TimeLogToDateTime(const TimeStamp: TTimeLog): TDateTime;
begin
  result := PTimeLogBits(@TimeStamp)^.ToDateTime;
end;


/// 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: cardinal); overload;
begin
{$ifdef PUREPASCAL}
  PWord(P  )^ := TwoDigitLookupW[Y div 100];
  PWord(P+2)^ := TwoDigitLookupW[Y mod 100];
{$else}
  YearToPChar(Y,P);
{$endif}
  inc(P,4);
  if Expanded then begin
    P^ := '-';
    inc(P);
  end;
  pWord(P)^ := TwoDigitLookupW[M];
  inc(P,2);
  if Expanded then begin
    P^ := '-';
    inc(P);
  end;
  pWord(P)^ := TwoDigitLookupW[D];
end;

procedure TimeToIso8601PChar(P: PUTF8Char; Expanded: boolean; H,M,S: cardinal;
  FirstChar: AnsiChar = 'T'); overload;
// we use Thhmmss format
begin
  P^ := FirstChar;
  inc(P);
  pWord(P)^ := TwoDigitLookupW[H];
  inc(P,2);
  if Expanded then begin
    P^ := ':';
    inc(P);
  end;
  pWord(P)^ := TwoDigitLookupW[M];
  inc(P,2);
  if Expanded then begin
    P^ := ':';
    inc(P);
  end;
  pWord(P)^ := TwoDigitLookupW[S];
end;

procedure DateToIso8601PChar(Date: TDateTime; P: PUTF8Char; Expanded: boolean); overload;
// we use YYYYMMDD date format
var Y,M,D: word;
begin
  DecodeDate(Date,Y,M,D);
  DateToIso8601PChar(P,Expanded,Y,M,D);
end;

/// convert a date into 'YYYY-MM-DD' date format
function DateToIso8601Text(Date: TDateTime): RawUTF8;
begin
  SetLength(Result,10);
  DateToIso8601PChar(Date,pointer(Result),True);
end;

procedure TimeToIso8601PChar(Time: TDateTime; P: PUTF8Char; Expanded: boolean;
  FirstChar: AnsiChar = 'T'); overload;
// we use Thhmmss format
var H,M,S,MS: word;
begin
  DecodeTime(Time,H,M,S,MS);
  TimeToIso8601PChar(P,Expanded,H,M,S,FirstChar);
end;

function DateTimeToIso8601(D: TDateTime; Expanded: boolean;
  FirstChar: AnsiChar='T'): RawUTF8;
// we use YYYYMMDDThhmmss format
var tmp: array[0..31] of AnsiChar;
begin
  if Expanded then begin
    DateToIso8601PChar(D,tmp,true);
    TimeToIso8601PChar(D,@tmp[10],true,FirstChar);
    SetString(result,PAnsiChar(@tmp),19);
  end else begin
    DateToIso8601PChar(D,tmp,false);
    TimeToIso8601PChar(D,@tmp[8],false,FirstChar);
    SetString(result,PAnsiChar(@tmp),15);
  end;
end;

function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8;
// we use YYYYMMDDTdate format
begin
  FastNewRawUTF8(result,8+2*integer(Expanded));
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrUInt(result)-12)^ := CP_UTF8; // use only SetLength() -> force set code page
{$endif}
  DateToIso8601PChar(Date,pointer(result),Expanded);
end;

/// 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;
begin
  FastNewRawUTF8(result,8+2*integer(Expanded));
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrUInt(result)-12)^ := CP_UTF8; // use only SetLength() -> force set code page
{$endif}
  DateToIso8601PChar(pointer(result),Expanded,Y,M,D);
end;

function TimeToIso8601(Time: TDateTime; Expanded: boolean; FirstChar: AnsiChar='T'): RawUTF8;
// we use Thhmmss format
begin
  FastNewRawUTF8(result,7+2*integer(Expanded));
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrUInt(result)-12)^ := CP_UTF8; // use only SetLength() -> force set code page
{$endif}
  TimeToIso8601PChar(Time,pointer(result),Expanded,FirstChar);
end;

function DateTimeToIso8601Text(DT: TDateTime; FirstChar: AnsiChar): RawUTF8;
begin
  DateTimeToIso8601TextVar(DT,FirstChar,result);
end;

procedure DateTimeToIso8601TextVar(DT: TDateTime; FirstChar: AnsiChar; var result: RawUTF8);
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) else
      result := DateTimeToIso8601(DT,true,FirstChar);
end;

procedure DateTimeToIso8601StringVar(DT: TDateTime; FirstChar: AnsiChar; var result: string);
var tmp: RawUTF8;
begin
  DateTimeToIso8601TextVar(DT,FirstChar,tmp);
  Ansi7ToString(Pointer(tmp),length(tmp),result);
end;

procedure DateTimeToIso8601ExpandedPChar(const Value: TDateTime; Dest: PUTF8Char;
  FirstChar: AnsiChar='T');
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);
      inc(Dest,9);
    end;
  end;
  Dest^ := #0;
end;

/// convert a Iso8601 encoded string into a "fake" second count
// - use internally for computation an abstract "year" of 16 months of 32 days
// of 32 hours of 64 minutes of 64 seconds
// - use this function only for fast comparaison between Iso8601 date/time
// - conversion is faster than Iso8601ToDateTime: use only binary integer math
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 for multiply
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;
    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 then
          inc(result,V shl 17) else begin
          result := 0;
          exit;
        end;
      end;
    end;
    if (L<15) or not(P[8] in [' ','T']) then begin
      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 Iso8601ToTimeLog(const S: RawByteString): TTimeLog;
{$ifdef PUREPASCAL}
begin
  result := Iso8601ToTimeLogPUTF8Char(pointer(S),length(S));
end;
{$else}
asm
    xor ecx,ecx  // ContainsNoTime=nil
    or 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;
{$endif}


{ 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 for multiply

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;

{$ifdef MSWINDOWS}
procedure TTimeLogBits.Expand(out Date: TSystemTime);
begin
  Date.wYear := (Value shr (6+6+5+5+4)) and 4095;
  Date.wMonth := 1+(Int64Rec(Value).Lo shr (6+6+5+5)) and 15;
  Date.wDay := 1+(Int64Rec(Value).Lo shr (6+6+5)) and 31;
  Date.wDayOfWeek := 0;
  Date.wHour := (Int64Rec(Value).Lo shr (6+6)) and 31;
  Date.wMinute := (Int64Rec(Value).Lo shr 6) and 63;
  Date.wSecond := Int64Rec(Value).Lo and 63;
end;
{$endif}

procedure TTimeLogBits.From(const S: RawUTF8);
begin
  Value := Iso8601ToTimeLog(S);
end;

procedure TTimeLogBits.From(FileDate: integer);
begin
{$ifdef MSWINDOWS}
  From(LongRec(FileDate).Hi shr 9 + 1980,
       LongRec(FileDate).Hi shr 5 and 15,
       LongRec(FileDate).Hi and 31,
       LongRec(FileDate).Lo shr 11,
       LongRec(FileDate).Lo shr 5 and 63,
       LongRec(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=false);
var HH,MM,SS,MS,Y,M,D: word;
    V: cardinal;
begin
  if DateOnly then
    HH := 0 else
    DecodeTime(DateTime,HH,MM,SS,MS);
  DecodeDate(DateTime,Y,M,D);
  V := HH+D shl 5+M shl 10+Y shl 14-(1 shl 5+1 shl 10);
  if DateOnly then
    Value := Int64(V) shl 12 else
    Value := SS+MM shl 6+Int64(V) shl 12;
end;

procedure TTimeLogBits.FromUnixTime(const UnixTime: Int64);
begin
  From(UnixTimeToDateTime(UnixTime));
end;

procedure TTimeLogBits.FromUnixMSTime(const UnixMSTime: Int64);
begin
  From(UnixMSTimeToDateTime(UnixMSTime));
end;

{$ifdef MSWINDOWS}
var
  UTCTimeCache: TTimeLog;
  UTCTimeTicks: cardinal;
{$endif}

procedure TTimeLogBits.FromUTCTime;
{$ifdef MSWINDOWS}
var Now: TSystemTime;
    V: cardinal;
    Ticks: cardinal;
begin
  Ticks := GetTickCount; // typically in range of 10-16 ms
  if Ticks=UTCTimeTicks then begin
    Value := UTCTimeCache;
    exit;
  end;
  UTCTimeTicks := Ticks;
  GetSystemTime(Now); // this API is fast enough for our purpose
  V := Now.wHour+Now.wDay shl 5+Now.wMonth shl 10+
    Now.wYear shl 14-(1 shl 5+1 shl 10);
  Value := Now.wSecond+Now.wMinute shl 6+Int64(V) shl 12;
  UTCTimeCache := Value;
end;
{$else}
begin
  From(NowUTC);
end;
{$endif}

procedure TTimeLogBits.FromNow;
{$ifdef MSWINDOWS}
var Now: TSystemTime;
    V: cardinal;
begin
  GetLocalTime(Now); // this API is fast enough for our purpose
  V := Now.wHour+Now.wDay shl 5+Now.wMonth shl 10+
    Now.wYear shl 14-(1 shl 5+1 shl 10);
  Value := Now.wSecond+Now.wMinute shl 6+Int64(V) shl 12;
end;
{$else}
begin
  From(Now); // other OS: lets SysUtils.pas get the current time
end;
{$endif}

function TTimeLogBits.ToTime: TDateTime;
begin
  if Value and (1 shl (6+6+5)-1)=0 then
    result := 0 else
    result := EncodeTime(
       (Int64Rec(Value).Lo shr (6+6)) and 31,
       (Int64Rec(Value).Lo shr 6) and 63,
        Int64Rec(Value).Lo and 63, 0);
end;

function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
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
    with Div100(Year) do
      Date := (146097 * YDiv100) shr 2 + (1461 * YMod100) shr 2 +
            (153 * Month + 2) div 5 + Day - 693900;
    result := true;
  end;
end;

function TTimeLogBits.ToDate: TDateTime;
var Y: cardinal;
begin
  Y := (Value shr (6+6+5+5+4)) and 4095;
  if (Y=0) or not TryEncodeDate(Y,
       1+(Int64Rec(Value).Lo shr (6+6+5+5)) and 15,
       1+(Int64Rec(Value).Lo shr (6+6+5)) and 31,result) then
    result := 0;
end;

function TTimeLogBits.ToDateTime: TDateTime;
var Y: cardinal;
    Time: TDateTime;
begin
  Y := (Value shr (6+6+5+5+4)) and 4095;
  if (Y=0) or not TryEncodeDate(Y,
       1+(Int64Rec(Value).Lo shr (6+6+5+5)) and 15,
       1+(Int64Rec(Value).Lo shr (6+6+5)) and 31,result) then
    result := 0;
  if (Value and (1 shl (6+6+5)-1)<>0) and TryEncodeTime(
      (Int64Rec(Value).Lo shr (6+6)) and 31,
      (Int64Rec(Value).Lo shr 6) and 63,
      Int64Rec(Value).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+(Int64Rec(Value).Lo shr (6+6+5+5)) and 15;
end;

function TTimeLogBits.Day: Integer;
begin
  result := 1+(Int64Rec(Value).Lo shr (6+6+5)) and 31;
end;

function TTimeLogBits.Hour: Integer;
begin
  result := (Int64Rec(Value).Lo shr (6+6)) and 31;
end;

function TTimeLogBits.Minute: Integer;
begin
  result := (Int64Rec(Value).Lo shr 6) and 63;
end;

function TTimeLogBits.Second: Integer;
begin
  result := Int64Rec(Value).Lo and 63;
end;
            
function TTimeLogBits.ToUnixTime: Int64;
begin
  result := DateTimeToUnixTime(ToDateTime);
end;

function TTimeLogBits.ToUnixMSTime: Int64;
begin
  result := DateTimeToUnixMSTime(ToDateTime);
end;

function TTimeLogBits.Text(Dest: PUTF8Char; Expanded: boolean; FirstTimeChar: AnsiChar): integer;
begin
  if Value=0 then
    result := 0 else
  if Value and (1 shl (6+6+5)-1)=0 then begin
    // no Time: just convert date
    DateToIso8601PChar(Dest,Expanded,
      (Value shr (6+6+5+5+4)) and 4095,
      1+(Int64Rec(Value).Lo shr (6+6+5+5)) and 15,
      1+(Int64Rec(Value).Lo shr (6+6+5)) and 31);
    if Expanded then
      result := 10 else
      result := 8;
  end else
  if Value shr (6+6+5)=0 then begin
    // no Date: just convert time
    TimeToIso8601PChar(Dest,Expanded,
      (Int64Rec(Value).Lo shr (6+6)) and 31,
      (Int64Rec(Value).Lo shr 6) and 63,
       Int64Rec(Value).Lo and 63, FirstTimeChar);
    if Expanded then
      result := 9 else
      result := 7;
  end else begin
    // convert time and date
    DateToIso8601PChar(Dest,Expanded,
      (Value shr (6+6+5+5+4)) and 4095,
      1+(Int64Rec(Value).Lo shr (6+6+5+5)) and 15,
      1+(Int64Rec(Value).Lo shr (6+6+5)) and 31);
    if Expanded then
      inc(Dest,10) else
      inc(Dest,8);
    TimeToIso8601PChar(Dest,Expanded,
      (Int64Rec(Value).Lo shr (6+6)) and 31,
      (Int64Rec(Value).Lo shr 6) and 63,
       Int64Rec(Value).Lo and 63, FirstTimeChar);
    if Expanded then
      result := 15+4 else
      result := 15;
  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
    SetString(result,PAnsiChar(@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 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(DateTime: TDateTime): TTimeLog;
begin
  PTimeLogBits(@result)^.From(DateTime);
end;


procedure AppendToTextFile(aLine: RawUTF8; const aFileName: TFileName);
var F: THandle;
    Old: TFileName;
    Date: array[1..22] of AnsiChar;
    i: integer;
{$ifdef MSWINDOWS}
    Now: TSystemTime; {$else}
    D: TDateTime;     {$endif}
begin
  if aFileName='' then
    exit;
  F := FileOpen(aFileName,fmOpenWrite);
  if PtrInt(F)<0 then begin
    F := FileCreate(aFileName);
    if PtrInt(F)<0 then
      exit;
  end;
   // append to end of file
  if FileSeek64(F,0,soFromEnd)>MAXLOGSIZE 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
{$ifdef MSWINDOWS}
  GetLocalTime(Now); // windows dedicated function
  DateToIso8601PChar(@Date[3],true,Now.wYear,Now.wMonth,Now.wDay);
  TimeToIso8601PChar(@Date[13],true,Now.wHour,Now.wMinute,Now.wSecond,' ');
{$else}
  D := Now; // cross platform version
  DateToIso8601PChar(D,@Date[3],true);
  TimeToIso8601PChar(D,@Date[13],true);
{$endif}
  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
    Msg := StringToUTF8(SysErrorMessage(GetLastError));
    if Msg='' then
      exit;
  end;
  AppendToTextFile(Msg,{$ifndef MSWINDOWS}ExtractFileName{$endif}
    (ChangeFileExt(paramstr(0),'.log')));
end;

{$ifndef FPC}
function GetEnumBaseTypeList(aTypeInfo: pointer; out MaxValue: Integer): PShortString;
begin
  if aTypeInfo=nil then
    result := nil else begin
    inc(PByte(aTypeInfo)); // TypeInfo.Name
    inc(PByte(aTypeInfo),PByte(aTypeInfo)^+sizeof(byte)*2+sizeof(longint)*2);
    aTypeInfo := PPointer(PPointer(aTypeInfo)^)^; // BaseType
    inc(PByte(aTypeInfo)); // BaseTypeInfo.Name
    inc(PByte(aTypeInfo),PByte(aTypeInfo)^+sizeof(Byte)*2+sizeof(longint));
    MaxValue := PLongint(aTypeInfo)^;
    result := pointer(PtrUInt(aTypeInfo)+sizeof(longint)+sizeof(pointer));
  end;
end;
{$endif}

function GetEnumName(aTypeInfo: pointer; aIndex: integer): PShortString;
{$ifdef FPC}
begin
  result := GetFPCEnumName(aTypeInfo, aIndex); // from SynFPCTypInfo
{$else}
var MaxValue: integer;
const NULL_SHORTSTRING: string[1] = '';
begin
  result := GetEnumBaseTypeList(aTypeInfo,MaxValue);
  if result<>nil then
    if aIndex>MaxValue then
      result := @NULL_SHORTSTRING else
      while aIndex>0 do begin
        inc(PByte(result),ord(result^[0])+1); // next short string
        dec(aIndex);
      end;
{$endif}
end;

function GetEnumNameValue(aTypeInfo: pointer; aValue: PUTF8Char; aValueLen: integer): Integer;
{$ifdef FPC}
begin
  result := GetFPCEnumValue(aTypeInfo, aValue); // from SynFPCTypInfo
{$else}
var List: PShortString;
    MaxValue: integer;
begin
  List := GetEnumBaseTypeList(aTypeInfo,MaxValue);
  if List<>nil then
    for result := 0 to MaxValue do
      if IdemPropName(List^,aValue,aValueLen) then
        exit else
        inc(PByte(List),ord(List^[0])+1); // next short string
  result := -1;
{$endif}
end;

function IsEqualGUID(const guid1, guid2: TGUID): Boolean;
{$ifdef CPU64}
var a: array[0..1] of Int64 absolute guid1;
    b: array[0..1] of Int64 absolute guid2;
{$else}
var a: array[0..3] of integer absolute guid1;
    b: array[0..3] of integer absolute guid2;
{$endif}
begin // faster implementation than in SysUtils.pas
{$ifdef CPU64}
  Result := (a[0]=b[0]) and (a[1]=b[1]);
{$else}
  Result := (a[0]=b[0]) and (a[1]=b[1]) and (a[2]=b[2]) and (a[3]=b[3]);
{$endif}
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
    P[0] := HexChars[PtrUInt(guid[i]) shr 4 and $F];
    P[1] := HexChars[PtrUInt(guid[i]) and $F];
    inc(P,2);
  end;
  inc(PByte(guid),4);
  for i := 1 to 2 do begin
    P[0] := '-';
    P[1] := HexChars[PtrUInt(guid[1]) shr 4 and $F];
    P[2] := HexChars[PtrUInt(guid[1]) and $F];
    P[3] := HexChars[PtrUInt(guid[0]) shr 4 and $F];
    P[4] := HexChars[PtrUInt(guid[0]) and $F];
    inc(PByte(guid),2);
    inc(P,5);
  end;
  P[0] := '-';
  P[1] := HexChars[PtrUInt(guid[0]) shr 4 and $F];
  P[2] := HexChars[PtrUInt(guid[0]) and $F];
  P[3] := HexChars[PtrUInt(guid[1]) shr 4 and $F];
  P[4] := HexChars[PtrUInt(guid[1]) and $F];
  P[5] := '-';
  inc(PByte(guid),2);
  inc(P,6);
  for i := 0 to 5 do begin
    P[i*2]   := HexChars[PtrUInt(guid[i]) shr 4 and $F];
    P[i*2+1] := HexChars[PtrUInt(guid[i]) and $F];
  end;
  result := P+12;
end;

function HexaToByte(P: PUTF8Char; var Dest: byte): boolean; {$ifdef HASINLINE}inline;{$endif}
var B,C: byte;
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(const guid: TGUID): RawUTF8;
var P: PUTF8Char;
begin
  FastNewRawUTF8(result,38);
  P := pointer(result);
  P^ := '{';
  GUIDToText(P+1,@guid)^ := '}';
end;

function GUIDToShort(const guid: TGUID): TGUIDShortString;
begin
  result[0] := #38;
  result[1] := '{';
  result[38] := '}';
  GUIDToText(@result[2],@guid);
end;

function GUIDToString(const 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}

function RawUTF8ToGUID(const text: RawByteString): TGUID;
begin
  if (length(text)<>38) or (text[1]<>'{') or (text[38]<>'}') or
     (TextToGUID(@text[2],@result)=nil) then
    fillchar(result,sizeof(result),0);
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;
  fillchar(result,sizeof(result),0);
end;

function StrCurr64(P: PAnsiChar; const Value: Int64): PAnsiChar;
var c, c10: Int64;
    c64: Int64Rec absolute c;
    Lo: cardinal;
begin
  if Value=0 then begin
    result := P-1;
    result^ := '0';
    exit;
  end;
  if Value<0 then
    c := -Value else
    c := Value;
  if (c64.Hi=0) and (c64.Lo<10000) then begin
    Lo := c64.Lo; // only decimals
    result := P;
  end else begin
    Lo := 10000;
    result := P-1; // reserve space to insert '.'
  end;
  repeat
    if c64.Hi=0 then begin
      result := StrUInt32(result,c64.Lo);
      break;
    end;
    c10 := c div 100;   // one div by two digits
    dec(c,c10*100);     // fast c := c mod 100
    dec(result,2);
    PWord(result)^ := TwoDigitLookupW[c];
    c := c10;
    if c10=0 then break;
  until false;
  if Lo<10000 then begin
    // only decimals -> append left '0.' to '0.000'
    case Lo of
    1..9: begin // append left '0.000'
      dec(result);
      result^ := '0';
      dec(result,2);
      PWord(result)^ := ord('0')+ord('0')shl 8;
    end;
    10..99: begin // append left '0.00'
      dec(result,2);
      PWord(result)^ := ord('0')+ord('0')shl 8;
    end;
    100..999: begin // append left '0.0'
      dec(result);
      result^ := '0';
    end;
    end;
    dec(result,2);
    PWord(result)^ := ord('0')+ord('.')shl 8;
  end else begin
    // insert '.' just before last 4 decimals
    P[-1] := P[-2];
    P[-2] := P[-3];
    P[-3] := P[-4];
    P[-4] := P[-5];
    P[-5] := '.';
  end;
  if Value<0 then begin
    dec(result);
    result^ := '-';
  end;
end;

procedure Curr64ToStr(const Value: Int64; var result: RawUTF8); overload;
var tmp: array[0..31] of AnsiChar;
    P: PAnsiChar;
    Decim, L: Cardinal;
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;
  SetRawUTF8(result,P,L);
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;
  move(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;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
  Int64Rec(result).Lo := c;
  inc(P);
  repeat
    if P^<>'.' then begin
      c := byte(P^)-48;
      if c>9 then
        break;
      {$ifdef CPU64}
      result := result*10;
      {$else}
      result := result shl 3+result+result;
      {$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 CPU64}
  2: result := result*1000;
  3: result := result*100;
  4: result := result*10;
  {$else}
  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;
  {$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
    Spare: integer;
begin
  Spare := V64 mod 100;
  if Spare<>0 then
    dec(V64,Spare);
  result := Value;
end;

function SimpleRoundTo2Digits(Value: Currency): Currency;
var V64: Int64 absolute Value; // to avoid any floating-point precision issues
    Spare: integer;
begin
  Spare := V64 mod 100;
  if Spare<>0 then
    if Spare>50 then
      inc(V64,100-Spare) else
    if Spare<-50 then
      dec(V64,100+Spare) else
      dec(V64,Spare);
  result := Value;
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;
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;

function TrimLeftLowerCaseShort(V: PShortString): RawUTF8;
{$ifdef NODELPHIASM}
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;
{$else}
asm // eax=V
    xor cl,cl
    push edx // save result RawUTF8
    or 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
    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}

function UnCamelCase(const S: RawUTF8): RawUTF8; overload;
begin
  result := '';
  if S='' then
    exit;
  SetLength(result,PInteger(PtrInt(S)-sizeof(integer))^*2); // max length
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrInt(result)-12)^ := CP_UTF8; // use only SetLength() -> force set code page
{$endif}
  SetLength(result,UnCamelCase(pointer(result),pointer(S)));
end;

function UnCamelCase(D, P: PUTF8Char): integer; overload;
var Space, SpaceBeg, DBeg: PUTF8Char;
    CapitalCount: integer;
    Number: boolean;
label Next;
begin
  Space := D;
  DBeg := D;
  SpaceBeg := D;
  if (D<>nil) and (P<>nil) then // avoid GPF
  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;
  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;
  result := D-DBeg;
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: ShortString;
    TrimLeft: integer;
begin
  result := '';
  if C=nil then
    exit;
  // new TObject.ClassName is UnicodeString (since Delphi 20009) -> inline code
  // with vmtClassName = UTF-8 encoded text stored in a shortstring = -44
  DelphiName := PShortString(PPointer(PtrInt(C)+vmtClassName)^)^;
  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;
  SetString(result,PAnsiChar(@DelphiName[TrimLeft+1]),ord(DelphiName[0])-TrimLeft);
end;

function GetCaptionFromClass(C: TClass): string;
var tmp: RawUTF8;
    P: PUTF8Char;
begin
  if C=nil then
    result := '' else begin
    tmp := RawUTF8(C.ClassName);
    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;
var PS: PUTF8Char;
    tmp: array[byte] of AnsiChar;
    L: integer;
begin
  PS := pointer(GetEnumName(aTypeInfo,aIndex));
  L := ord(PS^);
  inc(PS);
  while (L>0) and (PS^ in ['a'..'z']) do begin inc(PS); dec(L); end;
  tmp[L] := #0; // GetCaptionFromPCharLen expect
  move(PS^,tmp,L);
  GetCaptionFromPCharLen(tmp,result);
end;

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

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 GetMimeContentType(Content: Pointer; Len: integer;
  const FileName: TFileName=''): RawUTF8;
begin // see http://www.garykessler.net/library/file_sigs.html for magic numbers
  result := '';
  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
    $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';
      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;
    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 := 'image/jpeg'; // FF D8 FF DB/E0/E1/E2/E3/E8
        else
          case PWord(Content)^ of
            $4D42: Result := 'image/bmp'; // 42 4D
          end;
      end;
    end;
  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') of
      // 63   68  72  76   81   86   91   96  100  105
      1:  Result := 'image/png';
      5:  Result := 'image/gif';
      9:  Result := 'image/tiff';
      14,18: Result := 'image/jpeg';
      23: Result := 'image/bmp';
      27,91: Result := 'application/msword';
      31,35: Result := HTML_CONTENT_TYPE;
      40: Result := 'text/css';
      44: Result := 'application/x-javascript';
      47: Result := 'image/x-icon';
      51,105: Result := 'application/font-woff';
      55: 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;
      else
        if Result<>'' then
          Result := 'application/'+copy(result,2,10);
    end;
  end;
  if Result='' then
    Result := BINARY_CONTENT_TYPE;
end;

function IsContentCompressed(Content: Pointer; Len: integer): boolean;
begin
  if (Content<>nil) and (Len>4) then
    case PCardinal(Content)^ of
    $04034B50, // 'application/zip' = 50 4B 03 04
    $21726152, // 'application/x-rar-compressed' = 52 61 72 21 1A 07 00
    $AFBC7A37, // 'application/x-7z-compressed' = 37 7A BC AF 27 1C
    $75B22630, // 'audio/x-ms-wma' = 30 26 B2 75 8E 66
    $9AC6CDD7, // 'video/x-ms-wmv' = D7 CD C6 9A 00 00
    $474E5089, // 'image/png' = 89 50 4E 47 0D 0A 1A 0A
    $38464947, // 'image/gif' = 47 49 46 38
    $46464F77, // 'application/font-woff' = wOFF in BigEndian
    $002A4949, $2A004D4D, $2B004D4D: // 'image/tiff'
      result := true;
    $46464952: if Len>16 then // RIFF
      case PCardinalArray(Content)^[2] of
      $50424557: // 'image/webp'
        result := true;
      else result := False;
      end else
      result := false;
    else
      case PCardinal(Content)^ and $00ffffff of
        $685A42, // 'application/bzip2' = 42 5A 68
        $088B1F, // 'application/gzip' = 1F 8B 08
        $492049, // 'image/tiff' = 49 20 49
        $FFD8FF: // 'image/jpeg' = FF D8 FF DB/E0/E1/E2/E3/E8
          result := true;
        else result := false;
      end;
    end else
    result := false;
end;

function IsHTMLContentTypeTextual(Headers: PUTF8Char): Boolean;
begin
  result := ExistsIniNameValue(Headers,HEADER_CONTENT_TYPE_UPPER,
    ['TEXT/','APPLICATION/JSON','APPLICATION/XML',
     'APPLICATION/X-JAVASCRIPT','IMAGE/SVG+XML']);
end;

function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;
var boundary: 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))+#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 IdemPCharAndGetNextItem(P,
         'CONTENT-DISPOSITION: FORM-DATA; NAME="',part.Name,'"') then
        IdemPCharAndGetNextItem(P,'; FILENAME="',part.FileName,'"') else
      if IdemPCharAndGetNextItem(P,'CONTENT-TYPE: ',part.ContentType) or
         IdemPCharAndGetNextItem(P,'CONTENT-TRANSFER-ENCODING: ',part.Encoding) then;
      GetNextLineBegin(P,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
      exit;
    part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
    {$ifdef UNICODE}
    if (part.ContentType='') or (PosEx('-8',part.ContentType)>0) then
      SetCodePage(part.Content,CP_UTF8,false) else // ensure raw field value is UTF-8
    {$endif}
    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 FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt;
var L,i,cmp: PtrInt;
begin
  if R<0 then
    result := 0 else begin
    L := 0;
    result := -1; // return -1 if found
    repeat
      i := (L + R) shr 1;
      cmp := StrComp(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 (StrComp(P^[i],Value)>=0) do dec(i);
    result := i+1; // return the index where to insert
  end;
end;

function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char;
  Compare: TUTF8Compare): PtrInt; overload;
var L,i,cmp: PtrInt;
begin
  if not Assigned(Compare) or (R<0) then
    result := 0 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; overload;
var L, cmp: PtrInt;
begin
  L := 0;
  if Assigned(Compare) and (0<=R) then
  repeat
    result := (L + R) shr 1;
    cmp := Compare(P^[result],Value);
    if cmp=0 then
      exit;
    if cmp<0 then
      L := result + 1 else
      R := result - 1;
  until (L > R);
  result := -1;
end;

function FastFindPUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt;
// very fast find using a binary search
var L, cmp: PtrInt;
begin
  L := 0;
  if 0<=R then
  repeat
    result := (L + R) shr 1;
    cmp := StrComp(P^[result],Value);
    if cmp=0 then
      exit;
    if cmp<0 then
      L := result + 1 else
      R := result - 1;
  until (L > R);
  result := -1;
end;

function FastFindIndexedPUTF8Char(P: PPUTF8CharArray; R: PtrInt;
  var SortedIndexes: TCardinalDynArray; Value: PUTF8Char;
  ItemComp: TUTF8Compare): PtrInt;
// very fast find using a binary search
var L, cmp: PtrInt;
begin
  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
      L := result + 1 else
      R := result - 1;
  until (L > R);
  result := -1;
end;

function AddSortedRawUTF8(var Values: TRawUTF8DynArray; var ValuesCount: integer;
  const Value: RawUTF8; CoValues: PIntegerDynArray=nil; ForcedIndex: PtrInt=-1;
  Compare: TUTF8Compare=nil): PtrInt;
var n: PtrInt;
begin
  if ForcedIndex>=0 then
    result := ForcedIndex else begin
    if Assigned(Compare) then
      result := FastLocatePUTF8CharSorted(pointer(Values),ValuesCount-1,pointer(Value),Compare) else
      result := FastLocatePUTF8CharSorted(pointer(Values),ValuesCount-1,pointer(Value));
    if result<0 then
      exit; // Value exists -> fails
  end;
  n := Length(Values);
  if ValuesCount=n then begin
    inc(n,256+n shr 3);
    SetLength(Values,n);
    if CoValues<>nil then
      SetLength(CoValues^,n);
  end;
  n := ValuesCount;
  if result<n then begin
    n := (n-result)*sizeof(pointer);
    move(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
      move(CoValues^[result],CoValues^[result+1],n);
    end;
  end else
    result := n;
  Values[result] := Value;
  inc(ValuesCount);
end;


type
  /// used internaly for faster quick sort
  TQuickSortRawUTF8 = {$ifndef UNICODE}object{$else}record{$endif}
    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 L < J then
      Sort(L, J);
    L := I;
  until I >= 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; 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
        move(CoValues^[Index+1],CoValues^[Index],n*sizeof(Integer));
      move(pointer(Values[Index+1]),pointer(Values[Index]),n*sizeof(pointer));
      PtrUInt(Values[ValuesCount]) := 0; // avoid GPF
    end;
    result := true;
  end;
end;


{$ifdef MSWINDOWS}

{$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
  fillchar(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;


{$else}

const
  _SC_PAGE_SIZE = $1000;

{$endif MSWINDOWS}

{ TFileVersion }

constructor TFileVersion.Create(const aFileName: TFileName;
  aMajor,aMinor,aRelease: integer);
var M,D: word;
{$ifdef MSWINDOWS}
    Size, Size2: DWord;
    Pt: Pointer;
    Info: ^TVSFixedFileInfo;
    FileTime: TFILETIME;
    SystemTime: TSYSTEMTIME;
    tmp: TFileName;
{$endif}
begin
  Major := aMajor;
  Minor := aMinor;
  Release := aRelease;
  {$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
            Major := dwFileVersionMS shr 16;
            Minor := word(dwFileVersionMS);
            Release := dwFileVersionLS shr 16;
          end;
          Build := 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;
      finally
        Freemem(Pt);
      end;
    end;
  end;
  {$endif}
  Main := IntToString(Major)+'.'+IntToString(Minor);
  fDetailed := Main+ '.'+IntToString(Release)+'.'+IntToString(Build);
  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 SetExecutableVersion(aMajor,aMinor,aRelease: integer);
var setVersion,i: integer;
{$ifdef MSWINDOWS}
    Tmp: array[byte] of WideChar;
    TmpSize: cardinal;
{$else}
{$endif}
begin
  setVersion := aMajor shl 16+aMinor shl 8+aRelease;
  with ExeVersion do
  if Version<>nil then
    if Version.Version32=setVersion then
      exit else begin // forget previous to allow version number forcing
      i := GarbageCollector.IndexOf(Version);
      if i>0 then
        GarbageCollector.Delete(i);
    end;
  with ExeVersion do
  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;
    Version := TFileVersion.Create(InstanceFileName,aMajor,aMinor,aRelease);
    GarbageCollector.Add(Version);
    ProgramFullSpec := FormatUTF8('% % (%)',
      [ProgramFileName,Version.Detailed,DateTimeToIso8601(Version.BuildDateTime,True,' ')]);
    ProgramName := StringToUTF8(ExtractFileName(ProgramFileName));
    i := length(ProgramName);
    while i>0 do
      if ProgramName[i]='.' then begin
        SetLength(ProgramName,i-1);
        break;
      end else
      dec(i);
    {$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}
    Host := GetHostName;
    {$ifdef KYLIX3}
    User := LibC.getpwuid(LibC.getuid)^.pw_name;
    {$endif}
    {$endif}
    if Host='' then
      Host := 'unknown';
    if User='' then
      User := 'unknown';
  end;
end;

{$ifdef DARWIN}
function mprotect(Addr: Pointer; Len: size_t; Prot: Integer): Integer;
  cdecl external 'libc.dylib' name 'mprotect';
  {$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);
  end;
end;
{$else}
var PageSize, AlignedAddr: PtrInt;
    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 := _SC_PAGE_SIZE;
  AlignedAddr := PtrInt(Old) and not (PageSize - 1);
  while PtrInt(Old) + Size >= AlignedAddr + PageSize do
    Inc(PageSize,_SC_PAGE_SIZE);
  {$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;

{$ifndef CPUARM}

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 := PtrInt(RedirectFunc)-PtrInt(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 CPUARM}


{$ifndef LVCL}
{$ifndef FPC}
{$ifdef MSWINDOWS}

{ THeapMemoryStream = faster TMemoryStream using FastMM4/SynScaleMM heap,
  not windows.GlobalAlloc() }

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 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
    move(Values[result],Values[result+1],(Count-result)*2) else
    result := Count;
  Values[result] := aValue;
  inc(Count);
end;

function TSortedWordArray.IndexOf(aValue: Word): PtrInt;
var L,R: PtrInt;
    cmp: integer;
begin
  L := 0;
  R := Count-1;
  if 0<=R then
  repeat
    result := (L + R) shr 1;
    cmp := Values[result]-aValue;
    if cmp=0 then
      exit else
    if cmp<0 then
      L := result + 1 else
      R := result - 1;
  until (L > R);
  result := -1;
end;

{$ifdef PUREPASCAL}
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;
{$else}
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;
{$endif}

function FromVarInt32(var Source: PByte): integer;
begin // 0=0,1=1,2=-1,3=2,4=-2...
  result := integer(FromVarUInt32(Source));
  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 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 PUREPASCAL}
function ToVarUInt32(Value: PtrUInt; Dest: PByte): PByte;
begin
  if Value>$7f then
  repeat
    Dest^ := (Value and $7F) or $80;
    Value := Value shr 7;
    inc(Dest);
  until Value<=$7f;
  Dest^ := Value;
  inc(Dest);
  result := Dest;
end;
{$else}
function ToVarUInt32(Value: PtrUInt; Dest: PByte): PByte;
asm // eax=Value edx=Dest
    cmp eax,$7F
    ja @n
    mov [edx],al
    lea eax,[edx+1]
    ret
@n: mov ecx,eax
@s: and cl,$7F // handle two bytes per loop
    shr eax,7
    or cl,$80
    cmp eax,$7f
    mov [edx],cl
    lea edx,[edx+1]
    mov ecx,eax
    jbe @z
    and cl,$7F
    shr eax,7
    or cl,$80
    cmp eax,$7f
    mov [edx],cl
    mov ecx,eax
    lea edx,[edx+1]
    ja @s
@z: mov [edx],al
    lea eax,[edx+1]
end;
{$endif}

{$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;
{$else}
function FromVarUInt32(var Source: PByte): cardinal;
var c: PtrUInt;
begin
  result := Source^;
  inc(Source);
  if result<=$7f then
    exit;
  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;
{$endif}

function FromVarUInt32High(var Source: PByte): cardinal;
var c: PtrUInt;
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 FromVarUInt32up128(var Source: PByte): cardinal;
var c: PtrUInt;
begin 
  result := Source^ shl 7;
  inc(Source);
  if result<=$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 ToVarUInt64(Value: QWord; Dest: PByte): PByte;
begin
  {$ifndef CPU64}
  if Value<MaxInt then begin
    result := ToVarUInt32(Int64Rec(Value).Lo,Dest);
    exit;
  end;
  {$endif}
  if Value>$7f then
  repeat
    Dest^ := (byte(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;
begin
  if Source^>$7f then begin
    n := 0;
    result := PtrUInt(Source^) and $7F;
    inc(Source);
    repeat
      c := Source^;
      inc(n,7);
      if c<=$7f then
        break;
      result := result or (QWord(c and $7f) shl n);
      inc(Source);
    until false;
    result := result or (QWord(c) shl n);
  end else
    result := Source^;
  inc(Source);
end;

function ToVarInt64(Value: Int64; Dest: PByte): PByte;
begin // 0=0,1=1,2=-1,3=2,4=-2...
{$ifdef CPU64}
  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 := ToVarUInt64(Value,Dest);
{$else}
  if Value<0 then
    // -1->2, -2->4..
    result := ToVarUInt64((-Value) shl 1,Dest) else
  if Value>0 then
    // 1->1, 2->3..
    result := ToVarUInt64((Value shl 1)-1,Dest) else begin
    // 0->0
    Dest^ := 0;
    inc(Dest);
    result := Dest;
  end;
{$endif}
end;

function FromVarInt64(var Source: PByte): Int64;
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}Int64Rec(result).Lo{$endif} 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 := -(c shr 1) else
      // 1->1, 3->2..
      result := (c shr 1)+1;
  end;
  inc(Source);
end;

function FromVarInt64Value(Source: PByte): Int64;
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}Int64Rec(result).Lo{$endif} 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
    if c=0 then
      result := 0 else
    if c and 1<>0 then
      // 1->1, 3->2..
      result := (c shr 1)+1 else
      // 0->0, 2->-1, 4->-2..
      result := -(c shr 1);
end;

function GotoNextVarInt(Source: PByte): pointer;
begin
  if Source<>nil then begin
    while Source^>$7f do inc(Source);
    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
    Move(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);
  SetString(Result,PAnsiChar(Source),Len);
  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}

function RTTIArraySize(typeInfo: Pointer): SizeInt;
type
  PArrayInfo=^TArrayInfo;
  TArrayInfo=
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    ElSize: SizeInt;
    ElCount: SizeInt;
    ElInfo: Pointer;
  end;
begin
  with PArrayInfo(pointer(GetFPCTypeData(typeInfo)))^ do
    result := ElSize * ElCount;
end;

function RTTIRecordSize(typeInfo: Pointer): SizeInt; inline;
type
  PRecordInfo=^TRecordInfo;
  TRecordInfo=
    {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
    packed
    {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    record
    Size: Longint;
    Count: Longint;
    { Elements: array[count] of TRecordElement }
  end;
begin
  result := PRecordInfo(pointer(GetFPCTypeData(typeInfo)))^.Size;
end;

function RTTIManagedSize(typeInfo: Pointer): SizeInt; inline;
begin
  case TTypeKind(PByte(typeinfo)^) of
    tkLString,tkLStringOld,tkWString,tkUString,
    tkInterface,tkDynarray:
      result := sizeof(Pointer);
{$ifdef FPC_HAS_FEATURE_VARIANTS}
    tkVariant:
      result := sizeof(TVarData);
{$endif FPC_HAS_FEATURE_VARIANTS}
    tkArray:
      result := RTTIArraySize(typeinfo);
    tkObject,tkRecord:
      result := RTTIRecordSize(typeinfo);
  else
    raise ESynException.CreateUTF8('RTTIManagedSize(%)',[PByte(typeinfo)^]);
  end;
end;

procedure RecordClear(var Dest; TypeInfo: pointer);
  [external name 'FPC_FINALIZE'];

procedure RecordAddRef(var Data; TypeInfo : pointer);
  [external name 'FPC_ADDREF'];

procedure RecordCopy(var Dest; const Source; TypeInfo: pointer);
begin // external name 'FPC_COPY' does not work as we need
  RecordClear(Dest,TypeInfo);
  move(Source,Dest,RTTIManagedSize(TypeInfo));
  RecordAddRef(Dest,TypeInfo);
end;

procedure CopyArray(dest, source, typeInfo: Pointer; cnt: PtrUInt);
var i, size: SizeInt;
begin
  size := RTTIManagedSize(typeInfo);
  if size>0 then
    for i := 1 to cnt do begin
      RecordClear(dest^,TypeInfo); // inlined RecordCopy()
      move(source^,dest^,size);
      RecordAddRef(dest^,TypeInfo);
      inc(PByte(source),size);
      inc(PByte(dest),size);
    end;
end;

{$else}

procedure CopyArray(dest, source, typeInfo: Pointer; cnt: PtrUInt);
asm
{$ifdef CPU64}
  {$ifdef CPUX64}
  .NOFRAME
  {$endif}
  jmp System.@CopyArray
{$else}
  push dword ptr [EBP+8]
  call System.@CopyArray
{$endif}
end;

{$endif FPC}

function RecordEquals(const RecA, RecB; TypeInfo: pointer): boolean;
var FieldTable: PFieldTable absolute TypeInfo;
    F: integer;
    Field: ^TFieldInfo;
    Diff: cardinal;
    A, B: PAnsiChar;
begin
  A := @RecA;
  B := @RecB;
  if A=B then begin // both nil or same pointer
    result := true;
    exit;
  end;
  result := false;
  if  not (FieldTable^.Kind in tkRecordTypes) then
    exit; // raise Exception.CreateUTF8('% is not a record',[Typ^.Name]);
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  FieldTable := GetFPCAlignPtr(FieldTable);
  {$else}
  inc(PtrUInt(FieldTable),FieldTable^.NameLen);
  {$endif}
  Field := @FieldTable^.ManagedFields[0];
  Diff := 0;
  for F := 1 to FieldTable^.ManagedCount do begin
    Diff := Field^.Offset-Diff;
    if Diff<>0 then begin
      if not CompareMem(A,B,Diff) then
        exit; // binary block not equal
      inc(A,Diff);
      inc(B,Diff);
    end;
    case Field^.TypeInfo^.Kind of
      tkLString:
        if PAnsiString(A)^=PAnsiString(B)^ then
          Diff := sizeof(pointer) else
          exit;
      tkWString:
        if PWideString(A)^=PWideString(B)^ then
          Diff := sizeof(pointer) else
          exit;
      {$ifdef UNICODE}
      tkUString:
        if PUnicodeString(A)^=PUnicodeString(B)^ then
          Diff := sizeof(pointer) else
          exit;
      {$endif}
      tkRecord{$ifdef FPC},tkObject{$endif}:
        if RecordEquals(A^,B^,Field^.TypeInfo{$ifndef FPC}^{$endif}) then
          Diff := RecordTypeInfoSize(Field^.TypeInfo{$ifndef FPC}^{$endif}) else
          exit;
      {$ifndef NOVARIANTS}
      tkVariant:
        if PVariant(A)^=PVariant(B)^ then
          Diff := sizeof(variant) else
          exit;
      {$endif}
      {$ifdef FPC} // FPC does include RTTI for unmanaged fields! :)
      else
        if Field^.TypeInfo^.Kind in tkManagedTypes then
          raise ESynException.CreateUTF8('RecordEquals(kind=%)',[ord(Field^.TypeInfo^.Kind)]) else begin
          if F=FieldTable^.ManagedCount then
            Diff := FieldTable.Size-Field^.Offset else
            Diff := FieldTable^.ManagedFields[F].Offset-Field^.Offset;
          if not CompareMem(A,B,Diff) then
            exit; // binary block not equal
        end;
      {$else}
      else exit; // kind of field not handled
      {$endif}
    end;
    inc(A,Diff);
    inc(B,Diff);
    inc(Diff,Field^.Offset);
    inc(Field);
  end;
  if CompareMem(A,B,FieldTable.Size-Diff) then
    result := true;
end;

function RecordSaveLength(const Rec; TypeInfo: pointer): integer;
var FieldTable: PFieldTable absolute TypeInfo;
    F, Len: integer;
    Field: ^TFieldInfo;
    P: PPtrUInt;
    R: PAnsiChar;
    DynArray: TDynArray;
    IntFieldTable: PFieldTable;
begin
  R := @Rec;
  if (R=nil) or not(FieldTable^.Kind in tkRecordTypes) then begin
    result := 0; // should have been checked before
    exit; // raise Exception.CreateUTF8('% is not a record',[FieldTable^.NameLen]);
  end;
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  FieldTable := GetFPCAlignPtr(FieldTable);
  {$else}
  inc(PtrUInt(FieldTable),FieldTable^.NameLen);
  {$endif}
  Field := @FieldTable.ManagedFields[0];
  result := FieldTable.Size;
  for F := 1 to FieldTable.ManagedCount do begin
    P := pointer(R+Field.Offset);
    case Field.TypeInfo^.Kind of
      tkDynArray: begin
        DynArray.Init(Field.TypeInfo{$ifndef FPC}^{$endif},P^);
        inc(result,DynArray.SaveToLength-sizeof(PtrUInt));
      end;
      tkLString, tkWString: // length stored within WideString is in bytes
        if P^=0 then
          dec(result,sizeof(PtrUInt)-1) else
          inc(result,ToVarUInt32LengthWithData(PInteger(P^-sizeof(integer))^)-sizeof(PtrUInt));
      {$ifdef UNICODE}
      tkUString:
        if P^=0 then
          dec(result,sizeof(PtrUInt)-1) else
          inc(result,ToVarUInt32LengthWithData(PInteger(P^-sizeof(integer))^*2)-sizeof(PtrUInt));
      {$endif}
      tkRecord{$ifdef FPC},tkObject{$endif}: begin
        Len := RecordSaveLength(P^,Field.TypeInfo{$ifndef FPC}^{$endif});
        if Len=0 then begin
          result := 0;
          exit; // invalid/unhandled nested record content
        end;
        inc(result,Len);
        IntFieldTable := pointer(Field.TypeInfo{$ifndef FPC}^{$endif});
        {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
        IntFieldTable := GetFPCAlignPtr(IntFieldTable);
        {$else}
        inc(PtrUInt(IntFieldTable),IntFieldTable^.NameLen);
        {$endif}
        dec(result,IntFieldTable^.Size);
      end;
      {$ifndef NOVARIANTS}
      tkVariant: begin
        Len := VariantSaveLength(PVariant(P)^);
        if Len=0 then begin
          result := 0;
          exit; // invalid/unhandled variant content
        end;
        inc(result,Len-sizeof(variant));
      end;
      {$endif}
      {$ifndef FPC} // FPC does include RTTI for unmanaged fields! :)
      else begin
        result := 0;
        exit; // invalid/unhandled record content
      end;
      {$endif}
    end;
    inc(Field);
  end;
end;

function RecordSave(const Rec; Dest: PAnsiChar; TypeInfo: pointer): PAnsiChar; overload;
var FieldTable: PFieldTable absolute TypeInfo;
    F, LenBytes: integer;
    Diff: cardinal;
    Field: ^TFieldInfo;
    R: PAnsiChar;
    Kind: TTypeKind;
    DynArray: TDynArray;
    IntFieldTable: PFieldTable;
begin
  R := @Rec;
{  if FieldTable^.Kind<>tkRecord then begin // should have been checked before
    result := nil;
    exit; // raise Exception.CreateUTF8('% is not a record',[Typ^.Name]);
  end; }
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  FieldTable := GetFPCAlignPtr(FieldTable);
  {$else}
  inc(PtrUInt(FieldTable),FieldTable^.NameLen);
  {$endif}
  Field := @FieldTable^.ManagedFields[0];
  Diff := 0;
  for F := 1 to FieldTable^.ManagedCount do begin
    Diff := Field^.Offset-Diff;
    if Diff<>0 then begin
      move(R^,Dest^,Diff);
      inc(R,Diff);
      inc(Dest,Diff);
    end;
    Kind := Field.TypeInfo^.Kind;
    case Kind of
    tkDynArray: begin
      DynArray.Init(Field.TypeInfo{$ifndef FPC}^{$endif},R^);
      Dest := DynArray.SaveTo(Dest);
      Diff := sizeof(PtrUInt); // size of tkDynArray in record
    end;
    tkLString, tkWString {$ifdef UNICODE}, tkUString{$endif}: begin
      if PPtrUInt(R)^=0 then
        LenBytes := 0 else
        LenBytes := PInteger(PPtrUInt(R)^-sizeof(integer))^; // inlined length() 
      {$ifdef UNICODE} // WideString has length in bytes, UnicodeString in WideChars
      if Kind=tkUString then
        LenBytes := LenBytes*2;
      {$endif}
      Dest := pointer(ToVarUInt32(LenBytes,pointer(Dest)));
      if LenBytes>0 then begin
        move(pointer(PPtrUInt(R)^)^,Dest^,LenBytes);
        inc(Dest,LenBytes);
      end;
      Diff := sizeof(PtrUInt); // size of tkLString+tkWString+tkUString in record
    end;
    tkRecord{$ifdef FPC},tkObject{$endif}: begin
      Dest := RecordSave(R^,Dest,Field.TypeInfo{$ifndef FPC}^{$endif});
      if Dest=nil then begin
        result := nil; // invalid/unhandled record content
        exit;
      end;
      IntFieldTable := pointer(Field.TypeInfo{$ifndef FPC}^{$endif});
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      IntFieldTable := GetFPCAlignPtr(IntFieldTable);
      {$else}
      inc(PtrUInt(IntFieldTable),IntFieldTable^.NameLen);
      {$endif}
      Diff := IntFieldTable^.Size; // size of the record in record
    end;
    {$ifndef NOVARIANTS}
    tkVariant: begin
      Dest := VariantSave(PVariant(R)^,Dest);
      if Dest=nil then begin
        result := nil; // invalid/unhandled variant content
        exit;
      end;
      Diff := sizeof(Variant); // size of tkVariant in record
    end;
    {$endif}
    {$ifdef FPC} // FPC does include RTTI for unmanaged fields! :)
      else
        if Field^.TypeInfo^.Kind in tkManagedTypes then
          raise ESynException.CreateUTF8('RecordSave(kind=%)',[ord(Field^.TypeInfo^.Kind)]) else begin
          if F=FieldTable^.ManagedCount then
            Diff := FieldTable.Size-Field^.Offset else
            Diff := FieldTable^.ManagedFields[F].Offset-Field^.Offset;
          move(R^,Dest^,Diff);
          inc(Dest,Diff);
        end;
    {$else}
    else begin
      result := nil;
      exit; // invalid/unhandled record content
    end;
    {$endif}
    end;
    inc(R,Diff);
    inc(Diff,Field.Offset);
    inc(Field);
  end;
  Diff := FieldTable^.Size-Diff;
  if integer(Diff)<0 then
    raise ESynException.Create('RecordSave diff') else
  if Diff<>0 then begin
    move(R^,Dest^,Diff);
    result := Dest+Diff;
  end else
    result := Dest;
end;

function RecordSave(const Rec; TypeInfo: pointer): RawByteString; overload;
var Len: integer;
begin
  Len := RecordSaveLength(Rec,TypeInfo);
  SetString(result,nil,Len);
  if Len<>0 then
    RecordSave(Rec,pointer(result),TypeInfo);
end;

function RecordSaveBase64(const Rec; TypeInfo: pointer; UriCompatible: boolean): RawByteString;
var len: integer;
    data: RawByteString;
    dat: PAnsiChar;
begin
  result := '';
  len := RecordSaveLength(Rec,TypeInfo);
  if len=0 then
    exit;
  SetLength(data,len+4);
  dat := PAnsiChar(pointer(data))+4;
  RecordSave(Rec,dat,TypeInfo);
  PCardinal(data)^ := crc32c(0,dat,len);
  result := BinToBase64(data);
  if UriCompatible then
    Base64ToURI(result);
end;

function RecordLoadBase64(Source: PAnsiChar; Len: integer; var Rec;
  TypeInfo: pointer; UriCompatible: boolean): boolean;
var data: RawByteString;
begin
  result := false;
  if Len<=6 then
    exit;
  if UriCompatible then begin
    SetString(data,Source,Len);
    Base64FromURI(data);
    data := Base64ToBin(data);
  end else
    data := Base64ToBin(Source,Len);
  Len := length(data);
  if Len<=4 then
    exit;
  Source := PAnsiChar(pointer(data))+4;
  if crc32c(0,Source,Len-4)=PCardinal(data)^ then
    result := RecordLoad(Rec,Source,TypeInfo)<>nil;
end;

procedure _Finalize(Data: Pointer; TypeInfo: Pointer);
{$ifdef FPC}
  [external name 'FPC_FINALIZE'];
{$else}
asm
{$ifdef CPU64}
        {$ifdef CPUX64}
        .NOFRAME
        {$endif}
        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}
{$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
        {$ifdef DELPHI5OROLDER}
        jmp System.@RunError
        {$else}
        jmp System.Error
        {$endif}
@@array:movzx ecx,[edx].TFieldTable.NameLen
        add ecx,edx
        mov edx,dword ptr [ecx].TFieldTable.ManagedFields[0] // Fields[0].TypeInfo^
        mov ecx,[ecx].TFieldTable.ManagedCount
        mov edx,[edx]
        jmp System.@FinalizeArray
{$endif CPU64}
end;
{$endif FPC}

function RecordLoad(var Rec; Source: PAnsiChar; TypeInfo: pointer): PAnsiChar;
var FieldTable: PFieldTable absolute TypeInfo;
    F, LenBytes: integer;
    Diff: cardinal;
    Field: ^TFieldInfo;
    R: PAnsiChar;
    Kind: TTypeKind;
    DynArray: TDynArray;
    IntFieldTable: PFieldTable;
begin
  R := @Rec;
  if (R=nil) or not(FieldTable^.Kind in tkRecordTypes) then begin
    result := nil; // should have been checked before
    exit; // raise Exception.CreateUTF8('% is not a record',[Typ^.Name]);
  end;
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  FieldTable := GetFPCAlignPtr(FieldTable);
  {$else}
  inc(PtrUInt(FieldTable),FieldTable^.NameLen);
  {$endif}
  Field := @FieldTable^.ManagedFields[0];
  if Source=nil then begin  // inline RecordClear() function
    for F := 1 to  FieldTable^.ManagedCount do begin
      _Finalize(R+Field^.Offset,Field^.TypeInfo{$ifndef FPC}^{$endif});
      inc(Field);
    end;
    result := nil;
    exit;
  end;
  Diff := 0;
  for F := 1 to FieldTable^.ManagedCount do begin
    Diff := Field^.Offset-Diff;
    if Diff<>0 then begin
      move(Source^,R^,Diff);
      inc(Source,Diff);
      inc(R,Diff);
    end;
    Kind := Field.TypeInfo^.Kind;
    case Kind of
    tkDynArray: begin
      DynArray.Init(Field.TypeInfo{$ifndef FPC}^{$endif},R^);
      Source := DynArray.LoadFrom(Source);
      Diff := sizeof(PtrUInt); // size of tkDynArray in record
    end;
    tkLString, tkWString {$ifdef UNICODE}, tkUString{$endif}: begin
      LenBytes := FromVarUInt32(PByte(Source));
      case Kind of
        tkLString: begin
          SetString(PRawByteString(R)^,Source,LenBytes);
          {$ifdef UNICODE}
          { Delphi 2009+: set Code page for this AnsiString }
          if LenBytes<>0 then
            PWord(PPtrUInt(R)^-12)^ := PWord(PtrUInt(Field.TypeInfo^)+
              Field.TypeInfo^^.NameLen+2)^;
          {$endif}
        end;
        tkWString:
          SetString(PWideString(R)^,PWideChar(Source),LenBytes shr 1);
        {$ifdef UNICODE}
        tkUString:
          SetString(PString(R)^,PWideChar(Source),LenBytes shr 1);
        {$endif}
      end;
      inc(Source,LenBytes);
      Diff := sizeof(PtrUInt); // size of tkLString+tkWString+tkUString in record
    end;
    tkRecord{$ifdef FPC},tkObject{$endif}: begin
      Source := RecordLoad(R^,Source,Field.TypeInfo{$ifndef FPC}^{$endif});
      IntFieldTable := pointer(Field.TypeInfo{$ifndef FPC}^{$endif});
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      IntFieldTable := GetFPCAlignPtr(IntFieldTable);
      {$else}
      inc(PtrUInt(IntFieldTable),IntFieldTable^.NameLen);
      {$endif}
      Diff := IntFieldTable^.Size; // size of the record in record
    end;
    {$ifndef NOVARIANTS}
    tkVariant: begin
      Source := VariantLoad(PVariant(R)^,Source);
      Diff := sizeof(Variant); // size of tkVariant in record
    end;
    {$endif}
    {$ifdef FPC} // FPC does include RTTI for unmanaged fields! :)
      else
        if Field^.TypeInfo^.Kind in tkManagedTypes then
          raise ESynException.CreateUTF8('RecordLoad(kind=%)',[ord(Field^.TypeInfo^.Kind)]) else begin
          if F=FieldTable^.ManagedCount then
            Diff := FieldTable.Size-Field^.Offset else
            Diff := FieldTable^.ManagedFields[F].Offset-Field^.Offset;
          move(Source^,R^,Diff);
          inc(Source,Diff);
        end;
    {$else}
    else begin
      result := nil;
      exit; // invalid/unhandled record content
    end;
    {$endif}
    end;
    inc(R,Diff);
    inc(Diff,Field.Offset);
    inc(Field);
  end;
  Diff := FieldTable^.Size-Diff;
  if integer(Diff)<0 then
    raise ESynException.Create('RecordLoad diff') else
  if Diff<>0 then begin
    move(Source^,R^,Diff);
    result := Source+Diff;
  end else
    result := 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 CPUX64}
  .NOFRAME
{$endif}
  jmp System.@CopyRecord
end;

procedure RecordClear(var Dest; TypeInfo: pointer);
asm
{$ifdef CPUX64}
  .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;

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].TFieldTable.NameLen
  mov edx,[edx+ecx].TFieldTable.Size
  xor ecx,ecx
  jmp FillChar *)
        movzx ecx,byte ptr [edx].TFieldTable.NameLen
        push ebx
        mov ebx,eax
        push esi
        push edi
        mov edi,[edx+ecx].TFieldTable.ManagedCount
        lea esi,[edx+ecx].TFieldTable.ManagedFields
        test edi,edi
        jz @@end
@@loop: mov edx,[esi].TFieldInfo.TypeInfo
        mov eax,[esi].TFieldInfo.&Offset
        mov edx,[edx]
        lea esi,esi+8
        movzx ecx,[edx].TFieldTable.Kind
        lea eax,eax+ebx // eax=data to be initialized
        jmp dword ptr [@@Tab+ecx*4-tkLString*4]
@@Tab:  dd @@ptr, @@ptr, @@variant, @@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
@@variant:
        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 ! -> no simple patch
procedure TObjectCleanupInstance;
asm // faster version by AB
        push ebx
        mov ebx,eax
@@loop: mov ebx,[ebx] // handle two VMT levels per iteration
        mov edx,[ebx].vmtInitTable
        mov ebx,[ebx].vmtParent
        test edx,edx
        jne @@fin
        test ebx,ebx
        jz @@end
        mov ebx,[ebx]
        mov edx,[ebx].vmtInitTable
        mov ebx,[ebx].vmtParent
        test edx,edx
        jne @@fin
        test ebx,ebx
        jne @@loop
@@end:  pop ebx
        ret
@@fin:  call RecordClear // eax=data edx=typeinfo
        test ebx,ebx
        jne @@loop
        pop ebx
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].TFieldTable.NameLen
        push ebx
        mov ebx,eax
        push esi
        push edi
        mov edi,[edx+ecx].TFieldTable.ManagedCount
        lea esi,[edx+ecx].TFieldTable.ManagedFields
        test edi,edi
        jz @@end
@@loop: mov edx,[esi].TFieldInfo.TypeInfo
        mov eax,[esi].TFieldInfo.&Offset
        mov edx,[edx]
        lea esi,[esi+8]
        movzx ecx,[edx].TFieldTable.Kind
        lea eax,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].TFieldTable.NameLen
        add ecx,edx
        mov edx,dword ptr [ecx].TFieldTable.ManagedFields[0] // Fields[0].TypeInfo^
        mov ecx,[ecx].TFieldTable.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].TFieldTable.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].TFieldTable.ManagedCount // ebp = TFieldInfo count
        mov ecx,[ebx].TFieldTable.Size
        test ebp,ebp
        jz @fullcopy
        push ecx                        // sizeof(record) on stack
        add ebx,offset TFieldTable.ManagedFields[0] // ebx = first TFieldInfo
@next:  mov ecx,[ebx].TFieldInfo.&Offset
        mov edx,[ebx].TFieldInfo.TypeInfo
        sub ecx,eax
        mov edx,[edx]
        jle @nomov
        lea esi,[esi+ecx]
        lea edi,[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].TFieldTable.Kind
        cmp ecx,tkLString
        je @@LString
        jb @@err
{$ifdef UNICODE}
        cmp ecx,tkUString
        je @@UString
{$else} cmp ecx,tkDynArray
        je @@DynArray
{$endif}ja @@err
        jmp dword ptr [ecx*4+@@tab-tkWString*4]
@@Tab:  dd @@WString,@@Variant,@@Array,@@Record,@@Interface,@@err
        {$ifdef UNICODE}dd @@DynArray{$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].TFieldTable.NameLen
        push dword ptr [edx+ecx].TFieldTable.Size
        push dword ptr [edx+ecx].TFieldTable.ManagedCount
        mov ecx,dword ptr [edx+ecx].TFieldTable.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].TFieldTable.NameLen
        mov ecx,[edx+ecx].TFieldTable.Size
        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} cmp dword ptr [VarCopyProc],0
        mov edx,esi
        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
@@DynArray:
        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
        dec ebp    // any other TFieldInfo?
        lea ebx,[ebx+8] // next TFieldInfo
        jnz @next
        pop ecx // ecx= sizeof(record)
@fullcopy:
        mov edx,edi
        sub ecx,eax
        mov eax,esi
        jle @nomov2
        call move
@nomov2:pop edi
        pop esi
        pop ebx
        pop ebp
end;

{$endif DOPATCHTRTL}
{$endif FPC}

{$ifndef FPC}
{$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 MoveSSE2;
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,[rcx+rdx]
     dec r8
     mov [rdx],al
     add rdx,1
@04: test dl,02H
     jz @05
     mov ax,[rcx+rdx]
     sub r8,2
     mov [rdx],ax
     add rdx,2
@05: test dl,04H
     jz @06
     mov eax,[rcx+rdx]
     sub r8,4
     mov [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: dec r9
     mov rax,[rcx+rdx]
     mov [rdx],rax
     lea rdx,rdx+8
     jnz @08
     and r8,07H
@09: test r8,r8
     jle @11
     db 66H,66H,66H,90H
@10: dec r8
     mov al,[rcx+rdx]
     mov [rdx],al
     lea rdx,rdx+1
     jnz @10
@11: ret
@12: cmp r9,8192
     jc @13
     cmp rcx,4096
     jnc @14
@13: dec r9
     lea rdx,rdx+32
     mov rax,[rcx+rdx-20H]
     mov r10,[rcx+rdx-18H]
     mov [rdx-20H],rax
     mov [rdx-18H],r10
     mov rax,[rcx+rdx-10H]
     mov r10,[rcx+rdx-8H]
     mov [rdx-10H],rax
     mov [rdx-8H],r10
     jnz @13
     and r8,1FH
     jmp @07
@14: mov eax,32
     db 66H,66H,66H,90H,66H,66H,66H,90H
@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,[rcx+rdx-40H]
     mov r10,[rcx+rdx-38H]
     db $4C,$0F,$C3,$4A,$C0 // movnti [rdx-40H],r9
     db $4C,$0F,$C3,$52,$C8 // movnti [rdx-38H],r10
     mov r9,[rcx+rdx-30H]
     mov r10,[rcx+rdx-28H]
     db $4C,$0F,$C3,$4A,$D0 // movnti [rdx-30H],r9
     db $4C,$0F,$C3,$52,$D8 // movnti [rdx-28H],r10
     dec eax
     mov r9,[rcx+rdx-20H]
     mov r10,[rcx+rdx-18H]
     db $4C,$0F,$C3,$4A,$E0 // movnti [rdx-20H],r9
     db $4C,$0F,$C3,$52,$E8 // movnti [rdx-18H],r10
     mov r9,[rcx+rdx-10H]
     mov r10,[rcx+rdx-8H]
     db $4C,$0F,$C3,$4A,$F0 // movnti [rdx-10H],r9
     db $4C,$0F,$C3,$52,$F8 // movnti [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,[rcx+rdx]
     dec r8
     mov [rdx],al
@18: test dl,02H
     jz @19
     sub rdx,2
     mov ax,[rcx+rdx]
     sub r8,2
     mov [rdx],ax
@19: test dl,04H
     jz @20
     sub rdx,4
     mov eax,[rcx+rdx]
     sub r8,4
     mov [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,[rcx+rdx]
     dec r9
     mov [rdx],rax
     jnz @22
     and r8,07H
@23: test r8,r8
     jle @25
     db 66H,66H,66H,90H,66H,66H,66H,90H
     db 66H,66H,66H,90H,90H
@24: dec rdx
     mov al,[rcx+rdx]
     dec r8
     mov  [rdx],al
     jnz @24
@25: ret
@26: cmp r9,8192
     jc @27
     cmp rcx,-4096
     jc @28
@27: sub rdx,32
     mov rax,[rcx+rdx+18H]
     mov r10,[rcx+rdx+10H]
     mov [rdx+18H],rax
     mov [rdx+10H],r10
     dec r9
     mov rax,[rcx+rdx+8H]
     mov r10,[rcx+rdx]
     mov [rdx+8H],rax
     mov [rdx],r10
     jnz @27
     and r8,1FH
     jmp @21
@28: mov eax,32
     db 66H,66H,66H,90H,66H,66H,90H
@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,[rcx+rdx+38H]
     mov r10,[rcx+rdx+30H]
     db $4C,$0F,$C3,$4A,$38 // movnti [rdx+38H],r9
     db $4C,$0F,$C3,$52,$30 // movnti [rdx+30H],r10
     mov r9,[rcx+rdx+28H]
     mov r10,[rcx+rdx+20H]
     db $4C,$0F,$C3,$4A,$28 // movnti [rdx+28H],r9
     db $4C,$0F,$C3,$52,$20 // movnti [rdx+20H],r10
     dec eax
     mov r9,[rcx+rdx+18H]
     mov r10,[rcx+rdx+10H]
     db $4C,$0F,$C3,$4A,$18 // movnti [rdx+18H],r9
     db $4C,$0F,$C3,$52,$10 // movnti [rdx+10H],r10
     mov r9,[rcx+rdx+8H]
     mov r10,[rcx+rdx]
     db $4C,$0F,$C3,$4A,$08 // movnti [rdx+8H],r9
     db $4C,$0F,$C3,$12     // movnti [rdx],r10
     jnz @30
     cmp r8,4096
     jnc @28
     mfence
     jmp @20
end;

procedure FillCharSSE2;
asm  // rcx=Dest rdx=Count r8=Value
        .noframe
        cmp rdx,32
        mov rax,r8
        jle @small
        and r8,0FFH
        mov r9,101010101010101H
        imul r8,r9
        test cl,07H
        jz @27C5
        test cl,01H
        jz @27A4
        mov [rcx],r8b
        add rcx,1
        sub rdx,1
@27A4:  test cl,02H
        jz @27B5
        mov [rcx],r8w
        add rcx,2
        sub rdx,2
@27B5:  test cl,04H
        jz @27C5
        mov [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
        db 66H,66H,90H
@27E0:  mov [rcx],r8
        add rcx,8
        dec rax
        jnz @27E0
@27EC:  test rdx,rdx
        jle @27FC
@27F1:  mov [rcx],r8b
        inc rcx
        dec rdx
        jnz @27F1
@27FC:  ret
@27FD:  cmp rax,8192
        jnc @2840
        db 66H,66H,66H,90H,90H,90H
@2810:  add rcx,64
        mov [rcx-40H],r8
        mov [rcx-38H],r8
        mov [rcx-30H],r8
        mov [rcx-28H],r8
        dec rax
        mov [rcx-20H],r8
        mov [rcx-18H],r8
        mov [rcx-10H],r8
        mov [rcx-8H],r8
        jnz @2810
        jmp @27D2
        db 66H,66H,66H,90H,90H
@2840:  add rcx,64
        db $4C,$0F,$C3,$41,$C0 // movnti  [rcx-40H],r8
        db $4C,$0F,$C3,$41,$C8 // movnti  [rcx-38H],r8
        db $4C,$0F,$C3,$41,$D0 // movnti  [rcx-30H],r8
        db $4C,$0F,$C3,$41,$D8 // movnti  [rcx-28H],r8
        dec rax
        db $4C,$0F,$C3,$41,$E0 // movnti  [rcx-20H],r8
        db $4C,$0F,$C3,$41,$E8 // movnti  [rcx-18H],r8
        db $4C,$0F,$C3,$41,$F0 // movnti  [rcx-10H],r8
        db $4C,$0F,$C3,$41,$F8 // movnti  [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;

function StrLenSSE2(S: pointer): PtrInt;
asm // from GPL strlen64.asm by Agner Fog - www.agner.org/optimize
        .NOFRAME
        mov      rax,rcx             // get pointer to string from rcx
        or       rax,rax
        mov      r8,rcx              // copy pointer
        jz       @null               // returns 0 if S=nil
        // rax = s,ecx = 32 bits of s
        pxor     xmm0,xmm0           // set to zero
        and      ecx,0FH             // lower 4 bits indicate misalignment
        and      rax,-10H            // align pointer by 16
        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
@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
        sub      rax,r8              // subtract start address
        add      rax,rdx             // add byte index
@null:
end;

{$else CPU64}

procedure FillCharX87;
asm // eax=Dest edx=Count cl=Value
        // faster version by John O'Harrow  (Code Size = 153 Bytes)
        cmp   edx,32
        mov   ch,cl                 // copy value into both bytes of cx
        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
@exit:  ret
        lea eax,[eax+0]  // for 4-byte alignment of @table
@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     @done                 // 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
@done:  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;

function StrLenX86(S: pointer): PtrInt;
// pure x86 function (if SSE2 not available) - faster than SysUtils' version
asm
     test eax,eax
     jz @@z
     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 }
@@SetResult:
     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 }
@@z: 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

function SupportsSSE2: boolean;
begin
  result := false;
  asm
    pushfd
    pop eax
    mov edx,eax
    xor eax,$200000
    push eax
    popfd
    pushfd
    pop eax
    xor eax,edx
    jz @nocpuidopcode
    push ebx
    mov eax,1
    cpuid
    test edx,$04000000
    jz @nosse2
    mov result,true
@nosse2:
    pop ebx
@nocpuidopcode:
  end;
end;

procedure FillCharSSE2;
asm // Dest=eax Count=edx Value=cl
  cmp       edx, 32
  mov       ch,cl                {copy value into both bytes of cx}
  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;

function StrLenSSE2(S: pointer): PtrInt;
asm // from GPL strlen32.asm by Agner Fog - www.agner.org/optimize
        or       eax,eax
        mov      ecx,eax             // copy pointer
        jz       @null               // returns 0 if S=nil
        push     eax                 // save start address
        pxor     xmm0,xmm0           // set to zero
        and      ecx,0FH             // lower 4 bits indicate misalignment
        and      eax,-10H            // align pointer by 16
        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 CPU64}

procedure InitRedirectCode;
{$ifdef DOPATCHTRTL}
var FillCharAddr, MoveAddr: pointer;
{$endif}
begin
  {$ifdef DELPHI5OROLDER}
  StrLen := @StrLenX86;
  {$else}
  {$ifdef CPU64}
  StrLen := @StrLenSSE2;
  {$else}
  if SupportsSSE2 then
    StrLen := @StrLenSSE2 else
    StrLen := @StrLenX86;
  {$endif CPU64}
  {$endif DELPHI5OROLDER}
  // do redirection from RTL to our fastest version
  {$ifdef DOPATCHTRTL}
  if DebugHook=0 then begin // patch only outside debugging
    {$ifdef DELPHI5OROLDER}
    FillCharAddr := @FillCharX87;
    MoveAddr := @MoveX87;
    {$else}
    {$ifdef CPU64}
    {$ifdef NOX64PATCHRTL}
    FillCharAddr := nil;
    MoveAddr := nil;
    {$else}
    FillCharAddr := @FillCharSSE2;
    MoveAddr := @MoveSSE2;
    {$endif NOX64PATCHRTL}
    {$else}
    MoveAddr := @MoveX87; // SSE2 is not faster than X87 version on 32 bit CPU
    if SupportsSSE2 then
      FillCharAddr := @FillCharSSE2 else
      FillCharAddr := @FillCharX87;
    {$endif CPU64}
    {$endif DELPHI5OROLDER}
    RedirectCode(SystemFillCharAddress,FillCharAddr);
    RedirectCode(@System.Move,MoveAddr);
    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}
  end;
  {$endif DOPATCHTRTL}
end;

{$endif CPUARM}
{$endif FPC}


{ ************  Custom record / dynamic array JSON serialization }

type
  /// information about one customized JSON serialization
  TJSONCustomParserRegistration = record
    RecordTypeName: 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;
    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 DynArraySearch(aDynArrayTypeInfo, aRecordTypeInfo: pointer;
      out Reader: TDynArrayJSONCustomReader): boolean; overload;
    function DynArraySearch(aDynArrayTypeInfo, aRecordTypeInfo: pointer;
      out Writer: TDynArrayJSONCustomWriter; PParser: PTJSONCustomParserAbstract): boolean; 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;
  public
    constructor Create;
    procedure RegisterCallbacks(aTypeInfo: pointer;
      aReader: TDynArrayJSONCustomReader; aWriter: TDynArrayJSONCustomWriter);
    function RegisterFromText(aTypeInfo: pointer;
      const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
    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;
    FieldTable: PFieldTable;
    added: boolean;
    ndx: integer;
begin
  result := -1;
  FieldTable := RecordTypeInfoFieldTable(aRecordTypeInfo);
  if FieldTable=nil then
    exit; // not enough RTTI
  Reg.RecordTypeInfo := aRecordTypeInfo;
  Reg.DynArrayTypeInfo := aDynArrayTypeInfo;
  TypeInfoToName(Reg.RecordTypeInfo,Reg.RecordTypeName);
  if Reg.RecordTypeName='' then
    exit; // we need a type name!
  RegRoot := TJSONCustomParserRTTI.CreateFromTypeName('',Reg.RecordTypeName);
  {$ifdef ISDELPHI2010}
  if RegRoot=nil then begin
    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 -> 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;
begin
  if self<>nil then
  if (aDynArrayTypeInfo<>nil) and (fParsersCount<>0) then
    if fParser[fLastDynArrayIndex].DynArrayTypeInfo=aDynArrayTypeInfo then begin
      result := fLastDynArrayIndex;
      exit;
    end else begin
      if aRecordTypeInfo=nil then // record RTTI not specified: guess now
        aRecordTypeInfo := TypeInfoToRecordInfo(aDynArrayTypeInfo);
      if aRecordTypeInfo=nil then begin
        for result := 0 to fParsersCount-1 do
          if fParser[result].DynArrayTypeInfo=aDynArrayTypeInfo then begin
            fLastDynArrayIndex := result;
            exit;
          end;
      end else
      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].DynArrayTypeInfo=aDynArrayTypeInfo) or
           (fParser[result].RecordTypeInfo=aRecordTypeInfo) then begin
          fLastDynArrayIndex := result;
          fLastRecordIndex := result;
          exit;
        end;
    end;
  if AddIfNotExisting then begin
    result := TryToGetFromRTTI(aDynArrayTypeInfo,aRecordTypeInfo);
    if result>=0 then
      GlobalJSONCustomParsers.fLastRecordIndex := result;
  end else
    result := -1;
end;

function TJSONCustomParsers.DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo: pointer;
  out Reader: TDynArrayJSONCustomReader): boolean;
var ndx: integer;
begin
  ndx := DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo);
  if (ndx>=0) and Assigned(GlobalJSONCustomParsers.fParser[ndx].Reader) then begin
    Reader := GlobalJSONCustomParsers.fParser[ndx].Reader;
    result := true;
  end else
    result := false;
end;

function TJSONCustomParsers.DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo: pointer;
  out Writer: TDynArrayJSONCustomWriter; PParser: PTJSONCustomParserAbstract): boolean;
var ndx: integer;
begin
  ndx := DynArraySearch(aDynArrayTypeInfo,aRecordTypeInfo);
  if (ndx>=0) and Assigned(GlobalJSONCustomParsers.fParser[ndx].Writer) then begin
    Writer := GlobalJSONCustomParsers.fParser[ndx].Writer;
    if PParser<>nil then
      PParser^ := GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser;
    result := true;
  end else
    result := false;
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
      GlobalJSONCustomParsers.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(GlobalJSONCustomParsers.fParser[ndx].Reader) then begin
    Reader := GlobalJSONCustomParsers.fParser[ndx].Reader;
    result := true;
  end else
    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(GlobalJSONCustomParsers.fParser[ndx].Writer) then begin
    Writer := GlobalJSONCustomParsers.fParser[ndx].Writer;
    if PParser<>nil then
      PParser^ := GlobalJSONCustomParsers.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]);
  fillchar(Reg,sizeof(Reg),0);
  case PDynArrayTypeInfo(aTypeInfo)^.kind of
  tkDynArray: begin
    Reg.DynArrayTypeInfo := aTypeInfo;
    Reg.RecordTypeInfo := TypeInfoToRecordInfo(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(kind=%) not DynArray or Record',
    [self,ord(PDynArrayTypeInfo(aTypeInfo)^.kind)]);
  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;

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(aTypeInfo,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 RecordSaveJSON(const Rec; TypeInfo: pointer): RawUTF8;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream do
  try
    AddRecordJSON(Rec,TypeInfo);
    SetText(result);
  finally
    Free;
  end;
end;

const
  NULCHAR: AnsiChar = #0;

function RecordLoadJSON(var Rec; JSON: PUTF8Char; TypeInfo: pointer;
  EndOfObject: PUTF8Char=nil): PUTF8Char;
var wasString, wasValid: boolean;
    Reader: TDynArrayJSONCustomReader;
    EndOfObj: AnsiChar;
    Val: PUTF8Char;
begin // code below must match TTextWriter.AddRecordJSON
  result := nil;
  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 (PDynArrayTypeInfo(TypeInfo)^.kind in tkRecordTypes) then
      raise ESynException.CreateUTF8('RecordLoadJSON(%) kind=%',
        [TypeInfo,ord(PDynArrayTypeInfo(TypeInfo)^.kind)]);
    Val := GetJSONField(JSON,JSON,@wasString,@EndOfObj);
    if (Val=nil) or (not wasString) or
       (PInteger(Val)^ and $00ffffff<>JSON_BASE64_MAGIC) or
       (RecordLoad(Rec,pointer(Base64ToBin(Val+3)),TypeInfo)=nil) then
      exit; // invalid content
  end else begin
    if not GlobalJSONCustomParsers.RecordSearch(TypeInfo,Reader) then
      exit;
    JSON := Reader(JSON,Rec,wasValid);
    if not wasValid then
      exit;
    if (JSON<>nil) and (JSON^<>#0) then begin
      EndOfObj := JSON^;
      inc(JSON);
    end else
      EndOfObj := #0;
  end;
  if JSON=nil then
    result := @NULCHAR else
    result := JSON;
  if EndOfObject<>nil then
    EndOfObject^ := EndOfObj;
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);
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);
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    fTypeData := GetFPCTypeData(fCustomTypeInfo);
    {$else}
    with PDynArrayTypeInfo(fCustomTypeInfo)^ do
      fTypeData := pointer(PtrUInt(@elSize)+NameLen);
    {$endif}
    case PTypeKind(fCustomTypeInfo)^ of
    tkEnumeration{$ifndef FPC}, tkSet{$endif}: begin
      case TOrdType(PByte(fTypeData)^) of
        otSByte,otUByte: fDataSize := 1;
        otSWord,otUWord: fDataSize := 2;
        otSLong,otULong: fDataSize := 4;
      end;
      {$ifdef FPC}
      fKnownType := ktEnumeration;
      {$else}
      if PTypeKind(fCustomTypeInfo)^=tkEnumeration then
        fKnownType := ktEnumeration else begin
        fKnownType := ktSet;
        inc(PByte(fTypeData)); // jump over TOrdType (see TTypeInfo.SetEnumType)
        fTypeData := PPointer(PPointer(fTypeData)^)^;
      end;
      {$endif}
    end;
    tkArray: begin
      if PArrayTypeInfo(fTypeData)^.dimCount<>1 then
        raise ESynException.CreateUTF8(
          '%.Create("%") supports only one dimension static array)',
          [self,aCustomTypeName]);
      fKnownType := ktStaticArray;
      fDataSize := PArrayTypeInfo(fTypeData)^.Size;
      fFixedSize := fDataSize div PArrayTypeInfo(fTypeData)^.elCount;
      fNestedArray := TJSONCustomParserRTTI.CreateFromRTTI(
        '',PArrayTypeInfo(fTypeData)^.elType^,fFixedSize);
    end;
    tkDynArray:
      fKnownType := ktDynamicArray;
    else
      raise ESynException.CreateUTF8('%.Create("%") unsupported type: %',
        [self,aCustomTypeName,PByte(fCustomTypeInfo)^]);
    end;
  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;

destructor TJSONCustomParserCustomSimple.Destroy;
begin
  inherited;
  fNestedArray.Free;
end;

procedure TJSONCustomParserCustomSimple.CustomWriter(
  const aWriter: TTextWriter; const aValue);
var i,max: integer;
    V: PByte;
    item: PShortString;
begin
  case fKnownType of
  ktStaticArray: begin
    aWriter.Add('[');
    V := @aValue;
    for i := 1 to PArrayTypeInfo(fTypeData)^.elCount do
      fNestedArray.WriteOneLevel(aWriter,V,[]);
    aWriter.CancelLastComma;
    aWriter.Add(']');
  end;
  {$ifndef FPC}
  ktSet: begin // written as an object with set names as fields = true/false
    aWriter.Add('{');
    item := GetEnumBaseTypeList(fTypeData,max);
    for i := 0 to max do begin
      aWriter.AddPropName(item^);
      aWriter.AddString(JSON_BOOLEAN[GetBit(aValue,i)]);
      aWriter.Add(',');
      inc(PByte(item),ord(item^[0])+1); // next short string
    end;
    aWriter.CancelLastComma;
    aWriter.Add('}');
  end;
  {$endif}
  ktDynamicArray:
    raise ESynException.CreateUTF8('%.CustomWriter("%"): Unsupported',
        [self,fCustomTypeName]);
  else begin // encoded as JSON strings
    aWriter.Add('"');
    case fKnownType of
    ktGUID:
      aWriter.Add(TGUID(aValue));
    ktEnumeration:
      aWriter.AddShort(GetEnumName(fCustomTypeInfo,byte(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;
    V,i: integer;
    wasString: boolean;
    Val: PByte;
begin
  result := nil;
  case fKnownType of
  ktStaticArray: begin
    if P^<>'[' then
      exit; // we expect a true array here
    P := GotoNextNotSpace(P+1);
    if JSONArrayCount(P)<>PArrayTypeInfo(fTypeData)^.elCount then
      exit; // invalid number of items
    Val := @aValue;
    for i := 1 to PArrayTypeInfo(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;
  {$ifndef FPC}
  ktSet: // not implemented yet
    raise ESynException.CreateUTF8('%.CustomReader("%") set',[self,fCustomTypeName]);
  {$endif}
  ktDynamicArray:
    raise ESynException.CreateUTF8('%.CustomReader("%"): Unsupported',
        [self,fCustomTypeName]);
  else begin // encoded as JSON strings
    PropValue := GetJSONField(P,P,@wasString,@EndOfObject);
    if PropValue=nil then
      exit;
    case fKnownType of
    ktGUID:
      if wasString and (TextToGUID(PropValue,@aValue)<>nil) then
        result := P;
    ktEnumeration: begin
      if wasString then
        V := GetEnumNameValue(fCustomTypeInfo,PropValue,StrLen(PropValue)) else
        V := GetInteger(PropValue);
      if V<0 then
        exit;
      case fDataSize of
      1: byte(aValue) := V;
      2: word(aValue) := V;
      4: integer(aValue) := V;
      else exit;
      end;
      result := P;
    end;
    ktFixedArray:
      if wasString and (StrLen(PropValue)=fFixedSize*2) and
         HexToBin(PAnsiChar(PropValue),@aValue,fFixedSize) then
        result := P;
    end;
  end;
  end;
end;


{ TJSONCustomParserCustomRecord }

{constructor TJSONCustomParserCustomRecord.Create(
  const aPropertyName, aCustomTypeName: RawUTF8);
begin
  inherited Create(aPropertyName,aCustomTypeName);
  fCustomTypeIndex := GlobalJSONCustomParsers.RecordSearch(aCustomTypeName);
  if fCustomTypeIndex<0 then
    raise ESynException.CreateUTF8('%.Create(unknown "%" type)',
      [self,aCustomTypeName]);
  with GlobalJSONCustomParsers.fParser[fCustomTypeIndex] do begin
    fCustomTypeInfo := RecordTypeInfo;
    fCustomTypeName := RecordTypeName;
  end;
  fDataSize := RecordTypeInfoSize(fCustomTypeInfo);
  if fDataSize=0 then
    raise ESynException.CreateUTF8('%.Create("%" non record type)',
      [self,aCustomTypeName]);
end;}

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 }

var
  GlobalCustomJSONSerializerFromTextSimpleType_: TRawUTF8ListHashed;

function GlobalCustomJSONSerializerFromTextSimpleType: TRawUTF8ListHashed;
begin
  if GlobalCustomJSONSerializerFromTextSimpleType_=nil then begin
    GarbageCollectorFreeAndNil(GlobalCustomJSONSerializerFromTextSimpleType_,
      TRawUTF8ListHashed.Create(false));
    GlobalCustomJSONSerializerFromTextSimpleType_.CaseSensitive := false;
    GlobalCustomJSONSerializerFromTextSimpleType_.AddObject(
      'TGUID',{$ifdef ISDELPHI2010}TypeInfo(TGUID){$else}nil{$endif});
  end;
  result := GlobalCustomJSONSerializerFromTextSimpleType_;
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 // we rely on TJSONCustomParserRTTIType enumeration to be sorted by name
  JSONCUSTOMPARSERRTTITYPE_NAMES: array[TJSONCustomParserRTTIType] of PUTF8Char =
    ('ARRAY','BOOLEAN','BYTE','CARDINAL','CURRENCY','DOUBLE','INT64','INTEGER',
     'RAWBYTESTRING','RAWJSON','RAWUTF8','RECORD','SINGLE','STRING','SYNUNICODE',
     'TDATETIME','TGUID','TID','TTIMELOG',{$ifndef NOVARIANTS}'VARIANT',{$endif}
     'WIDESTRING','WORD',nil); // latest ptCustom=nil
var ndx: integer;
begin
  UpperCaseCopy(TypeName,TypeNameLen,ItemTypeName);
  ndx := FastFindPUTF8CharSorted(@JSONCUSTOMPARSERRTTITYPE_NAMES,
    ord(pred(ptCustom)),pointer(ItemTypeName));
  if ndx>=0 then
    result := TJSONCustomParserRTTIType(ndx) else
    // recognize some simple type aliases (.. = type ..) as defined in mORMot.pas
    case IdemPCharArray(pointer(ItemTypeName),['TSQLRAWBLOB','TRECORDREFERENCE',
      'TRECORDREFERENCETOBEDELETED','TMODTIME','TCREATETIME','PTRINT','PTRUINT']) of
      // see also PT_COMPLEXTYPES
      0:   result := ptRawByteString;
      1,2: result := ptPtrUInt;
      3,4: result := ptTimeLog;
      5:   result := ptPtrInt;
      6:   result := ptPtrUInt;
      else result := ptCustom;
      // warning: recognized types should match at binary storage level!
    end;
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;
var Item: PDynArrayTypeInfo absolute Info;
    Typ: PByte;
begin
  result := ptCustom;
  if Info=nil then
    exit;
  case Item^.Kind of
  tkLString: 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 := ptInt64;
    else result := ptPtrInt;
    end;
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant: result := ptVariant;
  {$endif}
  tkDynArray: result := ptArray;
  tkChar, tkClass, tkMethod, tkWChar, tkInterface,
  tkInteger, tkSet: begin
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    Typ := GetFPCAlignPtr(pointer(Item));
    {$else}
    Typ := pointer(PtrUInt(@Item.elSize)+Item.NameLen);
    {$endif}
    case TOrdType(Typ^) of
    otSByte,otUByte: result := ptByte;
    otSWord,otUWord: result := ptWord;
    otSLong: result := ptInteger;
    otULong: result := ptCardinal;
    end;
  end;
  tkInt64: result := ptInt64;
  {$ifdef FPC}
  tkBool: result := ptBoolean;
  {$else}
  tkEnumeration:
    if Item=TypeInfo(boolean) then
      result := ptBoolean;
      // other enumerates will use TJSONCustomParserCustomSimple below
  {$endif}
  tkFloat: begin
    {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    Typ := GetFPCAlignPtr(Item);
    {$else}
    Typ := pointer(PtrUInt(@Item.elSize)+Item.NameLen);
    {$endif}
    case TFloatType(Typ^) of
    ftSingle: result := ptSingle;
    ftDoub:   result := ptDouble;
    ftCurr:   result := ptCurrency;
    // ftExtended, ftComp: not implemented yet
    end;
  end;
  end;
end;

class function TJSONCustomParserRTTI.CreateFromRTTI(
  const PropertyName: RawUTF8; Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
var Item: PDynArrayTypeInfo 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] 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("%")',
            [self,ItemTypeName]);
        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;
begin
  ndx := GlobalCustomJSONSerializerFromTextSimpleType.IndexOf(aCustomRecordTypeName);
  if ndx>=0 then
    result := TJSONCustomParserCustomSimple.Create(
      aPropertyName,aCustomRecordTypeName,
      GlobalCustomJSONSerializerFromTextSimpleType_.Objects[ndx]) 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: integer;
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: integer;
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(Int64),SizeOf(Integer),SizeOf(RawByteString),
    SizeOf(RawJSON),SizeOf(RawUTF8),0,SizeOf(Single), SizeOf(String),SizeOf(SynUnicode),
    SizeOf(TDateTime),SizeOf(TGUID),SizeOf(Int64), SizeOf(TTimeLog),
    {$ifndef NOVARIANTS}SizeOf(Variant),{$endif}
    SizeOf(WideString),SizeOf(Word),0);
var i: integer;
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: integer;
begin
  for j := 0 to high(NestedProperty) do begin
    case NestedProperty[j].PropertyType of
    ptRawByteString,
    ptRawJSON,
    ptRawUTF8:    PRawByteString(Data)^ := '';
    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: ^TDynArrayRec;
    ItemData: PByte;
begin
  if Data=0 then
    exit;
  ItemData := pointer(Data);
  Rec := pointer(Data);
  dec(PtrUInt(Rec),sizeof(TDynArrayRec));
  for i := 0 to Rec.length-1 do
    FinalizeNestedRecord(ItemData);
  FreeMem(Rec);
  Data := 0;
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
    fillchar(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: integer;
      wasString: boolean;
      PropValue: 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 then begin // null -> void array
      P := GotoNextNotSpace(P+4);
      EndOfObject := P^;
      if P^<>#0 then //if P^=',' then
        inc(P);
      Prop.FinalizeNestedArray(PPtrUInt(Data)^);
    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
            inc(ArrayCapacity,512+ArrayCapacity shr 3);
            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
            if not ProcessValue(Prop.NestedProperty[0],P,DynArray) or (P=nil) then
              goto Error;
          end else // array of record
            if not Prop.ReadOneLevel(P,DynArray,Options) or (P=nil) then
              goto Error else begin
              P := GotoNextNotSpace(P);
              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:
      P := TJSONCustomParserCustom(Prop).CustomReader(P,Data^,EndOfObject);
    {$ifndef NOVARIANTS}
    ptVariant:
      P := VariantLoadJSON(PVariant(Data)^,P,@EndOfObject,
        @JSON_OPTIONS[soCustomVariantCopiedByReference in Options]);
    {$endif}
    ptRawByteString: begin
      PropValue := GetJSONField(P,P,@wasString,@EndOfObject);
      if PropValue=nil then // null -> Blob=''
        PRawByteString(Data)^ := '' else
        if not Base64MagicCheckAndDecode(PropValue,PRawByteString(Data)^) then
          exit;
    end;
    ptRawJSON:
      PRawJSON(Data)^ := GetJSONItemAsRawJSON(P,@EndOfObject);
    else begin
      PropValue := GetJSONField(P,P,@wasString,@EndOfObject);
      if (PropValue<>nil) and // PropValue=nil for null
         (wasString<>(Prop.PropertyType in [ptRawUTF8,ptString,
           ptSynUnicode,ptDateTime,ptTimeLog,ptGUID,ptWideString])) then
         exit;
      case Prop.PropertyType of
      ptBoolean:   if (PropValue<>nil) and (PInteger(PropValue)^=TRUE_LOW) then
                     PBoolean(Data)^ := true else
                     PBoolean(Data)^ := GetInteger(PropValue)<>0;
      ptByte:      PByte(Data)^ := GetCardinal(PropValue);
      ptCardinal:  PCardinal(Data)^ := GetCardinal(PropValue);
      ptCurrency:  PInt64(Data)^ := StrToCurr64(PropValue);
      ptDouble:    PDouble(Data)^ := GetExtended(PropValue);
      ptInt64,ptID:PInt64(Data)^ := GetInt64(PropValue);
      ptInteger:   PInteger(Data)^ := GetInteger(PropValue);
      ptSingle:    PSingle(Data)^ := GetExtended(PropValue);
      ptRawUTF8:   PRawUTF8(Data)^ := PropValue;
      ptString:    UTF8DecodeToString(PropValue,StrLen(PropValue),PString(Data)^);
      ptSynUnicode:UTF8ToSynUnicode(PropValue,StrLen(PropValue),PSynUnicode(Data)^);
      ptDateTime:  Iso8601ToDateTimePUTF8CharVar(PropValue,0,PDateTime(Data)^);
      ptTimeLog:   PInt64(Data)^ := Iso8601ToTimeLogPUTF8Char(PropValue,0);
      ptWideString:UTF8ToWideString(PropValue,StrLen(PropValue),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: RawUTF8;
    Values: array of PUTF8Char;
begin
  result := false;
  if P=nil then
    exit;
  P := GotoNextNotSpace(P);
  if PInteger(P)^=NULL_LOW then begin // a record stored as null
    P := GotoNextNotSpace(P+4);
    inc(Data,fDataSize);
    result := true;
    exit;
  end;
  if not (PropertyType in [ptRecord,ptArray]) then begin
    result := ProcessValue(Self,P,Data);
    exit;
  end;
  if P^<>'{' then
    exit; // we expect a true object here
  repeat inc(P) until not(P^ in [#1..' ']);
  if P^='}' then begin
    inc(Data,fDataSize);
    EndOfObject := '}';
    inc(P);
  end else
  for i := 0 to High(NestedProperty) do begin
    PropName := GetJSONPropName(P);
    if PropName='' then
      exit;  // invalid JSON content
    if IdemPropNameU(NestedProperty[i].PropertyName,PropName) 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 high(NestedProperty) 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 High(NestedProperty) do
          if (Values[j]=nil) and IdemPropNameU(NestedProperty[j].PropertyName,PropName) then begin
            Values[j] := P;
            PropName := '';
            break;
          end;
        if (PropName<>'') and not(soReadIgnoreUnknownFields in Options) then
          exit; // unexpected property
        P := GotoNextJSONItem(P,1,@EndOfObject);
        if EndOfObject='}' then
          break;
        PropName := GetJSONPropName(P); // next name
        if PropName='' then
          exit;  // invalid JSON content
      until false;
      for j := i to high(NestedProperty) 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
    P := GotoNextJSONObjectOrArray(P,'}');
    if P=nil then
      exit;
  end else
    if EndOfObject<>'}' then
      exit;
  if P<>nil then
    P := GotoNextNotSpace(P);
  result := true;
end;

procedure TJSONCustomParserRTTI.WriteOneLevel(aWriter: TTextWriter; var P: PByte;
  Options: TJSONCustomParserSerializationOptions);
  procedure WriteOneValue(Prop: TJSONCustomParserRTTI; var Value: PByte);
  var DynArray: PByte;
      j: integer;
  begin
    case Prop.PropertyType of
    ptBoolean:   aWriter.AddString(JSON_BOOLEAN[PBoolean(Value)^]);
    ptByte:      aWriter.AddU(PByte(Value)^);
    ptCardinal:  aWriter.AddU(PCardinal(Value)^);
    ptCurrency:  aWriter.AddCurr64(PInt64(Value)^);
    ptDouble:    aWriter.AddDouble(unaligned(PDouble(Value)^));
    ptInt64,ptID:aWriter.Add(PInt64(Value)^);
    ptInteger:   aWriter.Add(PInteger(Value)^);
    ptSingle:    aWriter.AddSingle(PSingle(Value)^);
    ptWord:      aWriter.AddU(PWord(Value)^);
    {$ifndef NOVARIANTS}
    ptVariant:   aWriter.AddVariantJSON(PVariant(Value)^,twJSONEscape);
    {$endif}
    ptRawByteString:
      aWriter.WrBase64(PPointer(Value)^,length(PRawByteString(Value)^),true);
    ptRawJSON, ptRawUTF8, ptString, ptSynUnicode,
    ptDateTime, ptTimeLog, ptGUID, ptWideString: begin
      aWriter.Add('"');
      case Prop.PropertyType of
      ptRawJSON:       aWriter.AddNoJSONEscape(PPointer(Value)^,length(PRawJSON(Value)^));
      ptRawUTF8:       aWriter.AddJSONEscape(PPointer(Value)^);
      ptString:        aWriter.AddJSONEscapeString(PString(Value)^);
      ptSynUnicode,
      ptWideString:    aWriter.AddJSONEscapeW(PPointer(Value)^);
      ptDateTime:      aWriter.AddDateTime(unaligned(PDateTime(Value)^));
      ptTimeLog:       aWriter.AddTimeLog(PInt64(Value));
      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 Prop.NestedProperty[0].PropertyName='' then  // array of simple
            WriteOneValue(Prop.NestedProperty[0],DynArray) else begin
            Prop.WriteOneLevel(aWriter,DynArray,Options); // array of record
            aWriter.Add(',');
          end;
          {$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
      Prop.WriteOneLevel(aWriter,Value,Options);
      aWriter.Add(',');
      exit;
    end;
    ptCustom:
      TJSONCustomParserCustom(Prop).CustomWriter(aWriter,Value^);
    end;
    aWriter.Add(',');
    inc(Value,Prop.fDataSize);
  end;
var i: integer;
    SubProp: TJSONCustomParserRTTI;
begin
  if P=nil then begin
    aWriter.AddShort('null');
    exit;
  end;
  if not (PropertyType in [ptRecord,ptArray]) then begin
    WriteOneValue(self,P);
    exit;
  end;
  aWriter.Add('{');
  Inc(aWriter.fHumanReadableLevel);
  for i := 0 to high(NestedProperty) do begin
    SubProp := NestedProperty[i];
    if soWriteHumanReadable in Options then
      aWriter.AddCRAndIndent;
    aWriter.AddFieldName(SubProp.PropertyName);
    if soWriteHumanReadable in Options then
      aWriter.Add(' ');
    WriteOneValue(SubProp,P);
  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('Unknown 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;
begin
  Data := @aValue;
  aValid := Root.ReadOneLevel(P,Data,Options);
  result := P;
end;

procedure TJSONRecordAbstract.CustomWriter(const aWriter: TTextWriter; const aValue);
var P: PByte;
begin
  P := @aValue;
  Root.WriteOneLevel(aWriter,P,Options);
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;
begin
  if JSONCustomParserCache=nil then begin
    JSONCustomParserCache := TRawUTF8ListHashed.Create(True);
    GarbageCollector.Add(JSONCustomParserCache);
  end else begin
    i := JSONCustomParserCache.IndexOf(aDefinition);
    if i>=0 then begin
      result := TJSONRecordTextDefinition(JSONCustomParserCache.Objects[i]);
      exit;
    end;
  end;
  result := TJSONRecordTextDefinition.Create(aTypeInfo,aDefinition);
  JSONCustomParserCache.AddObject(aDefinition,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 generated % bytes',
      [self,fRoot.fCustomTypeName,recordInfoSize,fRoot.fDataSize]);
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, 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 not(P^ in [#1..' ']);
    end else
    if P^='[' then begin
      Typ := ptArray;
      ExpectedEnd := eeSquare;
      repeat inc(P) until not(P^ in [#1..' ']);
    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]);
          ExpectedEnd := eeEndKeyWord;
        end;
        ptRecord:
          ExpectedEnd := eeEndKeyWord;
        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,TypeInfoToName(aRecordTypeInfo)]);
    {$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: PFieldTable;
    i: integer;
    FieldSize: cardinal;
    RecField: PEnhancedFieldInfo;
    ItemFields: array of PEnhancedFieldInfo;
    ItemField: PDynArrayTypeInfo;
    ItemFieldName: RawUTF8;
    ItemFieldSize: cardinal;
    Item, ItemArray: TJSONCustomParserRTTI;
begin // only tkRecord is needed here
  FieldTable := RecordTypeInfoFieldTable(Info);
  if FieldTable=nil then
    raise ESynException.CreateUTF8('%.FromEnhancedRTTI(%=record?)',[self,Info]);
  FieldSize := FieldTable^.Size;
  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;
    if ItemFields[i]^.TypeInfo<>nil then
      ItemField := ItemFields[i]^.TypeInfo^ else
      ItemField := nil;
    SetRawUTF8(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('',ItemField^.elType2^,ItemField^.elSize);
      if (ItemArray.PropertyType=ptCustom) and
         (ItemArray.ClassType=TJSONCustomParserRTTI) then
        FromEnhancedRTTI(Item,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 VTYPE_STATIC then begin
        Dest := PVarData(TVarData(Source).VPointer)^;
        result := true;
      end else
        result := false;
    varNull..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;

procedure RawByteStringToVariant(Data: PByte; DataLen: Integer; var Value: variant);
begin
  with TVarData(Value) do begin
    if not (VType in VTYPE_STATIC) then
      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
    if not (VType in VTYPE_STATIC) then
      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
  with TVarData(Value) do
    if VType in VTYPE_STATIC then
      PPtrUInt(@VType)^ := varNull else begin
      VarClear(Value);
      PPtrUInt(@VType)^ := varNull;
    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); forward;

procedure SetVariantByRef(const Source: Variant; var Dest: Variant);
begin
  if not(TVarData(Dest).VType in VTYPE_STATIC) then
    VarClear(Dest);
  if (TVarData(Source).VType=varVariant or varByRef) or
     (TVarData(Source).VType in VTYPE_STATIC) then // already byref or simple
    TVarData(Dest) := TVarData(Source) else begin
    TVarData(Dest).VType := varVariant or varByRef;
    TVarData(Dest).VPointer := @Source;
  end;
end;

procedure SetVariantByValue(const Source: Variant; var Dest: Variant);
begin
  if not(TVarData(Dest).VType in VTYPE_STATIC) then
    VarClear(Dest);
  if TVarData(Source).VType in VTYPE_STATIC then
    TVarData(Dest) := TVarData(Source) else
  if not SetVariantUnRefSimpleValue(Source,TVarData(Dest)) then
    if TVarData(Source).VType=varVariant or varByRef then
      Dest := PVariant(TVarData(Source).VPointer)^ else
      Dest := Source;
end;

procedure ZeroFill(var Value: TVarData);
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 RawUTF8ToVariant(Txt: PUTF8Char; TxtLen: integer; var Value: variant);
begin
  with TVarData(Value) do begin
    if not (VType in VTYPE_STATIC) then
      VarClear(Value);
    VType := varString;
    VAny := nil; // avoid GPF below when assigning a string variable to VAny
    SetRawUTF8(RawUTF8(VAny),Txt,TxtLen);
  end;
end;

procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: variant);
begin
  with TVarData(Value) do begin
    if not (VType in VTYPE_STATIC) then
      VarClear(Value);
    VType := varString;
    VAny := nil; // avoid GPF below when assigning a string variable to VAny
    if Txt='' then
      exit;
    {$ifdef UNICODE}
    if PWord(PByte(Txt)-12)^=CP_RAWBYTESTRING then
      PWord(PByte(Txt)-12)^ := CP_UTF8; // force explicit UTF-8 
    {$endif}
    RawByteString(VAny) := Txt;
  end;
end;

procedure RawUTF8ToVariant(const Txt: RawUTF8; var Value: TVarData;
  ExpectedValueType: word);
begin
  if not (Value.VType in VTYPE_STATIC) then
    VarClear(variant(Value));
  Value.VType := ExpectedValueType;
  Value.VAny := nil; // avoid GPF below
  if Txt<>'' then
  case ExpectedValueType of
    varString: begin
      {$ifdef UNICODE}
      if PWord(PByte(Txt)-12)^=CP_RAWBYTESTRING then
        PWord(PByte(Txt)-12)^ := CP_UTF8; // force explicit UTF-8
      {$endif}
      RawByteString(Value.VAny) := Txt;
    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=varVariant or varByRef then begin
      result := VariantSave(PVariant(VPointer)^,Dest);
      exit;
    end else begin
    PWord(Dest)^ := VType;
    inc(Dest,sizeof(VType));
    case VType of
    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 VAny=nil then
        LenBytes := 0 else begin
        LenBytes := PInteger(PtrUInt(VAny)-sizeof(integer))^; // fast length() of string type
        {$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
        move(PPtrUInt(VAny)^,Dest^,LenBytes); // direct raw copy
        inc(Dest,LenBytes);
      end;
    end;
    else
      if SetVariantUnRefSimpleValue(Value,tmp) then begin
        result := VariantSave(variant(tmp),Dest-sizeof(VType));
        exit;
      end else // complex types are stored as JSON
        ComplexType;
    end;
  end;
  result := Dest;
end;

function VariantSaveLength(const Value: variant): integer;
var tmp: TVarData;
begin
  with TVarData(Value) do
  if VType=varVariant or varByRef then
    result := VariantSaveLength(PVariant(VPointer)^) else
  case VType of
  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 VAny=nil then
      result := 1+sizeof(VType) else
      result := ToVarUInt32LengthWithData(PInteger(PtrUInt(VAny)-sizeof(integer))^)
        +sizeof(VType);
   {$ifdef HASVARUSTRING}
   varUString:
    if VAny=nil then // stored length is in bytes, not (wide)chars
      result := 1+sizeof(VType) else
      result := ToVarUInt32LengthWithData(PInteger(PtrUInt(VAny)-sizeof(integer))^*2)
        +sizeof(VType);
    {$endif}
  else
    if SetVariantUnRefSimpleValue(Value,tmp) then
      result := VariantSaveLength(variant(tmp)) 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: TDocVariantOptions): variant;
begin
  if VariantLoad(result,Pointer(Bin),CustomVariantOptions)=nil then
    VarClear(result);
end;

function VariantLoad(var Value: variant; Source: PAnsiChar;
  CustomVariantOptions: TDocVariantOptions): PAnsiChar;
  procedure ComplexType;
  var JSON: PUTF8Char;
      tmp: RawUTF8;
  begin 
    try
      tmp := FromVarString(PByte(Source));
      JSON := pointer(tmp); // GetJSON*() does in-place unescape -> private copy
      TVarData(Value).VType := varEmpty; // avoid GPF below
      GetJSONToAnyVariant(Value,JSON,nil,@CustomVariantOptions);
      result := Source;
    except
      on Exception do
        Source := nil; // notify invalid/unhandled variant content
    end;
  end;
var LenBytes: Cardinal;
begin
  with TVarData(Value) do begin
    if not(VType in VTYPE_STATIC) then
      VarClear(Value);
    VType := PWord(Source)^;
    inc(Source,SizeOf(VType));
    case VType of
    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
      LenBytes := FromVarUInt32(PByte(Source));
      case VType of
      varString:
        SetString(AnsiString(VAny),Source,LenBytes);
      varOleStr:
        SetString(WideString(VAny),PWideChar(Source),LenBytes shr 1);
      {$ifdef HASVARUSTRING}
      varUString:
        SetString(UnicodeString(VAny),PWideChar(Source),LenBytes shr 1);
      {$endif}
      end;
      inc(Source,LenBytes);
    end;
    else // expected format for complex type is JSON (VType may differ)
      ComplexType;
    end;
  end;
  result := Source;
end;


procedure FromVarVariant(var Source: PByte; var Value: variant;
  CustomVariantOptions: TDocVariantOptions);
begin
  Source := PByte(VariantLoad(Value,PAnsiChar(Source)));
end;

function VariantLoadJSON(var Value: variant; JSON: PUTF8Char;
  EndOfObject: PUTF8Char; TryCustomVariants: PDocVariantOptions): 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);
      end else
        GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants);
    end else
      GetJSONToAnyVariant(Value,result,EndOfObject,TryCustomVariants);
  end else begin
    Val := GetJSONField(result,result,@wasString,EndOfObject);
    GetVariantFromJSON(Val,wasString,Value);
  end;
  if result=nil then
    result := @NULCHAR;
end;

procedure VariantLoadJSON(var Value: Variant; const JSON: RawUTF8;
  TryCustomVariants: PDocVariantOptions);
var tmp: RawUTF8;
begin
  SetString(tmp,PAnsiChar(pointer(JSON)),length(JSON)); // make local copy
  VariantLoadJSON(Value,pointer(tmp),nil,TryCustomVariants);
end;

function VariantLoadJSON(const JSON: RawUTF8; TryCustomVariants: PDocVariantOptions): variant;
var tmp: RawUTF8;
begin
  SetString(tmp,PAnsiChar(pointer(JSON)),length(JSON)); // make local copy
  VariantLoadJSON(result,pointer(tmp),nil,TryCustomVariants);
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);
begin // not very optimized, but fast enough in practice, and creates valid JSON
  with DefaultTextWriterJSONClass.CreateOwnedStream do
  try
    AddVariantJSON(Value,Escape);
    SetText(result);
  finally
    Free;
  end;
end;

function VariantSaveJSONLength(const Value: variant; Escape: TTextWriterKind): integer;
var Fake: TFakeWriterStream;
begin // will avoid most memory allocations, except for one 2KB internal buffer
  Fake := TFakeWriterStream.Create;
  try
    with DefaultTextWriterJSONClass.Create(Fake,2048) do
    try
      AddVariantJSON(Value,Escape);
      FlushFinal;
      result := fTotalFileSize;
    finally
      Free;
    end;
  finally
    Fake.Free;
  end;
end;

procedure VariantToVarRec(const V: variant; var result: TVarRec);
begin
  if TVarData(V).VType=varByRef or varVariant then
    VariantToVarRec(PVariant(TVarData(V).VPointer)^,result) else begin
    result.VType := vtVariant;
    result.VVariant := @V;
  end;
end;

function VarRecToVariant(const V: TVarRec): variant;
begin
  VarRecToVariant(V,result);
end;

procedure VarRecToVariant(const V: TVarRec; var result: variant);
begin
  if TVarData(result).VType in VTYPE_STATIC then
    TVarData(result).VType := varEmpty else
    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;
    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 UNICODE}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString: begin
      VType := varString;
      VAny := nil; // avoid GPF on next line
      VarRecToUTF8(V,RawUTF8(VAny));
    end;
    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;
begin
  Dest.VType := varEmpty; // left to Unassigned if not found
  DestVar := V;
  while DestVar.VType=varByRef or varVariant do
    DestVar := PVarData(DestVar.VPointer)^;
  repeat
    itemName := GetNextItem(FullName,'.');
    if itemName='' then
      exit;
    if DestVar.VType=DocVariantType.VarType 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=DocVariantType.VarType) 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;
    WS: PWideString;
    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}
  if Value.VType=varByRef or varOleStr then
    WS := Value.VPointer else
  if Value.VType=varOleStr then
    WS := @Value.VPointer else
  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;
  ValueSet.VType := varString; // unpatched RTL do not like WideString values
  ValueSet.VString := nil; // to avoid GPF in RawUTF8(ValueSet.VString) below
  RawUnicodeToUtf8(pointer(WS^),length(WS^),RawUTF8(ValueSet.VString));
  try
    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
    if not(Dest.VType in VTYPE_STATIC) then
      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 := (self<>nil) and (TVarData(V).VType=VarType);
end;  


{ TSynTableVariantType }

var
  SynTableVariantType: TCustomVariantType = nil;
  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);
// internal method used by VariantLoadJSON(), GetVariantFromJSON() and
// TDocVariantData.InitJSON()
var wasString: boolean;
procedure ProcessSimple(Val: PUTF8Char);
begin
  GetVariantFromJSON(Val,wasString,Value);
  if JSON=nil then
    JSON := @NULCHAR;
end;
var i: integer;
    VariantType: ^TSynInvokeableVariantType;
    ToBeParsed: PUTF8Char;
    wasParsedWithinString: boolean;
begin
  if not(TVarData(Value).VType in VTYPE_STATIC) then
    VarClear(Value);
  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;

procedure GetVariantFromJSON(JSON: PUTF8Char; wasString: Boolean; var Value: variant;
  TryCustomVariants: PDocVariantOptions);
var Dot: PUTF8Char;
    err: integer;
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) and (JSON^ in ['{','[']) then begin
    GetJSONToAnyVariant(Value,JSON,nil,TryCustomVariants);
    exit;
  end;
  // handle simple text or numerical values
  with TVarData(Value) do begin
    if VType in VTYPE_STATIC then
      VType := varEmpty else
      VarClear(Value);
    if (JSON=nil) or ((PInteger(JSON)^=NULL_LOW) and not wasString) then begin
      VType := varNull;
      exit;
    end else
    if (PInteger(JSON)^=FALSE_LOW) and (JSON[4]='e') and
       (JSON[5] in EndOfJSONValueField) then begin
      VType := varBoolean;
      VBoolean := false;
      exit;
    end else
    if (PInteger(JSON)^=TRUE_LOW) and (JSON[4] in EndOfJSONValueField) then begin
      VType := varBoolean;
      VBoolean := true;
      exit;
    end else
    if not wasString then begin // try if not a number
      Dot := JSON;
      repeat
        case Dot^ of
        '0'..'9','+','-':
          inc(Dot);
        '.':
          if (Dot[2]<>#0) and (Dot[3]<>#0) and (Dot[4]<>#0) and (Dot[5]<>#0) then
            break else begin // currency ###.1234 number
            VType := varCurrency;
            VInt64 := StrToCurr64(JSON);
            exit;
          end;
        #0: begin // integer number
          VInt64 := GetInt64(JSON);
          if (VInt64<=high(integer)) and (VInt64>=low(integer)) then
            VType := varInteger else
            VType := varInt64;
          exit;
        end;
        else break;
        end;
      until false;
      VDouble := GetExtended(JSON,err);
      if err=0 then begin // floating-point number
        VType := varDouble;
        exit;
      end;
    end;
    // found no numerical value -> return a string in the expected format
    VType := varString;
    VAny := nil; // avoid GPF below when assigning a string variable to VAny
    SetString(RawUTF8(VAny),PAnsiChar(JSON),StrLen(JSON));
  end;
end;

procedure TSynTableVariantType.Clear(var V: TVarData);
begin
  //Assert(V.VType=SynTableVariantType.VarType);
  TSynTableData(V).VValue := ''; // clean memory release
  PPtrUInt(@V)^ := 0; // will set V.VType := varEmpty
end;

procedure TSynTableVariantType.Copy(var Dest: TVarData;
  const Source: TVarData; const Indirect: Boolean);
begin
  //Assert(Source.VType=SynTableVariantType.VarType);
  inherited Copy(Dest,Source,Indirect); // copy VType+VID+VTable
  if not Indirect then
    with TSynTableData(Dest) do begin
      PtrInt(VValue) := 0; // avoid GPF
      VValue := TSynTableData(Source).VValue; // copy by reference
    end;
end;

procedure TSynTableVariantType.IntGet(var Dest: TVarData;
  const V: TVarData; Name: PAnsiChar);
begin
  TSynTableData(V).GetFieldVariant(RawByteString(Name),variant(Dest));
end;

procedure TSynTableVariantType.IntSet(const V, Value: TVarData;
  Name: PAnsiChar);
begin
  TSynTableData(V).SetFieldValue(RawByteString(Name),Variant(Value));
end;

class function TSynTableVariantType.ToID(const V: Variant): integer;
var Data: TSynTableData absolute V;
begin
  if Data.VType<>SynTableVariantType.VarType then
    result := 0 else
    result := Data.VID;
end;

class function TSynTableVariantType.ToSBF(const V: Variant): TSBFString;
var Data: TSynTableData absolute V;
begin
  if Data.VType<>SynTableVariantType.VarType then
    result := '' else
    result := Data.VValue;
end;

class function TSynTableVariantType.ToTable(const V: Variant): TSynTable;
var Data: TSynTableData absolute V;
begin
  if Data.VType<>SynTableVariantType.VarType then
    result := nil else
    result := Data.VTable;
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[true]);
  result := tmp.VValue;
end;

function ValuesToVariantDynArray(const items: array of const): TVariantDynArray;
var tmp: TDocVariantData;
begin
  tmp.InitArray(items,JSON_OPTIONS[true]);
  result := tmp.VValue;
end;

function VariantTypeToSQLDBFieldType(const V: Variant): TSQLDBFieldType;
var tmp: TVarData;
begin
  with TVarData(V) do
  case VType of
  varEmpty:
    result := ftUnknown;
  varNull:
    result := ftNull;
  {$ifndef DELPHI5OROLDER}varShortInt, varWord, varLongWord,{$endif}
  varSmallInt, varByte, varBoolean, varInteger, varInt64, varWord64:
    result := ftInt64;
  varSingle,varDouble:
    result := ftDouble;
  varDate:
    result := ftDate;
  varCurrency:
    result := ftCurrency;
  varString:
    if (VString<>nil) and (PCardinal(VString)^ and $ffffff=JSON_BASE64_MAGIC) then
      result := ftBlob else
      result := ftUTF8;
  else
  if SetVariantUnRefSimpleValue(V,tmp) then
    result := VariantTypeToSQLDBFieldType(variant(tmp)) else
    result := ftUTF8;
  end;
end;


{ TDocVariantData }

procedure TDocVariantData.Init(aOptions: TDocVariantOptions; aKind: TDocVariantKind);
begin
  if DocVariantType=nil then
    DocVariantType := SynRegisterCustomVariantType(TDocVariant);
  ZeroFill(TVarData(self));
  VType := DocVariantType.VarType;
  VOptions := aOptions;
  VKind := aKind;
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,A: integer;
begin
  n := length(NameValuePairs) shr 1;
  if n=0 then
    exit; // nothing to add
  SetLength(VValue,VCount+n);
  SetLength(VName,VCount+n);
  for A := 0 to n-1 do begin
    VarRecToUTF8(NameValuePairs[A*2],VName[A+VCount]);
    VarRecToVariant(NameValuePairs[A*2+1],VValue[A+VCount]);
  end;
  inc(VCount,n);
end;

procedure TDocVariantData.InitArray(const Items: array of const;
  aOptions: TDocVariantOptions=[]);
var A: integer;
begin
  Init(aOptions,dvArray);
  if high(Items)>=0 then begin
    VCount := length(Items);
    SetLength(VValue,VCount);
    for A := 0 to high(Items) do
      VarRecToVariant(Items[A],VValue[A]);
  end;
end;

procedure TDocVariantData.InitArrayFromVariants(const Items: TVariantDynArray;
  aOptions: TDocVariantOptions=[]);
begin
  if Items=nil then
    VType := varNull else begin
    Init(aOptions,dvArray);
    VCount := length(Items);
    VValue := Items; // direct by-reference copy
  end;
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; // direct by-reference copy
    VValue := aValues;
  end;
end;

function TDocVariantData.InitJSONInPlace(JSON: PUTF8Char;
  aOptions: TDocVariantOptions; aEndOfObject: PUTF8Char): PUTF8Char;
var EndOfObject: AnsiChar;
    Name: PUTF8Char;
    n: integer;
begin
  Init(aOptions);
  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..' ']);
    n := JSONArrayCount(JSON);
    if n<0 then
      exit; // invalid content
    VKind := dvArray;
    if n>0 then begin
      SetLength(VValue,n);
      repeat
        GetJSONToAnyVariant(VValue[VCount],JSON,@EndOfObject,@VOptions);
        if JSON=nil then
          exit;
        inc(VCount);
        if VCount>n then
          raise EDocVariant.Create('Unexpected array size');
      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);
    if n<0 then
      exit; // invalid content
    VKind := dvObject;
    if n>0 then begin
      SetLength(VValue,n);
      SetLength(VName,n);
      repeat
        // see http://docs.mongodb.org/manual/reference/mongodb-extended-json
        Name := GetJSONPropName(JSON);
        if Name=nil then
          exit;
        GetJSONToAnyVariant(VValue[VCount],JSON,@EndOfObject,@VOptions);
        if JSON=nil then
          exit;
        VName[VCount] := Name;
        inc(VCount);
        if VCount>n then
          raise EDocVariant.Create('Unexpected object size');
      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
      VKind := dvObject;
      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: RawUTF8;
begin
  SetString(tmp,PAnsiChar(pointer(JSON)),length(JSON)); // make private copy
  result := InitJSONInPlace(pointer(tmp),aOptions)<>nil;
end;

procedure TDocVariantData.InitCopy(const SourceDocVariant: variant;
  aOptions: TDocVariantOptions);
var i: 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 (DocVariantType=nil) or (Source^.VType<>DocVariantType.VarType) then
    raise ESynException.CreateUTF8('No TDocVariant for InitCopy(%)',[Source.VType]);
  SourceVValue := Source^.VValue; // local fast per-reference copy
  if Source<>@self then begin
    VType := DocVariantType.VarType;
    VKind := Source^.Kind;
    VCount := Source^.VCount;
    pointer(VName) := nil;  // avoid GPF
    VName := Source^.VName;
    pointer(VValue) := nil;
  end else
    VariantDynArrayClear(VValue); // force re-create full copy of all values
  if VCount>0 then begin
    SetLength(VValue,VCount);
    for i := 0 to VCount-1 do begin
      v := @SourceVValue[i];
      while v^.VType=varByRef or varVariant do
        v := v^.VPointer;
      t := v^.VType;
      if t<=varNativeString then // simple string/number types copy
        VValue[i] := variant(v^) else
      if t=VType then // direct recursive copy for TDocVariant
        TDocVariantData(VValue[i]).InitCopy(variant(v^),aOptions) else
      if FindCustomVariantType(t,Handler) then
        if Handler.InheritsFrom(TSynInvokeableVariantType) then
          TSynInvokeableVariantType(Handler).CopyByValue(
            TVarData(VValue[i]),v^) else
          Handler.Copy(TVarData(VValue[i]),v^,false) else
        VValue[i] := variant(v^); // default copy
    end;
  end;
  VariantDynArrayClear(SourceVValue); // faster alternative
  VOptions := aOptions; // may not be the same as in Source
end;

procedure TDocVariantData.Clear;
begin
  if VType=DocVariantType.VarType then
    DocVariantType.Clear(TVarData(self)) else
    VarClear(variant(self));
end;                       

procedure TDocVariantData.Reset;
var opt: TDocVariantOptions;
begin
  opt := VOptions;
  DocVariantType.Clear(TVarData(self));
  VType := DocVariantType.VarType;
  VOptions := opt;
end;

procedure TDocVariantData.SetCount(aCount: integer);
begin
  VCount := aCount;
end;

procedure TDocVariantData.InternalAddValue(const aName: RawUTF8; const aValue: variant);
var len: integer;
begin
  if aName<>'' then
    case Kind of // aName is set for an object
      dvUndefined:
        VKind := dvObject;
      dvArray:
        raise EDocVariant.CreateUTF8('Unexpected "%" property name in an array',[aName]);
    end else
    case Kind of // aName is not set for an array
      dvUndefined:
        VKind := dvArray;
      dvObject:
        raise EDocVariant.Create('Unexpected array item added to an object');
    end;
  if VValue=nil then
    SetLength(VValue,16) else
  if VCount>=length(VValue) then
    SetLength(VValue,VCount+VCount shr 3+32);
  if VKind=dvObject then begin
    len := length(VValue);
    if Length(VName)<>len then
      SetLength(VName,len);
    VName[VCount] := aName;
  end;
  SetVariantByValue(aValue,VValue[VCount]);
  inc(VCount);
end;

procedure TDocVariantData.SetCapacity(aValue: integer);
begin
  if VKind=dvObject 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;
var ndx: integer;
begin
  if dvoCheckForDuplicatedNames in VOptions then begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      raise EDocVariant.CreateUTF8('Duplicated "%" name',[aName]);
  end;
  InternalAddValue(aName,aValue);
  result := VCount-1;
end;

function TDocVariantData.AddValue(aName: PUTF8Char; aNameLen: integer; const aValue: variant): integer;
var tmp: RawUTF8;
begin
  SetString(tmp,PAnsiChar(aName),aNameLen);
  result := AddValue(tmp,aValue);
end;

function TDocVariantData.AddItem(const aValue: variant): integer;
begin
  InternalAddValue('',aValue);
  result := VCount-1;
end;

function TDocVariantData.SearchItemByProp(const aPropName,aPropValue: RawUTF8;
  aCaseSensitive: boolean): integer;
var i: integer;
begin
  if VKind=dvArray then
    for result := 0 to VCount-1 do
      with TDocVariantData(VValue[result]) do
        if VKind=dvObject then begin
          i := GetValueIndex(aPropName);
          if i>=0 then
            if aCaseSensitive then begin
              if VValue[i]=aPropValue then
                exit;
            end else
            if IdemPropNameU(VariantToUTF8(VValue[i]),aPropValue) then
              exit;
        end;
  result := -1;
end;

function TDocVariantData.SearchItemByValue(const aValue: Variant): integer;
begin
  if VKind=dvArray then
    for result := 0 to VCount-1 do
      if VValue[result]=aValue then // rely on Variants.pas comparison
        exit;
  result := -1;
end;

procedure QuickSortDocVariant(names: PPointerArray; values: PVariantArray;
  L, R: PtrInt; Compare: TUTF8Compare);
var I, J, P: PtrInt;
    pivot, Tmp: pointer;
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
        Tmp := names[J]; names[J] := names[I]; names[I] := Tmp;
        Exchg16(@values[I],@values[J]);
        if P = I then P := J else if P = J then P := I;
        inc(I); dec(J);
      end;
    until I > J;
    if L < J then
      QuickSortDocVariant(names,values,L,J,Compare);
    L := I;
  until I >= R;
end;

procedure TDocVariantData.SortByName(Compare: TUTF8Compare=nil);
begin
  if (VKind<>dvObject) or (VCount=0) then
    exit;
  if not Assigned(Compare) then
    Compare := @StrIComp;
  QuickSortDocVariant(pointer(VName),pointer(VValue),0,VCount-1,Compare);
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
        move(VName[Index+1],VName[Index],(VCount-Index)*sizeof(pointer));
        PtrUInt(VName[VCount]) := 0; // avoid GPF
      end;
      move(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.GetValueIndex(aName: PUTF8Char; aNameLen: integer;
  aCaseSensitive: boolean): integer;
var err: integer;
begin
  if Kind=dvArray 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;
  // simple lookup for object names -> hashing may be needed for huge count
  if aCaseSensitive then begin
    for result := 0 to VCount-1 do
      if (length(VName[result])=aNameLen) and
         CompareMem(pointer(VName[result]),aName,aNameLen) then
        exit;
  end else
    for result := 0 to VCount-1 do
      if IdemPropNameU(VName[result],aName,aNameLen) then
        exit;
  result := -1;
end;

function TDocVariantData.GetValueIndex(const aName: RawUTF8): integer;
begin
  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 (DocVariantType=nil) or (VType<>DocVariantType.VarType) or
     (Kind<>dvObject) then
    result := aDefault else begin
    ndx := GetValueIndex(aName);
    if ndx>=0 then
      result := VValue[ndx] else
      result := aDefault;
  end;
end;

function TDocVariantData.GetAsInteger(const aName: RawUTF8; out aValue: integer): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName);
  if found=nil then
    result := false else
    result := VariantToInteger(PVariant(found)^,aValue)
end;

function TDocVariantData.GetAsInt64(const aName: RawUTF8; out aValue: Int64): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName);
  if found=nil then
    result := false else
    result := VariantToInt64(PVariant(found)^,aValue)
end;

function TDocVariantData.GetAsDouble(const aName: RawUTF8; out aValue: double): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName);
  if found=nil then
    result := false else
    result := VariantToDouble(PVariant(found)^,aValue);
end;

function TDocVariantData.GetAsRawUTF8(const aName: RawUTF8; out aValue: RawUTF8): Boolean;
var found: PVarData;
begin
  found := GetVarData(aName);
  if found=nil then
    result := false else begin
    aValue := VariantToUTF8(PVariant(found)^);
    result := true;
  end;
end;

function TDocVariantData.GetVarData(const aName: RawUTF8;
  var aValue: TVarData): boolean;
var found: PVarData;
begin
  found := GetVarData(aName);
  if found=nil then
    result := false else begin
    aValue := found^;
    result := true;
  end;
end;

function TDocVariantData.GetVarData(const aName: RawUTF8): PVarData;
var ndx: Integer;
begin
  if (DocVariantType=nil) or (VType<>DocVariantType.VarType) or
     (Kind<>dvObject) then
    result := nil else begin
    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 (DocVariantType=nil) or (VType<>DocVariantType.VarType) or
     (Kind<>dvObject) then
    exit;
  DocVariantType.Lookup(Dest,TVarData(self),pointer(aPath));
  if Dest.VType>=varNull then
    result := variant(Dest); // copy
end;

function TDocVariantData.GetValueByPath(const aDocVariantPath: array of RawUTF8): variant;
var found,res: PVarData;
    P: integer;
begin
  VarClear(result);
  if (DocVariantType=nil) or (VType<>DocVariantType.VarType) or
     (Kind<>dvObject) 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;

procedure TDocVariantData.SetValueOrRaiseException(Index: integer; const NewValue: variant);
begin
  if cardinal(Index)>=cardinal(VCount) then
    raise EDocVariant.CreateUTF8('Out of range [%] (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 dvoReturnNullForOutOfRangeIndex in VOptions then
      Dest := '' else
      raise EDocVariant.CreateUTF8('Out of range [%] (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 dvoReturnNullForOutOfRangeIndex in VOptions then
      SetVariantNull(Dest) else
      raise EDocVariant.CreateUTF8('Out of range [%] (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 VKind=dvArray 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 VKind=dvArray 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
        InternalAddValue(Name,aValue) else
        SetVariantByValue(aValue,VValue[ndx]);
    end else
      SetValueOrRaiseException(VariantToIntegerDef(aNameOrIndex,-1),aValue);
  end;
end;

function TDocVariantData.ToJSON: RawUTF8;
begin
  VariantSaveJSON(variant(self),twJSONEscape,result);
end;

procedure TDocVariantData.ToRawUTF8DynArray(out Result: TRawUTF8DynArray);
var i: integer;
    wasString: boolean;
begin
  case VKind of
  dvUndefined: exit; // leave Result=[]
  dvArray: ;
  else raise EDocVariant.Create('ToRawUTF8DynArray expects an array');
  end;
  SetLength(Result,VCount);
  for i := 0 to VCount-1 do
    VariantToUTF8(VValue[i],Result[i],wasString);
end;


{ TDocVariant }

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=DocVariantType.VarType);
  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 (Data.Kind=dvArray) and (PWord(Name)^=ord('_')) then begin
    Data.InternalAddValue('',Variant(Value));
    exit;
  end;
  SetString(aName,Name,StrLen(PUTF8Char(Name)));
  ndx := Data.GetValueIndex(aName);
  if ndx<0 then
    Data.InternalAddValue(aName,Variant(Value)) else
    SetVariantByValue(variant(Value),Data.VValue[ndx]);
end;

function TDocVariant.IterateCount(const V: TVarData): integer;
var Data: TDocVariantData absolute V;
begin
  if Data.Kind<>dvArray then
    result := -1 else
    result := Data.VCount;
end;

procedure TDocVariant.Iterate(var Dest: TVarData; const V: TVarData; Index: integer);
var Data: TDocVariantData absolute V;
begin
  if (Data.Kind=dvArray) 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: TDocVariantData absolute V;
    temp: RawUTF8;
procedure SetTempFromFirstArgument;
var wasString: boolean;
begin
  VariantToUTF8(variant(Arguments[0]),temp,wasString);
end;
begin
  result := true;
  case length(Arguments) of
  0:if SameText(Name,'Clear') then begin
      PDocVariantData(@V)^.VCount := 0;
      PDocVariantData(@V)^.VKind := dvUndefined;
      exit;
    end;
  1:if SameText(Name,'Add') then begin
      Data.InternalAddValue('',variant(Arguments[0]));
      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;
      Data.InternalAddValue(temp,variant(Arguments[1]));
      exit;
    end;
  end;
  result := false;
end;

procedure TDocVariant.ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind);
var i: integer;
begin
  with TDocVariantData(Value) do
  if VType=DocVariantType.VarType then
  case VKind of
    dvUndefined:
      W.AddShort('null');
    dvObject: begin
      W.Add('{');
      for i := 0 to VCount-1 do begin
        W.Add('"');
        W.AddJSONEscape(pointer(VName[i]),Length(VName[i]));
        W.Add('"',':');
        W.AddVariantJSON(VValue[i],twJSONEscape);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add('}');
    end;
    dvArray: begin
      W.Add('[');
      for i := 0 to VCount-1 do begin
        W.AddVariantJSON(VValue[i],twJSONEscape);
        W.Add(',');
      end;
      W.CancelLastComma;
      W.Add(']');
    end;
  end else
    raise ESynException.CreateUTF8('Unexpected variant type %',[VType]);
end;

procedure TDocVariant.Clear(var V: TVarData);
begin
  //Assert(V.VType=DocVariantType.VarType);
  VariantDynArrayClear(TDocVariantData(V).VValue);
  Finalize(TDocVariantData(V).VName,1);
  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=DocVariantType.VarType);
  if Indirect then
    SimplisticCopy(Dest,Source,true) else
    if dvoValueCopiedByReference in TDocVariantData(Source).Options then begin
      if not(Dest.VType in VTYPE_STATIC) then
        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=DocVariantType.VarType);
  if not(Dest.VType in VTYPE_STATIC) then
    VarClear(variant(Dest)); // Dest may be a complex type
  D.VType := S.VType;
  D.VOptions := S.VOptions;
  D.VKind := S.VKind;
  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
      if not(Dest.VType in VTYPE_STATIC) then
        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).Init(JSON_OPTIONS[true]);
end;

class procedure TDocVariant.NewFast(const aValues: array of PDocVariantData);
var i: integer;
begin
  for i := 0 to high(aValues) do
    aValues[i]^.Init(JSON_OPTIONS[true]);
end;

class function TDocVariant.New(Options: TDocVariantOptions): Variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).Init(Options);
end;

class function TDocVariant.NewObject(const NameValuePairs: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,Options);
end;

class function TDocVariant.NewArray(const Items: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).InitArray(Items,Options);
end;

class function TDocVariant.NewArray(const Items: TVariantDynArray;
  Options: TDocVariantOptions=[]): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    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
  if not(TVarData(result).VType in VTYPE_STATIC) then
    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 (DocVariantType=nil) or
     (TVarData(DocVariantArray).VType<>DocVariantType.VarType) or
     (TDocVariantData(DocVariantArray).Kind<>dvArray) or
     (TDocVariantData(DocVariantArray).Count<>1) then
    result := default else
    result := TDocVariantData(DocVariantArray).Values[0];
end;

function DocVariantData(const DocVariant: variant): PDocVariantData;
begin
  with TVarData(DocVariant) do
    if VType=DocVariantType.VarType then
      result := @DocVariant else
    if VType=varByRef or varVariant then
      result := DocVariantData(PVariant(VPointer)^) else
    raise EDocVariant.CreateUTF8('DocVariantType.Data(%<>TDocVariant)',[VType]);
end;

const // will be in code section of the exe, so will be read-only by design
  DocVariantDataFake: TDocVariantData = ();

function DocVariantDataSafe(const DocVariant: variant): PDocVariantData;
begin
  with TVarData(DocVariant) do
    if VType=DocVariantType.VarType then
      result := @DocVariant else
    if VType=varByRef or varVariant then
      result := DocVariantDataSafe(PVariant(VPointer)^) else
      result := @DocVariantDataFake;
end;

function DocVariantDataSafe(const DocVariant: variant; ExpectedKind: TDocVariantKind): PDocVariantData; overload;
begin
  result := DocVariantDataSafe(DocVariant);
  if result^.Kind<>ExpectedKind then
    raise EDocVariant.CreateUTF8('DocVariantSafe(%)<>%',
      [ord(result^.Kind),ord(ExpectedKind)]);
end;

function _Obj(const NameValuePairs: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,Options);
end;

function _Arr(const Items: array of const;
  Options: TDocVariantOptions=[]): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).InitArray(Items,Options);
end;

procedure _ObjAddProps(const NameValuePairs: array of const; var Obj: variant);
begin
  // ensure Obj is not by reference
  while TVarData(Obj).VType=varByRef or varVariant do
    TVarData(Obj) := PVarData(TVarData(Obj).VPointer)^;
  // add name,value pairs
  if (DocVariantType=nil) or
     (TVarData(Obj).VType<>DocVariantType.VarType) or
     (TDocVariantData(Obj).Kind<>dvObject) then begin
    // Obj is not a valid TDocVariant object -> create new
    if not(TVarData(Obj).VType in VTYPE_STATIC) then
      VarClear(Obj);
    TDocVariantData(Obj).InitObject(NameValuePairs,JSON_OPTIONS[true]);
  end else
    // add name,value pairs to the TDocVariant object
    TDocVariantData(Obj).AddNameValuesToObject(NameValuePairs);
end;

procedure _ObjAddProps(const Document: variant; var Obj: variant);
var i: integer;
begin
  while TVarData(Obj).VType=varByRef or varVariant do
    TVarData(Obj) := PVarData(TVarData(Obj).VPointer)^;
  if (DocVariantType=nil) or
     (TVarData(Obj).VType<>DocVariantType.VarType) or
     (TDocVariantData(Obj).Kind<>dvObject) or
     (TVarData(Document).VType<>DocVariantType.VarType) or
     (TDocVariantData(Document).Kind<>dvObject) then
    exit; // nothing to do
  with TDocVariantData(Document) do
    for i := 0 to VCount-1 do
      TDocVariantData(Obj).AddValue(VName[i],VValue[i]);
end;

function _ObjFast(const NameValuePairs: array of const): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).InitObject(NameValuePairs,JSON_OPTIONS[true]);
end;

function _ArrFast(const Items: array of const): variant;
begin
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  TDocVariantData(result).InitArray(Items,JSON_OPTIONS[true]);
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[true]);
end;

function _JsonFmt(const Format: RawUTF8; const Args,Params: array of const;
  Options: TDocVariantOptions): variant;
begin
  _Json(FormatUTF8(Format,Args,Params,true),result,Options);
end;

function _JsonFastFmt(const Format: RawUTF8; const Args,Params: array of const): variant;
begin
  _Json(FormatUTF8(Format,Args,Params,true),result,JSON_OPTIONS[true]);
end;

function _Json(const JSON: RawUTF8; var Value: variant;
  Options: TDocVariantOptions): boolean;
begin
  if not(TVarData(Value).VType in VTYPE_STATIC) then
    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(DocVariant,JSON_OPTIONS[false]);
end;

procedure _UniqueFast(var DocVariant: variant);
begin
  TDocVariantData(DocVariant).InitCopy(DocVariant,JSON_OPTIONS[true]);
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[true]);
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}

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(var Value; TypeInfo: pointer): RawUTF8;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(8192) do
  try
    AddDynArrayJSON(TypeInfo,Value);
    SetText(result);
  finally
    Free;
  end;
end;

function DynArraySaveJSON(TypeInfo: pointer; const BlobValue: RawByteString): RawUTF8;
var DynArray: TDynArray;
    Value: pointer;
begin
  Value := nil;
  DynArray.Init(TypeInfo,Value);
  try
    if DynArray.LoadFrom(pointer(BlobValue))=nil then
      result := '' else begin
      with DefaultTextWriterJSONClass.CreateOwnedStream(8192) do
      try
        AddDynArrayJSON(TypeInfo,Value);
        SetText(result);
      finally
        Free;
      end;
     end;
  finally
    DynArray.Clear;
  end;
end;

function DynArrayElementTypeName(TypeInfo: pointer; ElemTypeInfo: PPointer): RawUTF8;
var DynArray: TDynArray;
    VoidArray: pointer;
const KNOWNTYPE_ITEMNAME: array[TDynArrayKind] of RawUTF8 = (
    '','byte','word','integer','cardinal','single','Int64','double','currency',
    'TTimeLog','TDateTime','RawUTF8','WinAnsiString','string','WideString',
    'SynUnicode',{$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];
end;

function SortDynArrayByte(const A,B): integer;
begin
  result := byte(A)-byte(B);
end;

function SortDynArrayWord(const A,B): integer;
begin
  result := word(A)-word(B);
end;

function SortDynArrayInteger(const A,B): integer;
begin
  result := Integer(A)-Integer(B);
end;

function SortDynArrayCardinal(const A,B): integer;
begin
  result := Int64(cardinal(A))-Int64(cardinal(B));
end;

function SortDynArrayInt64(const A,B): integer;
begin
  result := Int64(A)-Int64(B);
end;

function SortDynArrayPointer(const A,B): integer;
begin
  result := PtrInt(A)-PtrInt(B);
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 SortDynArrayAnsiString(const A,B): integer;
begin
  result := StrComp(PUTF8Char(A),PUTF8Char(B));
end;

function SortDynArrayString(const A,B): integer;
begin
  {$ifdef UNICODE}
  result := SysUtils.StrComp(PChar(A),PChar(B));
  {$else}
  result := StrComp(PUTF8Char(A),PUTF8Char(B));
  {$endif}
end;

function SortDynArrayAnsiStringI(const A,B): integer;
begin
  result := StrIComp(PUTF8Char(A),PUTF8Char(B));
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 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;

{$ifndef NOVARIANTS}

function SortDynArrayVariant(const A,B): integer;
begin
  if variant(A)=variant(B) then
    result := 0 else
  if variant(A)>variant(B) then
    result := 1 else
    result := -1;
end;

function SortDynArrayVariantI(const A,B): integer;
var UA,UB: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(variant(A),UA,wasString);
  VariantToUTF8(variant(B),UB,wasString);
  result := StrIComp(pointer(UA),pointer(UB));
end;

{$endif}

function TDynArray.Add(const Elem): integer;
begin
  result := Count;
  if fValue=nil then
    exit; // avoid GPF if void
  SetCount(result+1);
  ElemCopy(Elem,pointer(PtrUInt(fValue^)+PtrUInt(result)*ElemSize)^);
end;

function TDynArray.New: integer;
begin
  result := Count;
  if fValue=nil then
    exit; // avoid GPF if void
  SetCount(result+1);
end;

procedure TDynArray.Insert(Index: Integer; const Elem);
var n: integer;
    P: PByteArray;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := Count;
  SetCount(n+1);
  if cardinal(Index)<cardinal(n) then begin
    P := pointer(PtrUInt(fValue^)+PtrUInt(Index)*ElemSize);
    Move(P[0],P[ElemSize],cardinal(n-Index)*ElemSize);
    if ElemType<>nil then
      fillchar(P[0],ElemSize,0); // avoid GPF in ElemCopy() below
  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;

procedure TDynArray.Delete(aIndex: Integer);
var n, len: integer;
    P: PAnsiChar;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := Count;
  if cardinal(aIndex)>=cardinal(n) then
    exit; // out of range
  dec(n);
  P := pointer(PtrUInt(fValue^)+PtrUInt(aIndex)*ElemSize);
  if ElemType<>nil then
    _Finalize(P,ElemType) else
    if IsObjArray then
      FreeAndNil(PObject(P)^);
  if n>aIndex then begin
    len := cardinal(n-aIndex)*ElemSize;
    move(P[ElemSize],P[0],len);
    if ElemType<>nil then // avoid GPF
      fillchar(P[len],ElemSize,0);
  end;
  SetCount(n);
end;

function TDynArray.ElemPtr(aIndex: integer): pointer;
begin
  result := nil;
  if (fValue=nil) or (fValue^=nil) then
    exit;
  if fCountP<>nil then begin
    if cardinal(aIndex)>=PCardinal(fCountP)^ then
      exit;
  end else
    {$ifdef FPC}
    if cardinal(aIndex)>=cardinal(DynArrayLength(Value^)) then
    {$else}
    if cardinal(aIndex)>=PCardinal(PtrUInt(fValue^)-sizeof(PtrInt))^ then
    {$endif}
      exit;
  result := pointer(PtrUInt(fValue^)+PtrUInt(aIndex)*ElemSize);
end;

function TDynArray.GetCount: integer;
begin
  if fValue<>nil then
    if fCountP=nil then
      if PtrInt(fValue^)<>0 then
        {$ifdef FPC}
        result := DynArrayLength(Value^) else
        {$else}
        result := PInteger(PtrUInt(fValue^)-sizeof(PtrInt))^ else
        {$endif}
        result := 0 else
      result := fCountP^ else
    result := 0; // avoid GPF if void
end;

procedure TDynArray.Reverse;
var i, siz, n, tmp: integer;
    P1, P2: PAnsiChar;
    c: AnsiChar;
    i64: Int64;
begin
  n := Count-1;
  if n>0 then begin
    siz := ElemSize;
    P1 := fValue^;
    case siz of
    1: begin
      // optimized version for TByteDynArray and such
      P2 := P1+n;
      for i := 1 to n shr 1 do begin
        c := P1^;
        P1^ := P2^;
        P2^ := c;
        inc(P1);
        dec(P2);
      end;
    end;
    4: begin
      // optimized version for TIntegerDynArray + TRawUTF8DynArray and such
      P2 := P1+n*sizeof(Integer);
      for i := 1 to n shr 1 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);
      for i := 1 to n shr 1 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;
      for i := 1 to n shr 1 do begin
        Exchg16(Pointer(P1),Pointer(P2));
        inc(P1,16);
        dec(P2,16);
      end;
    end;
    else begin
      // generic version
      P2 := P1+n*siz;
      for i := 1 to n shr 1 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
      EStreamError.Create('TDynArray.SaveToStream');
    MemStream.Seek(PosiEnd,soBeginning);
  end else begin
    tmp := SaveTo;
    Stream.Write(pointer(tmp)^,length(tmp));
  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.SaveTo(Dest: PAnsiChar): PAnsiChar;
var i, n, LenBytes: integer;
    P: PAnsiChar;
    FieldTable: PFieldTable;
    NestedArray: TDynArray;
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 := pointer(ToVarUInt32(ElemSize,pointer(Dest)));
  if ElemType=nil then
    Dest^ := #0 else
    Dest^ := PAnsiChar(ElemType)^;
  inc(Dest);
  // then store dynamic array count
  n := Count;
  Dest := pointer(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
    if IsObjArray then
      raise ESynException.CreateUTF8('TDynArray.SaveTo(%) is a T*ObjArray',
        [PShortString(@PDynArrayTypeInfo(ArrayType).NameLen)^]) else begin
      // binary types: store as once
      n := n*integer(ElemSize);
      move(P^,Dest^,n);
      inc(Dest,n);
    end else
    case PTypeKind(ElemType)^ of
    tkLString, tkWString {$ifdef UNICODE}, tkUString{$endif}: begin
      for i := 1 to n do begin
        if PPtrUInt(P)^=0 then
          LenBytes := 0 else begin
          LenBytes := PInteger(PPtrUInt(P)^-sizeof(integer))^; // fast length()
          {$ifdef UNICODE} // WideString length in bytes, UnicodeString in WideChars
          if PTypeKind(ElemType)^=tkUString then
            LenBytes := LenBytes*2;
          {$endif}
        end;
        Dest := pointer(ToVarUInt32(LenBytes,pointer(Dest)));
        if LenBytes>0 then begin
          move(pointer(PPtrUInt(P)^)^,Dest^,LenBytes);
          inc(Dest,LenBytes);
        end;
        inc(P,sizeof(PtrUInt));
      end;
    end;
    {$ifndef NOVARIANTS}
    tkVariant:
      for i := 0 to n-1 do begin
        Dest := VariantSave(PVariantArray(P)^[i],Dest);
        if Dest=nil then
          break; // invalid/unhandled variant content
      end;
    {$endif}
    tkRecord{$ifdef FPC},tkObject{$endif}: begin
      FieldTable := ElemType;
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      FieldTable := GetFPCAlignPtr(FieldTable);
      {$else}
      inc(PtrUInt(FieldTable),FieldTable^.NameLen);
      {$endif}
      if FieldTable^.ManagedCount=0 then begin
        {$ifndef LVCL}
        assert(FieldTable^.Size=ElemSize);
        {$endif}
        n := n*integer(ElemSize);
        move(P^,Dest^,n);
        inc(Dest,n);
      end else begin
        for i := 1 to n do begin
          Dest := RecordSave(P^,Dest,ElemType);
          if Dest=nil then
            break; // invalid record type (wrong field type)
          inc(P,ElemSize);
        end;
      end;
    end;
    tkDynArray:
      for i := 1 to n do begin
        NestedArray.Init(ElemType,P^);
        Dest := NestedArray.SaveTo(Dest);
        inc(P,ElemSize);
      end;
  end;
  // store Hash32 checksum
  if Dest<>nil then  // may be nil if RecordSave() failed
    PCardinal(result-sizeof(Cardinal))^ := Hash32(result,Dest-result);
  result := Dest;
end;

function TDynArray.SaveToLength: integer;
var i,n,L: integer;
    P: PAnsiChar;
    NestedArray: TDynArray;
begin
  if fValue=nil then begin
    result := 0;
    exit; // avoid GPF if void
  end;
  n := Count;
  result := ToVarUInt32Length(ElemSize)+ToVarUInt32Length(n)+1;
  if n=0 then
    exit;
  if ElemType=nil then
    if IsObjArray then
      raise ESynException.CreateUTF8('TDynArray.SaveToLength(%) is a T*ObjArray',
        [PShortString(@PDynArrayTypeInfo(ArrayType).NameLen)^]) else
      inc(result,integer(ElemSize)*n) else begin
    P := fValue^;
    case PTypeKind(ElemType)^ of
    tkLString, tkWString:
      for i := 1 to n do begin
        if PPtrUInt(P)^=0 then
          inc(result) else
          inc(result,ToVarUInt32LengthWithData(PInteger(PPtrUInt(P)^-sizeof(integer))^));
        inc(P,sizeof(PtrUInt));
      end;
    {$ifdef UNICODE}
    tkUString: // WideString has length in bytes, UnicodeString in WideChars
      for i := 1 to n do begin
        if PPtrUInt(P)^=0 then
          inc(result) else
          inc(result,ToVarUInt32LengthWithData(PInteger(PPtrUInt(P)^-sizeof(integer))^*2));
        inc(P,sizeof(PtrUInt));
      end;
    {$endif}
    {$ifndef NOVARIANTS}
    tkVariant:
      for i := 0 to n-1 do begin
        L := VariantSaveLength(PVariantArray(P)^[i]);
        if L=0 then
          break; // invalid/unhandled variant content
        inc(result,L);
      end;
    {$endif}
    tkRecord{$ifdef FPC},tkObject{$endif}:
      for i := 1 to n do begin
        L := RecordSaveLength(P^,ElemType);
        if L=0 then
          break; // invalid record type (wrong field type)
        inc(result,L);
        inc(P,ElemSize);
      end;
    tkDynArray:
      for i := 1 to n do begin
        NestedArray.Init(ElemType,P^);
        inc(result,NestedArray.SaveToLength);
        inc(P,ElemSize);
      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: RawUTF8;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream(8192) do
  try
    AddDynArrayJSON(self);
    SetText(result);
  finally
    Free;
  end;
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 not(P^ in [#1..' ']);
  until false;
  if P^=']' then
    result := n;
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 not(P^ in [#1..' ']);
  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 not(P^ in [#1..' ']);
  until false;
  if P^='}' then
    result := n;
end;

const
  PTRSIZ = sizeof(Pointer);
  KNOWNTYPE_SIZE: array[TDynArrayKind] of byte = (
    0, 1, 2, 4,4,4, 8,8,8,8,8, PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,PTRSIZ,
    {$ifndef NOVARIANTS}sizeof(Variant),{$endif} 0);

function TDynArray.GetArrayTypeName: RawUTF8;
begin
  TypeInfoToName(fTypeInfo,result);
end;

function TDynArray.ToKnownType(exactType: boolean): TDynArrayKind;
var FieldTable: PFieldTable;
label Bin, Rec;
begin
  if fKnownType<>djNone then begin
    result := fKnownType;
    exit;
  end;
  { TByteDynArray/TWordDynArray/TIntegerDynArray/TInt64DynArray/TRawUF8DynArray/
    TWideStringDynArray/TVariantDynArray/TUnicodeStringArray will be retrieved
    from RTTI as tkLString/tkWString/tkVariant/tkUString }
  if fTypeInfo=TypeInfo(TCardinalDynArray) then
   fKnownType := djCardinal else
  if fTypeInfo=TypeInfo(TSingleDynArray) then
   fKnownType := djSingle else
  if fTypeInfo=TypeInfo(TDoubleDynArray) then
   fKnownType := djDouble else
  if fTypeInfo=TypeInfo(TCurrencyDynArray) then
   fKnownType := djCurrency else
  if fTypeInfo=TypeInfo(TWinAnsiDynArray) then
    fKnownType := djWinAnsi else
  if fTypeInfo=TypeInfo(TStringDynArray) then
    fKnownType := djString else
  if fTypeInfo=TypeInfo(TTimeLogDynArray) then
    fKnownType := djTimeLog else
  if fTypeInfo=TypeInfo(TDateTimeDynArray) then
    fKnownType := djDateTime else
  if fTypeInfo=TypeInfo(TSynUnicodeDynArray) then
    fKnownType := djSynUnicode else begin
    // not found directly from T*DynArray -> guess from RTTI
    fKnownType := djNone;
    fKnownSize := 0;
    if not exactType then
    if ElemType=nil then
Bin:  case ElemSize of
      1: fKnownType := djByte;
      2: fKnownType := djWord;
      4: fKnownType := djInteger;
      8: fKnownType := djInt64;
      else fKnownSize := ElemSize;
      end else
    case PTypeKind(ElemType)^ of
      tkLString: fKnownType := djRawUTF8;
      tkWString: fKnownType := djWideString;
      {$ifdef UNICODE}
      tkUString: fKnownType := djString;
      {$endif}
      tkRecord{$ifdef FPC},tkObject{$endif}: begin
        FieldTable := ElemType;
        {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
rec:    FieldTable := GetFPCAlignPtr(FieldTable);
        {$else}
rec:    inc(PtrUInt(FieldTable),(FieldTable^.NameLen));
        {$endif}
        if FieldTable^.ManagedCount=0 then // only binary content -> full content
          goto Bin;
        with FieldTable^.ManagedFields[0] do
        case Offset of
        0: case TypeInfo^.Kind of
            tkLString: fKnownType := djRawUTF8;
            tkWString: fKnownType := djWideString;
            {$ifdef UNICODE}
            tkUString: fKnownType := djString;
            {$endif}
            tkRecord{$ifdef FPC},tkObject{$endif}: begin
              FieldTable := pointer(TypeInfo{$ifndef FPC}^{$endif});
              goto Rec;
            end;
            {$ifndef NOVARIANTS}
            tkVariant: fKnownType := djVariant;
            {$endif}
            else begin
              {$ifdef FPC} // unmanaged fields have RTTI in newest FPC! :)
              if (FieldTable^.ManagedCount<>1) and // emulate Delphi behavior
                 (FieldTable^.ManagedFields[1].TypeInfo^.Kind in tkManagedTypes) then
              case FieldTable^.ManagedFields[1].Offset of
                1: fKnownType := djByte;
                2: fKnownType := djWord;
                4: fKnownType := djInteger;
                8: fKnownType := djInt64;
                else fKnownSize := FieldTable^.ManagedFields[1].Offset;
              end else
              {$endif}
              goto bin;
            end;
           end;
        1: fKnownType := djByte;
        2: fKnownType := djWord;
        4: fKnownType := djInteger;
        8: fKnownType := djInt64;
        else fKnownSize := Offset;
        end;
    end;
    {$ifndef NOVARIANTS}
    tkVariant: fKnownType := djVariant;
    {$endif}
    end;
  end;
  if KNOWNTYPE_SIZE[fKnownType]<>0 then
    fKnownSize := KNOWNTYPE_SIZE[fKnownType];
  result := fKnownType;
end;

function TDynArray.LoadFromJSON(P: PUTF8Char; aEndOfObject: PUTF8Char=nil): PUTF8Char;
var n, i: integer;
    T: TDynArrayKind;
    wasString, expectedString, isValid: boolean;
    EndOfObject: AnsiChar;
    Val: PUTF8Char;
    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 GlobalJSONCustomParsers.DynArraySearch(ArrayType,ElemType,CustomReader) then
    T := djCustom else 
    T := ToKnownType;
  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 IsObjArray 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
      expectedString := (T in [djTimeLog..djSynUnicode]);
      for i := 0 to n-1 do begin
        Val := GetJSONField(P,P,@wasString,@EndOfObject);
        if (Val=nil) or (wasString<>expectedString) then
          exit;
        case T of
        djByte:     PByteArray(fValue^)^[i] := GetCardinal(Val);
        djWord:     PWordArray(fValue^)^[i] := GetCardinal(Val);
        djInteger:  PIntegerArray(fValue^)^[i] := GetInteger(Val);
        djCardinal: PCardinalArray(fValue^)^[i] := GetCardinal(Val);
        djSingle:   PSingleArray(fValue^)^[i] := GetExtended(Val);
        djInt64:    SetInt64(Val,PInt64Array(fValue^)^[i]);
        djTimeLog:  PInt64Array(fValue^)^[i] := Iso8601ToTimeLogPUTF8Char(Val,0);
        djDateTime: Iso8601ToDateTimePUTF8CharVar(Val,0,TDateTime(PDoubleArray(fValue^)^[i]));
        djDouble:   PDoubleArray(fValue^)^[i] := GetExtended(Val);
        djCurrency: PInt64Array(fValue^)^[i] := StrToCurr64(Val);
        djRawUTF8:  RawUTF8(PPointerArray(fValue^)^[i]) := Val;
        djWinAnsi:  WinAnsiConvert.UTF8BufferToAnsi(Val,StrLen(Val),RawByteString(PPointerArray(fValue^)^[i]));
        djString:   UTF8DecodeToString(Val,StrLen(Val),string(PPointerArray(fValue^)^[i]));
        djWideString: UTF8ToWideString(Val,StrLen(Val),WideString(PPointerArray(fValue^)^[i]));
        djSynUnicode: UTF8ToSynUnicode(Val,StrLen(Val),SynUnicode(PPointerArray(fValue^)^[i]));
        end;
      end;
    end;
    end;
  end;
  if aEndOfObject<>nil then
    aEndOfObject^ := EndOfObject;
  if EndOfObject=']' then
    if P=nil then
      result := @NULCHAR else
      result := P;
end;

function SimpleDynArrayLoadFrom(Source: PAnsiChar; aTypeInfo: pointer;
  var Count, ElemSize: integer): pointer;
var Hash: PCardinalArray absolute Source;
    Typ: PDynArrayTypeInfo absolute aTypeInfo;
begin
  result := nil;
  if (aTypeInfo=nil) or (Typ^.kind<>tkDynArray) then
    exit; // invalid type information
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  Typ := GetFPCAlignPtr(Typ);
  {$else}
  inc(PtrUInt(Typ),Typ^.NameLen);
  {$endif}
  if (Typ^.ElType<>nil) or (Source=nil) or
     (Source[0]<>AnsiChar(Typ^.elSize)) or (Source[1]<>#0) then
    exit; // invalid type information or Source content
  ElemSize := Typ^.elSize;
  inc(Source,2);
  Count := FromVarUInt32(PByte(Source)); // dynamic array count
  if (Count<>0) and (Hash32(@Hash[1],Count*Typ^.elSize)=Hash[0]) then
    result := @Hash[1]; // returns valid Source content
end;

function IntegerDynArrayLoadFrom(Source: PAnsiChar; var Count: integer): 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 (Hash32(@Hash[1],Count*sizeof(Integer))=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))) or
     (Source[1]<>AnsiChar(tkLString)) 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 security checksum
  for result := 0 to Count-1 do begin
    Len := FromVarUInt32(PByte(Source));
    if CaseSensitive then begin
      if (Len=ValueLen) and CompareMem(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 TDynArray.LoadFrom(Source: PAnsiChar): PAnsiChar;
var i, n, LenBytes: integer;
    P: PAnsiChar;
    FieldTable: PFieldTable;
    Hash: PCardinalArray;
    NestedArray: TDynArray;
begin
  // check stored element size+type
  if Source=nil then begin
    Clear;
    result := nil;
    exit;
  end;
  FromVarUInt32(PByte(Source)); // ignore StoredElemSize to be Win32/64 compatible
  if (fValue=nil) or
     //((ElemSize<>sizeof(pointer)) and (StoredElemSize<>ElemSize)) or
     ((ElemType=nil) and (Source^<>#0) or
     ((ElemType<>nil) and (Source^=#0{<>PAnsiChar(ElemType)^}))) then begin
     // ignore ElemType^ to be cross-FPC/Delphi compatible
    result := nil; // invalid Source content
    exit;
  end;
  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
  if IsObjArray then 
    raise ESynException.CreateUTF8('TDynArray.LoadFrom(%) is a T*ObjArray',
      [PShortString(@PDynArrayTypeInfo(ArrayType).NameLen)^]) else begin
    // binary type was stored as once
    n := n*integer(ElemSize);
    move(Source^,P^,n);
    inc(Source,n);
  end else
  case PTypeKind(ElemType)^ of
    tkLString, tkWString {$ifdef UNICODE}, tkUString{$endif}:
    for i := 1 to n do begin
      LenBytes := FromVarUInt32(PByte(Source));
      case PTypeKind(ElemType)^ of
      tkLString: begin
        SetString(PRawByteString(P)^,Source,LenBytes);
        {$ifdef UNICODE}
        { Delphi 2009+: set Code page for this AnsiString }
        if LenBytes<>0 then
          PWord(PPtrUInt(P)^-12)^ := PWord(PtrUInt(ElemType)+
            PDynArrayTypeInfo(ElemType)^.NameLen+2)^;
        {$endif}
      end;
      tkWString:
        SetString(PWideString(P)^,PWideChar(Source),LenBytes shr 1);
      {$ifdef UNICODE}
      tkUString:
        SetString(PString(P)^,PWideChar(Source),LenBytes shr 1);
      {$endif}
      end;
      inc(Source,LenBytes);
      inc(P,sizeof(PtrUInt));
    end;
    tkRecord{$ifdef FPC},tkObject{$endif}: begin
      FieldTable := ElemType;
      {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
      FieldTable := GetFPCAlignPtr(FieldTable);
      {$else}
      inc(PtrUInt(FieldTable),FieldTable^.NameLen);
      {$endif}
      if FieldTable^.ManagedCount=0 then begin
        {$ifndef LVCL}
        assert(FieldTable^.Size=ElemSize);
        {$endif}
        n := n*integer(ElemSize);
        move(Source^,P^,n);
        inc(Source,n);
      end else begin
        for i := 1 to n do begin
          Source := RecordLoad(P^,Source,ElemType);
          if Source=nil then
            break; // invalid content (e.g. wrong field type)
          inc(P,ElemSize);
        end;
      end;
    end;
    {$ifndef NOVARIANTS}
    tkVariant:
      for i := 0 to n-1 do begin
        Source := VariantLoad(PVariantArray(P)^[i],Source);
        if Source=nil then
          break; // invalid/unhandled variant content
      end;
    {$endif}
    tkDynArray:
      for i := 1 to n do begin
        NestedArray.Init(ElemType,P^);
        Source := NestedArray.LoadFrom(Source);
        if Source=nil then
          break; // invalid content (e.g. wrong field type)
        inc(P,ElemSize);
      end;
  end;
  // check security checksum
  if (Source=nil) or (Hash32(@Hash[1],Source-PAnsiChar(@Hash[1]))<>Hash[0]) then
    result := nil else
    result := Source;
end;

function TDynArray.Find(const Elem; const aIndex: TIntegerDynArray;
      aCompare: TDynArraySortCompare): integer;
var n, L, cmp: integer;
    P: PAnsiChar;
begin
  n := Count;
  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 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 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): integer;
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(var 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): integer;
var n, L, cmp: integer;
    P: PAnsiChar;
begin
  n := Count;
  if (@fCompare<>nil) and (n>0) then begin
    dec(n);
    P := fValue^;
    if fSorted and (n>10) then begin
      // array is sorted -> use fast 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
      // array is not sorted -> use iterating search
      for result := 0 to n do
        if fCompare(P^,Elem)=0 then
          exit else
          inc(P,ElemSize);
  end;
  result := -1;
end;

type
  // internal structure used to make QuickSort faster & with less stack usage
  TDynArrayQuickSort = {$ifndef UNICODE}object{$else}record{$endif}
    Compare: TDynArraySortCompare;
    Pivot: pointer;
    Index: PCardinalArray;
    ElemSize: cardinal;
    P: integer;
    Value: PAnsiChar;
    IP, JP: PAnsiChar;
    procedure QuickSort(L, R: PtrInt);
    procedure QuickSortIndexed(L, R: PtrInt);
  end;

procedure QuickSortIndexedPUTF8Char(Values: PPUtf8CharArray; Count: Integer;
  var SortedIndexes: TCardinalDynArray; CaseSensitive: boolean);
var QS: TDynArrayQuickSort;
    i: integer;
begin
  if CaseSensitive then
    QS.Compare := SortDynArrayAnsiString else
    QS.Compare := SortDynArrayAnsiStringI;
  QS.Value := pointer(Values);
  QS.ElemSize := sizeof(PUTF8Char);
  SetLength(SortedIndexes,Count);
  dec(Count);
  for i := 0 to Count do
    SortedIndexes[i] := i;
  QS.Index := pointer(SortedIndexes);
  QS.QuickSortIndexed(0,Count);
end;

procedure TDynArrayQuickSort.QuickSort(L, R: PtrInt);
var I, J: integer;
    tmp: pointer;
begin
  if L<R then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      pivot := Value+cardinal(P)*ElemSize;
      IP := Value+cardinal(I)*ElemSize;
      JP := Value+cardinal(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
          if ElemSize=SizeOf(pointer) then begin
            // optimized version e.g. for TRawUTF8DynArray 
            tmp := PPointer(IP)^;
            PPointer(IP)^ := PPointer(JP)^;
            PPointer(JP)^ := tmp;
          end else
            // 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 L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure TDynArrayQuickSort.QuickSortIndexed(L, R: PtrInt);
var I, J, 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 L < J then
      QuickSortIndexed(L, J);
    L := I;
  until I >= R;
end;

procedure TDynArray.Sort;
var QuickSort: TDynArrayQuickSort;
begin
  if (@fCompare<>nil) and (fValue<>nil) and (fValue^<>nil) then begin
    Quicksort.Compare := @fCompare;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := ElemSize;
    Quicksort.QuickSort(0,Count-1);
    fSorted := true;
  end;
end;

procedure TDynArray.CreateOrderedIndex(var aIndex: TIntegerDynArray;
  aCompare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
    n: integer;
begin
  if (@aCompare<>nil) and (fValue<>nil) and (fValue^<>nil) then begin
    n := Count;
    if length(aIndex)<n then begin
      SetLength(aIndex,n);
      FillIncreasing(pointer(aIndex),0,n);
    end;
    Quicksort.Compare := @aCompare;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := ElemSize;
    Quicksort.Index := pointer(aIndex);
    Quicksort.QuickSortIndexed(0,n-1);
  end;
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 := CompareMem(@A,@B,ElemSize); // generic comparison
      end else
    case PTypeKind(ElemType)^ of
    tkRecord{$ifdef FPC},tkObject{$endif}:
      result := RecordEquals(A,B,ElemType);
    tkLString:
      result := AnsiString(A)=AnsiString(B);
    tkWString:
      result := WideString(A)=WideString(B);
    {$ifdef UNICODE}
    tkUString:
      result := UnicodeString(A)=UnicodeString(B);
    {$endif}
    {$ifndef NOVARIANTS}
    tkVariant:
      result := Variant(A)=Variant(B);
    {$endif}
    else result := false;
    end;
end;

{$ifndef DELPHI5OROLDER} // do not know why Delphi 5 compiler does not like it
function TDynArray.Equals(const B: TDynArray): boolean;
var i, n: integer;
    P1,P2: PAnsiChar;
    A1: PPointerArray absolute P1;
    A2: PPointerArray absolute P2;
begin
  result := false;
  if ArrayType<>B.ArrayType then
    exit; // array types shall match
  n := Count;
  if n<>B.Count then
    exit;
  P1 := fValue^;
  P2 := B.fValue^;
  if @fCompare<>nil then // if a customized comparison is available, use it
    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
  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;
  tkLString:
    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 UNICODE}
  tkUString:
    for i := 0 to n-1 do
      if UnicodeString(A1^[i])<>UnicodeString(A2^[i]) then
        exit;
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant:
    for i := 0 to n-1 do
      if PVariantArray(P1)^[i]<>PVariantArray(P2)^[i] then
        exit;
  {$endif}
  else exit;
  end;
  result := true;
end;

procedure TDynArray.Copy(const Source: TDynArray);
var n: Cardinal;
begin
  if (fValue=nil) or (Source.fValue=nil) or (ArrayType<>Source.ArrayType) then
    Exit;
  SetCapacity(Source.Capacity);
  n := Source.Count;
  if ElemType=nil then
    move(Source.fValue^^,fValue^^,n*ElemSize) else
    CopyArray(fValue^,Source.fValue^,ElemType,n);
end;

procedure TDynArray.CopyFrom(const Source; MaxElem: integer);
var SourceDynArray: TDynArray;
begin
  SourceDynArray.Init(fTypeInfo,pointer(@Source)^);
  SourceDynArray.fCountP := @MaxElem; // would set Count=0 at Init()
  Copy(SourceDynArray);
end;
{$endif DELPHI5OROLDER}

function TDynArray.IndexOf(const Elem): integer;
var P: pointer;
    max: integer;
begin
  if fValue=nil then begin
    result := -1;
    exit; // avoid GPF if void
  end;
  max := Count-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
         if PIntegerArray(P)^[result]=integer(Elem) then exit;
    8: for result := 0 to max do // Int64,Currency,Double
         if PInt64Array(P)^[result]=Int64(Elem) then exit;
  else // generic binary comparison (fast with our overloaded CompareMem)
    for result := 0 to max do
      if CompareMem(P,@Elem,ElemSize) then
        exit else
        inc(PtrUInt(P),ElemSize);
  end else
  case PTypeKind(ElemType)^ of
  tkLString:
    for result := 0 to max do
      if AnsiString(PPtrIntArray(P)^[result])=AnsiString(Elem) then exit;
  tkWString:
    for result := 0 to max do
      if WideString(PPtrIntArray(P)^[result])=WideString(Elem) then exit;
  {$ifdef UNICODE}
  tkUString:
    for result := 0 to max do
      if UnicodeString(PPtrIntArray(P)^[result])=UnicodeString(Elem) then exit;
  {$endif}
  {$ifndef NOVARIANTS}
  tkVariant:
    for result := 0 to max do
      if PVariantArray(P)^[result]=variant(Elem) 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(PtrUInt(P),ElemSize);
  end;
  result := -1;
end;

procedure TDynArray.Init(aTypeInfo: pointer; var aValue; aCountPointer: PInteger=nil);
var Typ: PDynArrayTypeInfo absolute aTypeInfo;
begin
  fTypeInfo := aTypeInfo;
  fValue := @aValue;
  if Typ^.Kind<>tkDynArray then
    raise ESynException.CreateUTF8('Not a dynamic array: %',[PShortString(@Typ^.NameLen)^]);
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  Typ := GetFPCAlignPtr(Typ);
  {$else}
  inc(PtrUInt(Typ),Typ^.NameLen);
  {$endif}
  with Typ^ do begin
    fElemSize := elSize;
    if elType=nil then
      fElemType := nil else
      {$ifndef FPC}
      fElemType := elType^;
      {$else} begin
      if TTypeKind(PByte(elType)^) in tkManagedTypes then
        fElemType := elType else
        fElemType := nil;
      end;
      {$endif}
  end;
  fSorted := false;
  fCompare := nil;
  fKnownType := djNone;
  fKnownSize := 0;
  fCountP := aCountPointer;
  if fCountP<>nil then
    fCountP^ := 0;
end;

procedure TDynArray.InitSpecific(aTypeInfo: pointer; var aValue; aKind: TDynArrayKind;
      aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
var Comp: TDynArraySortCompare;
begin
  Init(aTypeInfo,aValue,aCountPointer);
  Comp := DYNARRAY_SORTFIRSTFIELD[aCaseInsensitive,aKind];
  if @Comp=nil then
    raise ESynException.CreateUTF8('TDynArray.InitSpecific wrong aKind=%',[ord(aKind)]);
  fCompare := Comp;
  fKnownType := aKind;
  fKnownSize := KNOWNTYPE_SIZE[aKind];
end;

procedure TDynArray.UseExternalCount(var aCountPointer: Integer);
begin
  fCountP := @aCountPointer;
end;

procedure TDynArray.Void;
begin
  fValue := nil;
end;

function TDynArray.IsVoid: boolean;
begin
  result := fValue=nil;
end;

procedure _DynArrayClear(var a: Pointer; typeInfo: Pointer);
{$ifdef FPC}
  [external name 'FPC_DYNARRAY_CLEAR'];
{$else}
asm
{$ifdef CPUX64}
  .NOFRAME
{$endif}
  jmp System.@DynArrayClear
end;
{$endif}

procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: PtrUInt);
{$ifdef FPC}
  [external name 'FPC_FINALIZE_ARRAY'];
{$else}
asm
{$ifdef CPUX64}
  .NOFRAME
{$endif}
  jmp System.@FinalizeArray
end;
{$endif}

function TDynArray.IsObjArray: boolean;
begin
  result := Assigned(DynArrayIsObjArray) and (fElemSize=sizeof(pointer)) and
    (fElemType=nil) and DynArrayIsObjArray(fTypeInfo);
end;

procedure TDynArray.InternalSetLength(NewLength: PtrUInt);
var p: PDynArrayRec;
    pa: PAnsiChar absolute p;
    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 hidden finalize
  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 IsObjArray then
      for i := 0 to Count-1 do
        PObjectArray(fValue^)[i].Free;
    _DynArrayClear(fValue^,ArrayType);
    exit;
  end;
  // retrieve old length
  p := fValue^;
  if p<>nil then begin
    dec(PtrUInt(p),Sizeof(TDynArrayRec)); // p^ = start of heap object
    OldLength := p^.length;
  end else
    OldLength := 0;
  // calculate the needed size of the resulting memory structure on heap
  NeededSize := NewLength*ElemSize+Sizeof(TDynArrayRec);
  if NeededSize>1024*1024*512 then // max allowed memory block is 512MB
    raise ERangeError.CreateFmt('TDynArray SetLength(%s,%d) size concern',
      [PShortString(@PDynArrayTypeInfo(ArrayType).NameLen)^,NewLength]);
  // if not shared (refCnt=1), resize; if shared, create copy (not thread safe)
  if (p=nil) or (p^.refCnt=1) then begin
    if NewLength<OldLength then
      if ElemType<>nil then
        _FinalizeArray(pa+NeededSize,ElemType,OldLength-NewLength) else
        if IsObjArray then
          for i := NewLength to OldLength-1 do
            PObjectArray(fValue^)[i].Free; 
    ReallocMem(p,neededSize);
  end else begin
    InterlockedDecrement(PInteger(@p^.refCnt)^); // FPC has refCnt: PtrInt
    GetMem(p,neededSize);
    minLength := oldLength;
    if minLength>newLength then
      minLength := newLength;
    if ElemType<>nil then begin
      pp := pa+Sizeof(TDynArrayRec);
      FillChar(pp^,minLength*elemSize,0);
      CopyArray(pp,fValue^,ElemType,minLength)
    end else
      Move(fValue^,pa[Sizeof(TDynArrayRec)],minLength*elemSize);
  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(PtrUInt(p),Sizeof(p^));
  // reset new allocated elements content to zero 
  OldLength := OldLength*elemSize;
  FillChar(pa[OldLength],neededSize-OldLength-Sizeof(TDynArrayRec),0);
  fValue^ := p;
end;

procedure TDynArray.SetCount(aCount: integer);
const MINIMUM_SIZE = 64;
var capa, delta: integer;
begin
  fSorted := false;
  if fValue=nil then
    exit; // avoid GPF if void
  if fCountP<>nil then begin
    delta := aCount-fCountP^;
    if delta=0 then
      exit;
    fCountP^ := aCount;
    if PtrInt(fValue^)=0 then begin
      // no capa yet
      if (delta>0) and (aCount<MINIMUM_SIZE) then
        aCount := MINIMUM_SIZE; // reserve some minimal space for Add()
    end else begin
      capa := DynArrayLength(fValue^);
      if delta>0 then begin
        // size-up -> grow by chunks
        if capa>=fCountP^ then
          exit; // no need to grow
        inc(capa,capa shr 2);
        if capa<fCountP^ then
          aCount := fCountP^ else
          aCount := capa;
      end else
      if aCount>0 then // aCount=0 should release memory (e.g. for TDynArray.Clear)
        // 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 (PtrInt(fValue^)<>0) then
    result := DynArrayLength(fValue^) 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: Cardinal; aFirstIndex: cardinal=0);
var n: Cardinal;
    D: PPointer;
    P: PAnsiChar;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  n := Count;
  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
      move(P^,D^^,aCount*ElemSize) else
      CopyArray(D^,P,ArrayType,aCount);
  end;
end;

procedure TDynArray.AddArray(const DynArray; aStartIndex: integer=0; aCount: integer=-1);
var DynArrayCount, n: integer;
    D: PPointer;
    PS,PD: pointer;
begin
  if fValue=nil then
    exit; // avoid GPF if void
  D := @DynArray;
  if D^=nil then  // inline GetCount
    DynArrayCount := 0 else
    DynArrayCount := DynArrayLength(D^);
  if aStartIndex>=DynArrayCount then
    exit; // nothing to copy
  if (aCount<0) or (cardinal(aStartIndex+aCount)>cardinal(DynArrayCount)) then
    aCount := DynArrayCount-aStartIndex;
  if aCount<=0 then
    exit;
  n := Count;
  SetCount(n+aCount);
  PS := pointer(PtrUInt(D^)+cardinal(aStartIndex)*ElemSize);
  PD := pointer(PtrUInt(fValue^)+cardinal(n)*ElemSize);
  if ElemType=nil then
    move(PS^,PD^,cardinal(aCount)*ElemSize) else
    CopyArray(PD,PS,ArrayType,aCount);
end;

procedure TDynArray.ElemClear(var Elem);
begin
  if ElemType<>nil then
    case PTypeKind(ElemType)^ of // release reference counted
      tkLString:
        RawByteString(Elem) := '';
      tkWString:
        WideString(Elem) := '';
      {$ifdef UNICODE}tkUString: UnicodeString(Elem) := ''; {$endif}
      tkRecord{$ifdef FPC},tkObject{$endif}:
        RecordClear(Elem,ElemType);
      {$ifndef NOVARIANTS}
      tkVariant:
        VarClear(Variant(Elem));
      {$endif}
      else exit; 
    end;
  fillchar(Elem,ElemSize,0); // always fill with zero binary content
end;

procedure TDynArray.ElemCopy(const A; var B);
begin
  if ElemType=nil then
    move(A,B,ElemSize) else begin
    {$ifdef FPC}
    RecordClear(B,ElemType); // inlined CopyArray()
    move(A,B,RTTIManagedSize(ElemType));
    RecordAddRef(B,ElemType);
    {$else}
    CopyArray(@B,@A,ElemType,1);
    {$endif}
  end;
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);
    FillChar(pointer(result)^,ElemSize,0);
    ElemLoad(Source,pointer(result)^);
  end;
end;

procedure TDynArray.ElemLoad(Source: PAnsiChar; var Elem);
begin
  if Source=nil then
    exit; // avoid GPF
  if ElemType=nil then
    move(Source^,Elem,ElemSize) else
    case PTypeKind(ElemType)^ of
    tkLString: begin
      SetString(RawByteString(Elem),Source+4,PInteger(Source)^);
      {$ifdef UNICODE}
      { Delphi 2009+: set Code page for this AnsiString }
      if PPtrUInt(@Elem)^<>0 then
        PWord(PPtrUInt(@Elem)^-12)^ := PWord(PtrUInt(ElemType)+
          PDynArrayTypeInfo(ElemType)^.NameLen+2)^;
      {$endif}
    end;
    tkWString: // WideString internal length is in bytes
      SetString(WideString(Elem),PWideChar(Source+4),PInteger(Source)^ shr 1);
    {$ifdef UNICODE}
    tkUString:
      SetString(UnicodeString(Elem),PWideChar(Source+4),PInteger(Source)^);
    {$endif}
    {$ifndef NOVARIANTS}
    tkVariant:
      VariantLoad(variant(Elem),Source);
    {$endif}
    tkRecord{$ifdef FPC},tkObject{$endif}:
      RecordLoad(Elem,Source,ElemType);
    end;
end;

procedure TDynArray.ElemLoadClear(var ElemLoaded: RawByteString);
begin
  if (ElemType<>nil) and (length(ElemLoaded)=integer(ElemSize)) then
  case PTypeKind(ElemType)^ of
    tkLString:
      PRawByteString(pointer(ElemLoaded))^ := '';
    tkWString:
      PWideString(pointer(ElemLoaded))^ := '';
    {$ifdef UNICODE}
    tkUString:
      PUnicodeString(pointer(ElemLoaded))^ := '';
    {$endif}
    {$ifndef NOVARIANTS}
    tkVariant:
      VarClear(PVariant(pointer(ElemLoaded))^);
    {$endif}
    tkRecord{$ifdef FPC},tkObject{$endif}:
      RecordClear(pointer(ElemLoaded)^,ElemType);
  end;
  ElemLoaded := '';
end;

function TDynArray.ElemSave(const Elem): RawByteString;
begin
  if ElemType=nil then
    SetString(result,PAnsiChar(@Elem),ElemSize) else
    case PTypeKind(ElemType)^ of
      tkLString, tkWString: // WideString internal length is in bytes
        if PPtrInt(@Elem)^=0 then
          SetString(result,PAnsiChar(@Elem),4) else
          SetString(result,PAnsiChar(PPtrInt(@Elem)^-sizeof(integer)),
            PInteger(PPtrInt(@Elem)^-sizeof(integer))^+sizeof(integer));
      {$ifdef UNICODE}
      tkUString:
        if PPtrInt(@Elem)^=0 then
          SetString(result,PAnsiChar(@Elem),4) else
          SetString(result,PAnsiChar(PPtrInt(@Elem)^-sizeof(integer)),
            PInteger(PPtrInt(@Elem)^-sizeof(integer))^*2+sizeof(integer));
      {$endif}
      {$ifndef NOVARIANTS}
      tkVariant:
        result := VariantSave(variant(Elem));
      {$endif}
      tkRecord{$ifdef FPC},tkObject{$endif}:
        result := RecordSave(Elem,ElemType);
      else result := '';
    end;
end;

function TDynArray.ElemLoadFind(Source: PAnsiChar): integer;
var tmp: RawByteString;
begin
  tmp := ElemLoad(Source);
  if tmp='' then
    result := -1 else
    try
      if @fCompare=nil then
        result := IndexOf(pointer(tmp)^) else
        result := Find(pointer(tmp)^);
    finally
      ElemLoadClear(tmp);
    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;

{$ifdef UNDIRECTDYNARRAY}
function TDynArrayHashed.Count: Integer;
begin
  result := InternalDynArray.Count;
end;

procedure TDynArrayHashed.SetCount(aCount: Integer);
begin
  InternalDynArray.Count := aCount;
end;

function TDynArrayHashed.GetCapacity: Integer;
begin
  result := InternalDynArray.Capacity;
end;

procedure TDynArrayHashed.SetCapacity(aCapacity: Integer);
begin
  InternalDynArray.SetCapacity(aCapacity);
end;

function TDynArrayHashed.fValue: PPointer;
begin
  result := InternalDynArray.fValue;
end;

function TDynArrayHashed.ElemSize: PtrUInt;
begin
  result := InternalDynArray.ElemSize;
end;

function TDynArrayHashed.ElemType: Pointer;
begin
  result := InternalDynArray.ElemType;
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: Integer);
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.Find(const Elem): integer;
begin
  result := InternalDynArray.Find(Elem);
end;
{$endif}

function TDynArrayHashed.FindHashed(const Elem): integer;
begin
  if fHashs=nil then
    result := -1 else begin
    result := HashFind(HashOneFromTypeInfo(Elem),Elem);
    if result<0 then
      result := -1; // for coherency with most methods
  end;
end;

procedure TDynArrayHashed.HashAdd(const Elem; aHashCode: Cardinal; var result: integer);
var n: integer;
begin
  n := Count;
  SetCount(n+1); // reserve space for a void element in array
  if Capacity+1>=length(fHashs) then begin
    // fHashs[] is too small -> recreate
    ReHash;
    result := HashFind(aHashCode,Elem); // 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;
begin
  if aHashCode=0 then
    aHashCode := HashOneFromTypeInfo(Elem);
  if aHashCode=HASH_VOID then
    aHashCode := HASH_ONVOIDCOLISION; // as in HashFind() -> for HashAdd() below
  result := HashFind(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;
  assert(ndx=Count-1);
  result := PAnsiChar(fValue^)+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
    assert(ndx=Count-1);
    result := PAnsiChar(fValue^)+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 Elem): integer;
var P: PAnsiChar;
begin
  result := HashFind(HashOneFromTypeInfo(Elem),Elem);
  if result<0 then
    result := -1 else begin
    // copy from dynamic array found entry into Elem = Fill
    P := PAnsiChar(fValue^)+cardinal(result)*ElemSize;
    if ElemType=nil then
      move(P^,Elem,ElemSize) else
      CopyArray(@Elem,P,ElemType,1);
  end;
end;

function TDynArrayHashed.FindHashedAndUpdate(var Elem; AddIfNotExisting: boolean): integer;
var P: PAnsiChar;
    aHashCode: cardinal;
begin
  aHashCode := HashOneFromTypeInfo(Elem);
  if aHashCode=HASH_VOID then
    aHashCode := HASH_ONVOIDCOLISION; // as in HashFind() -> for HashAdd() below
  result := HashFind(aHashCode,Elem);
  if result<0 then
    if AddIfNotExisting then begin
      // not existing -> add as new element
      HashAdd(Elem,aHashCode,result); // ReHash only if necessary
      P := PAnsiChar(fValue^)+cardinal(result)*ElemSize;
      if ElemType=nil then
        move(Elem,P^,ElemSize) else
        CopyArray(P,@Elem,ElemType,1);
    end else
      result := -1 else begin
    // copy from Elem into dynamic array found entry = Update
    P := PAnsiChar(fValue^)+cardinal(result)*ElemSize;
    if ElemType=nil then
      move(Elem,P^,ElemSize) else
      CopyArray(P,@Elem,ElemType,1);
    ReHash;
  end;
end;

function TDynArrayHashed.FindHashedAndDelete(var Elem): integer;
begin
  result := HashFind(HashOneFromTypeInfo(Elem),Elem);
  if result<0 then
    result := -1 else begin
    Delete(result);
    ReHash;
  end;
end;

function HashAnsiString(const Elem; Hasher: THasher): cardinal;
begin
  if PtrUInt(Elem)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-sizeof(integer))^);
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,UpperCopy255(tmp,RawUTF8(Elem))-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(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-sizeof(integer))^*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(PtrUInt(Elem)),
      PInteger(PtrUInt(Elem)-sizeof(integer))^{$ifdef UNICODE}*sizeof(WideChar){$endif});
      // WideString internal size is in bytes, UnicodeString is in WideChars
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(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-sizeof(integer))^);
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 := Byte(Elem);
end;

function HashWord(const Elem; Hasher: THasher): cardinal;
begin
  result := Word(Elem);
end;

function HashInteger(const Elem; Hasher: THasher): cardinal;
begin
  result := Integer(Elem);
end;

function HashCardinal(const Elem; Hasher: THasher): cardinal;
begin
  result := Cardinal(Elem);
end;

function HashInt64(const Elem; Hasher: THasher): cardinal;
begin
  result := Hasher(0,@Elem,sizeof(Int64)); // better than Int64Rec.(Lo xor Hi)
end;

{$ifndef NOVARIANTS}

function HashVariant(const Elem; Hasher: THasher): cardinal;
var U: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(variant(Elem),U,wasString);
  if PtrUInt(U)=0 then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,Pointer(PtrUInt(U)),PInteger(PtrUInt(U)-sizeof(integer))^);
end;

function HashVariantI(const Elem; Hasher: THasher): cardinal;
var U: RawUTF8;
    wasString: boolean;
begin
  VariantToUTF8(variant(Elem),U,wasString);
  if pointer(U)=nil then
    result := HASH_ONVOIDCOLISION else
    result := Hasher(0,pointer(U),UpperCopy(pointer(U),U)-pointer(U));
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.Create('TDynArrayHashed.InitSpecific wrong 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=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil; aCaseInsensitive: boolean=false);
var aKind: TDynArrayKind;
begin
  {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$else}inherited{$endif}
    Init(aTypeInfo,aValue,aCountPointer);
  fEventCompare := 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;
  fHashs := nil;
end;

procedure TDynArrayHashed.HashInit;
var cap, PO2: integer;
begin
  fHashs := nil; // any previous hash is invalid
  // find nearest power of two for new fHashs[] size
  cap := Capacity+Capacity shr 3+64; // Capacity is faster than Count
  PO2 := 256;       
  while PO2<cap do
    PO2 := PO2 shl 1;
  SetLength(fHashs,PO2); // fill all fHashs[]=HASH_VOID
end;

//var TDynArrayHashedCollisionCount: cardinal;

function TDynArrayHashed.HashFind(aHashCode: cardinal; const Elem): integer;
var n, first: integer;
    looped: boolean;
begin
  looped := false;
  if fHashs=nil then
    HashInit;
  n := length(fHashs);
  if aHashCode=HASH_VOID then
    aHashCode := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
  result := (aHashCode-1) and (n-1); // fHashs[] has a power of 2 length
  first := result;
  repeat
    with fHashs[result] do
    if Hash=aHashCode then
      if not Assigned(fEventCompare) then
        if @{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare<>nil then begin
          if {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare(PAnsiChar(fValue^)[Index*ElemSize],Elem)=0 then begin
            result := Index;
            exit; // found -> returns index in dynamic array
          end;
        end else begin
        if {$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}ElemEquals(PAnsiChar(fValue^)[Index*ElemSize],Elem) then begin
          result := Index;
          exit; // found -> returns index in dynamic array
        end;
      end else begin
        if fEventCompare(PAnsiChar(fValue^)[Index*ElemSize],Elem)=0 then begin
          result := Index;
          exit; // found -> returns index in dynamic array
        end;
      end else
    if Hash=HASH_VOID then begin
      result := -(result+1);
      exit; // not found -> returns void index in fHashs[] as negative
    end;
    // hash collision -> search next item
//    inc(TDynArrayHashedCollisionCount);
    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.Create('HashFind fatal collision'); // should never be here
end;

function TDynArrayHashed.GetHashFromIndex(aIndex: Integer): Cardinal;
var P: pointer;
begin
  if cardinal(aIndex)>=cardinal(Count) then
    result := 0 else begin
    // it's faster to rehash than to loop in fHashs[].Index values
    P := PAnsiChar(fValue^)+cardinal(aIndex)*ElemSize;
    result := HashOneFromTypeInfo(P^);
    if result=HASH_VOID then
      result := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
  end;
end;

function TDynArrayHashed.HashOneFromTypeInfo(const Elem): cardinal;
var Kind: TDynArrayKind;
begin
  if @fHashElement<>nil then
    result := fHashElement(Elem,fHasher) else
  {$ifdef UNDIRECTDYNARRAY}with InternalDynArray do{$endif} begin
    Kind := ToKnownType;
    if Assigned(DYNARRAY_HASHFIRSTFIELD[false,Kind]) then
      result := DYNARRAY_HASHFIRSTFIELD[false,Kind](Elem,fHasher) else
      if fKnownSize=0 then
        result := HASH_ONVOIDCOLISION else
        result := fHasher(0,@Elem,fKnownSize);
  end;
end;

procedure TDynArrayHashed.ReHash(aHasher: TOnDynArrayHashOne=nil);
var i, n, ndx: integer;
    P: PAnsiChar;
    aHashCode: cardinal;
begin
  HashInit;
  n := Count;
  if n>0 then begin // avoid GPF after TDynArray.Clear call (Count=0)
    P := fValue^;
    for i := 0 to n-1 do begin
      if @aHasher=nil then
        aHashCode := HashOneFromTypeInfo(P^) else
        aHashCode := aHasher(P^);
      if aHashCode=HASH_VOID then
        aHashCode := HASH_ONVOIDCOLISION; // 0 means void slot in the loop below
      ndx := HashFind(aHashCode,P^);
      if ndx<0 then
        // >=0 -> already found -> not necessary to add duplicated hash
        with fHashs[-ndx-1] do begin
          Hash := aHashCode;
          Index := i;
        end;
      inc(P,ElemSize);
    end;
  end;
end;


{ TObjectDynArrayWrapper }

constructor TObjectDynArrayWrapper.Create(var aValue);
begin
  fValue := @aValue;
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 begin
    if cap<256 then
      inc(cap,64) else
      inc(cap,256+cap shr 3);
    SetLength(TObjectDynArray(fValue^),cap);
  end;
  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
  TObjectDynArray(fValue^)[Index].Free;
  dec(fCount);
  if fCount>Index then
    move(TObjectDynArray(fValue^)[Index+1],TObjectDynArray(fValue^)[Index],
      (fCount-Index)*sizeof(pointer));
end;

procedure TObjectDynArrayWrapper.Clear;
var i: integer;
begin
  if fValue^<>nil then begin
    for i := fCount-1 downto 0 do
    try
      TObjectDynArray(fValue^)[i].Free;
    except
      on Exception do;
    end;
    Finalize(TObjectDynArray(fValue^)); // 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;

function TObjectDynArrayWrapper.Count: integer;
begin
  result := fCount;
end;

function TObjectDynArrayWrapper.Capacity: integer;
begin
  result := length(TObjectDynArray(fValue^));
end;

procedure TObjectDynArrayWrapper.Sort(Compare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
begin
  if (@Compare<>nil) and (fCount>0) then begin
    Quicksort.Compare := @Compare;
    Quicksort.Value := fValue^;
    Quicksort.ElemSize := sizeof(pointer);
    Quicksort.QuickSort(0,fCount-1);
  end;
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;


{ wrapper functions to T*ObjArr types }

function ObjArrayAdd(var aObjArray; aItem: TObject): integer;
var a: TObjectDynArray absolute aObjArray;
begin
  result := length(a);
  SetLength(a,result+1);
  a[result] := aItem;
end;

function ObjArrayAddOnce(var aObjArray; aItem: TObject): integer;
begin
  result := ObjArrayFind(aObjArray,aItem);
  if result<0 then
    result := ObjArrayAdd(aObjArray,aItem);
end;

procedure ObjArraySetLength(var aObjArray; aLength: integer);
begin
  SetLength(TObjectDynArray(aObjArray),aLength);
end;

function ObjArrayFind(var aObjArray; aItem: TObject): integer;
begin
  for result := 0 to length(TObjectDynArray(aObjArray))-1 do
    if TObjectDynArray(aObjArray)[result]=aItem then
      exit;
  result := -1;
end;

procedure ObjArrayDelete(var aObjArray; aItemIndex: integer); 
var n: integer;
    a: TObjectDynArray absolute aObjArray;
begin
  n := length(a);
  if cardinal(aItemIndex)>=cardinal(n) then
    exit; // out of range
  a[aItemIndex].Free;
  dec(n);
  if n>aItemIndex then
    Move(a[aItemIndex+1],a[aItemIndex],(n-aItemIndex)*sizeof(TObject));
  SetLength(a,n);
end;

function ObjArrayDelete(var aObjArray; aItem: TObject): integer; 
begin
  result := ObjArrayFind(aObjArray,aItem);
  if result>=0 then
    ObjArrayDelete(aObjArray,result);
end;

procedure ObjArraySort(var aObjArray; Compare: TDynArraySortCompare);
var QuickSort: TDynArrayQuickSort;
    n: integer;
begin
  n := length(TObjectDynArray(aObjArray));
  if (@Compare<>nil) and (n>0) then begin
    Quicksort.Compare := @Compare;
    Quicksort.Value := pointer(aObjArray);
    Quicksort.ElemSize := sizeof(pointer);
    Quicksort.QuickSort(0,n-1);
  end;
end;

procedure ObjArrayClear(var aObjArray);
var i: integer;
    a: TObjectDynArray absolute aObjArray;
begin
  if a<>nil then begin
    for i := 0 to length(a)-1 do
      a[i].Free;
    a := nil;
  end;
end;

procedure ObjArrayObjArrayClear(var aObjArray);
var i: integer;
    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;


{ TObjectHash }

const
  COUNT_TO_START_HASHING = 32;

function TObjectHash.Find(Item: TObject): integer;
var n: integer;
begin
  n := Count;
  if n<=COUNT_TO_START_HASHING then begin
    for result := 0 to n-1 do // loop comparison if not worth it
      if Compare(Get(result),Item) then
        exit;
    result := -1;
    exit;
  end;
  result := HashFind(Hash(Item),Item);
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 n,PO2,i,ndx: integer;
    H: cardinal;
    O: TObject;
begin
  assert(fHashs=nil);
  // find nearest power of two for new fHashs[] size
  n := aCountToHash+64+aCountToHash shr 3; // create some void entries (for speed)
  PO2 := 256;
  while PO2<n 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',[self]);
    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.JustAdded: boolean;
var H: cardinal;
    n,ndx: integer;
    O: TObject;
begin
  n := Count-1;
  O := Get(n);
  if O=nil then
    raise ESynException.CreateUTF8('Invalid %.JustAdded call',[self]);
  if n<COUNT_TO_START_HASHING then begin
    result := false;
    for ndx := 0 to n-1 do // loop comparison if not worth it
      if Compare(Get(ndx),O) then
        exit;
    result := true;
    exit;
  end;
  if n+32+n shr 3>length(fHashs) then begin
    fHashs := nil;
    HashInit(n); // re-compute fHashs up to Count-1 if not enough void positions
  end;
  H := Hash(O);
  ndx := HashFind(H,O);
  if ndx>=0 then begin
    result := true; // duplicate found
    exit;
  end;
  with fHashs[-ndx-1] do begin
    Hash := H;
    Index := n;
  end;
  result := true;
end;


{ TInterfacedObjectWithCustomCreate }

constructor TInterfacedObjectWithCustomCreate.Create;
begin // nothing to do by default - overridden constructor may add custom code
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;


{ ****************** text buffer and JSON functions and classes ********* }

{ TTextWriter }

procedure TTextWriter.Add(Value: PtrInt);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if B+16>=BEnd then
    FlushToStream;
  P := StrInt32(@tmp[23],value);
  Len := @tmp[23]-P;
  move(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: integer;
begin
  if B+31>=BEnd 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);
  move(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 B+31>=BEnd then
    FlushToStream;
  inc(B,PTimeLogBits(Value)^.Text(B+1,true,'T'));
end;

procedure TTextWriter.AddDateTime(Value: PDateTime; FirstChar: AnsiChar; QuoteChar: AnsiChar);
begin
  if (Value^=0) and (QuoteChar=#0) then
    exit;
  if B+21>=BEnd 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);
      inc(B,9);
    end;
    dec(B);
  end;
  if QuoteChar<>#0 then begin
    inc(B);
    B^ := QuoteChar;
  end;
end;

procedure TTextWriter.AddDateTime(const Value: TDateTime);
begin
  if Value=0 then
    exit;
  if B+19>=BEnd 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');
    inc(B,9);
  end;
  dec(B);
end;

procedure TTextWriter.AddU(Value: cardinal);
var tmp: array[0..15] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if B+16>=BEnd then
    FlushToStream;
  P := StrUInt32(@tmp[15],Value);
  Len := @tmp[15]-P;
  move(P[0],B[1],Len);
  inc(B,Len);
end;

procedure TTextWriter.Add(Value: Extended; precision: integer);
var S: ShortString;
begin
  if Value=0 then
    Add('0') else
    AddNoJSONEscape(@S[1],ExtendedToString(S,Value,precision));
end;

procedure TTextWriter.AddDouble(Value: double);
var S: ShortString;
begin
  if Value=0 then
    Add('0') else
    AddNoJSONEscape(@S[1],ExtendedToString(S,Value,DOUBLE_PRECISION));
end;

procedure TTextWriter.AddSingle(Value: single);
var S: ShortString;
begin
  if Value=0 then
    Add('0') else
    AddNoJSONEscape(@S[1],ExtendedToString(S,Value,SINGLE_PRECISION));
end;

{$ifndef CPU64}
procedure TTextWriter.Add(Value: Int64);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if B+24>=BEnd then
    FlushToStream;
  P := StrInt64(@tmp[23],Value);
  Len := @tmp[23]-P;
  move(P[0],B[1],Len);
  inc(B,Len);
end;
{$endif}

procedure TTextWriter.AddFloatStr(P: PUTF8Char);
var L: cardinal;
begin
  L := StrLen(P);
  if (L=0) or (L>30) then
    Add('0') else begin
    if B+31>=BEnd 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;
    move(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 B+1>=BEnd then
    FlushToStream;
  B[1] := c1;
  B[2] := c2;
  inc(B,2);
end;

procedure TTextWriter.Add(const guid: TGUID);
begin
  if B+36>=BEnd then
    FlushToStream;
  GUIDToText(B+1,@guid);
  inc(B,36);
end;

procedure TTextWriter.AddCR;
begin
  if B+1>=BEnd 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 B+1>=BEnd then
    FlushToStream;
  if fEndOfLineCRLF then begin
    pWord(B+1)^ := 13+10 shl 8; // CR + LF
    inc(B,2);
  end else begin
    B[1] := #13; // CR
    inc(B);
  end;
  if fEchos<>nil then begin
    fEchoStart := EchoFlush;
    for i := 0 to length(fEchos)-1 do
      fEchos[i](self,aLevel,fEchoBuf);
    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 B+ntabs+1>=BEnd then
    FlushToStream;
  pWord(B+1)^ := 13+10 shl 8; // CR + LF
  fillchar(B[3],ntabs,9); // indentation using tabs
  inc(B,ntabs+2);
end;

procedure TTextWriter.AddChars(aChar: AnsiChar; aCount: integer);
begin
  if cardinal(aCount-1)>=cardinal(fTempBufSize) then
    exit; // avoid buffer overflow
  if B+aCount>=BEnd then
    FlushToStream;
  fillchar(B[1],aCount,ord(aChar));
  inc(B,aCount);
end;

procedure TTextWriter.Add2(Value: integer);
begin
  if B+3>=BEnd 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 B+5>=BEnd then
    FlushToStream;
  if cardinal(Value)>9999 then
    pCardinal(B+1)^ := $30303030 else // '0000,' if overflow
    YearToPChar(Value,B+1);
  inc(B,5);
  B^ := ',';
end;

var // can be safely made global since timing is multi-thread safe
  GlobalTime: TSystemTime;
  GlobalClock: cardinal;

procedure TTextWriter.AddCurrentLogTime;
var Ticks: cardinal;
begin
  if B+17>=BEnd then
    FlushToStream;
  inc(B);
  Ticks := GetTickCount; // this call is very fast (just one integer mul)
  if GlobalClock<>Ticks then begin // typically in range of 10-16 ms
    GlobalClock := Ticks;
    GetLocalTime(GlobalTime); // avoid slower API call
  end;
  YearToPChar({$ifdef MSWINDOWS}GlobalTime.wYear{$else}GlobalTime.Year{$endif},B);
  with GlobalTime do begin
    PWord(B+4)^ := TwoDigitLookupW[{$ifdef MSWINDOWS}wMonth{$else}Month{$endif}];
    PWord(B+6)^ := TwoDigitLookupW[{$ifdef MSWINDOWS}wDay{$else}Day{$endif}];
    B[8] := ' ';
    PWord(B+9)^ := TwoDigitLookupW[{$ifdef MSWINDOWS}wHour{$else}Hour{$endif}];
    PWord(B+11)^ := TwoDigitLookupW[{$ifdef MSWINDOWS}wMinute{$else}Minute{$endif}];
    PWord(B+13)^ := TwoDigitLookupW[{$ifdef MSWINDOWS}wSecond{$else}Second{$endif}];
    PWord(B+15)^ := TwoDigitLookupW[{$ifdef MSWINDOWS}wMilliseconds shr 4{$else}Millisecond shr 4{$endif}]; // range 0..62 = 16 ms
    B[17] := ' ';
  end;
  inc(B,16);
end;

procedure TTextWriter.AddMicroSec(MS: cardinal);
function Value3Digits(V: Cardinal; P: PUTF8Char): Cardinal;
begin
  PWord(P+1)^ := TwoDigitLookupW[V mod 100];
  P^ := AnsiChar((V div 100)mod 10+48);
  result := V div 1000;
end;
begin // 00.000.000
  if B+17>=BEnd then
    FlushToStream;
  B[3] := '.';
  B[7] := '.';
  inc(B);
  MS := Value3Digits(Value3Digits(MS,B+7),B+3);
  if MS>100 then
    MS := 99;
  PWord(B)^:= TwoDigitLookupW[MS];
  inc(B,9);
end;

procedure TTextWriter.Add3(Value: integer);
begin
  if B+4>=BEnd 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;

procedure TTextWriter.WriteObjectAsString(Value: TObject;
  Options: TTextWriterWriteObjectOptions);
begin
  Add('"');
  if fInternalJSONWriter=nil then
    fInternalJSONWriter := DefaultTextWriterJSONClass.CreateOwnedStream else
    fInternalJSONWriter.CancelAll;
  fInternalJSONWriter.WriteObject(Value,Options);
  AddJSONEscape(Pointer(fInternalJSONWriter.Text),0);
  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;

class function TTextWriter.RegisterCustomJSONSerializerFromText(aTypeInfo: pointer;
  const aRTTIDefinition: RawUTF8): TJSONRecordAbstract;
begin
  result := GlobalJSONCustomParsers.RegisterFromText(aTypeInfo,aRTTIDefinition);
end;

class function TTextWriter.RegisterCustomJSONSerializerSetOptions(aTypeInfo: pointer;
  aOptions: TJSONCustomParserSerializationOptions; aAddIfNotExisting: boolean): boolean;
var ndx: integer;
begin
  result := false;
  if aTypeInfo=nil then
    exit;
  case PFieldTable(aTypeInfo)^.kind 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.RegisterCustomJSONSerializerFindParser(
  aTypeInfo: pointer; aAddIfNotExisting: boolean=false): TJSONRecordAbstract;
var ndx: integer;
begin
  result := nil;
  if aTypeInfo=nil then
    exit;
  case PFieldTable(aTypeInfo)^.kind 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; aTypeName: RawUTF8='');
begin
  if aTypeName='' then
    TypeInfoToName(aTypeInfo,aTypeName);
  GlobalCustomJSONSerializerFromTextSimpleType.AddObjectIfNotExisting(aTypeName,aTypeInfo);
end;

procedure TTextWriter.AddRecordJSON(const Rec; TypeInfo: pointer);
var customWriter: TDynArrayJSONCustomWriter;
begin
  if (self=nil) or (@Rec=nil) or (TypeInfo=nil) or
     not(PDynArrayTypeInfo(TypeInfo)^.kind 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;
    typ: PDynArrayTypeInfo;
begin
  typ := TypeInfo;
  if (self=nil) or (typ=nil) or not(typ^.kind in tkRecordTypes) then
    raise ESynException.CreateUTF8('Invalid %.AddVoidRecordJSON(%)',[self,TypeInfo]);
  {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  typ := GetFPCAlignPtr(typ);
  {$else}
  inc(PtrUInt(typ),typ^.NameLen);
  {$endif}
  SetLength(tmp,typ^.elSize);
  AddRecordJSON(tmp[0],TypeInfo);
end;

{$ifndef NOVARIANTS}
procedure TTextWriter.AddVariantJSON(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:   Add(VInt64);
  varSingle:   AddSingle(VSingle);
  varDouble:   AddDouble(VDouble);
  varDate:     AddDateTime(@VDate,'T','"');
  varCurrency: AddCurr64(VInt64);
  varBoolean:  AddString(JSON_BOOLEAN[VBoolean]);
  varVariant:  AddVariantJSON(PVariant(VPointer)^,Escape);
  varString: begin
    Add('"');
    {$ifdef UNICODE}
    AddAnyAnsiString(RawByteString(VString),twJSONEscape);
    {$else}
    AddJSONEscape(VString); // VString is expected to be a RawUTF8
    {$endif}
    Add('"');
  end;
  varOleStr {$ifdef HASVARUSTRING}, varUString{$endif}: begin
    Add('"');
    AddW(VAny,0,Escape);
    Add('"');
  end;
  else
  if VType=varVariant or varByRef then
    AddVariantJSON(PVariant(VPointer)^,Escape) else
  if VType=varByRef or varString then begin
    Add('"');
    {$ifdef UNICODE}
    AddAnyAnsiString(PRawByteString(VAny)^,twJSONEscape);
    {$else}
    AddJSONEscape(PPointer(VAny)^); // VString is expected to be a RawUTF8
    {$endif}
    Add('"');
  end else
  if {$ifdef HASVARUSTRING}(VType=varByRef or varUString) or {$endif}
     (VType=varByRef or varOleStr) then begin
    Add('"');
    AddW(PPointer(VAny)^,0,Escape);
    Add('"');
  end else
  if FindCustomVariantType(VType,CustomVariantType) and
     CustomVariantType.InheritsFrom(TSynInvokeableVariantType) then
    TSynInvokeableVariantType(CustomVariantType).ToJson(self,Value,Escape) else
    raise ESynException.CreateUTF8('%.AddVariantJSON(VType=%)',[self,VType]);
  end;
end;
{$endif NOVARIANTS}

procedure TTextWriter.AddDynArrayJSON(aTypeInfo: pointer; var aValue);
var DynArray: TDynArray;
begin
  DynArray.Init(aTypeInfo,aValue);
  AddDynArrayJSON(DynArray);
end;

procedure TTextWriter.AddDynArrayJSONAsString(aTypeInfo: pointer; var aValue);
begin
  Add('"');
  if fInternalJSONWriter=nil then
    fInternalJSONWriter := DefaultTextWriterJSONClass.CreateOwnedStream else
    fInternalJSONWriter.CancelAll;
  fInternalJSONWriter.AddDynArrayJSON(aTypeInfo,aValue);
  AddJSONEscape(Pointer(fInternalJSONWriter.Text),0);
  Add('"');
end;

procedure TTextWriter.AddTypedJSON(aTypeInfo: pointer; const aValue);
begin
  case PTypeKind(aTypeInfo)^ of
    tkClass:
      WriteObject(TObject(aValue),[woFullExpand]);
    tkEnumeration: begin
      Add('"');
      AddShort(GetEnumName(aTypeInfo,byte(aValue))^);
      Add('"');
    end;
    tkRecord{$ifdef FPC},tkObject{$endif}:
      AddRecordJSON(aValue,aTypeInfo);
    tkDynArray:
      AddDynArrayJSON(DynArray(aTypeInfo,(@aValue)^));
{$ifndef NOVARIANTS}
    tkVariant:
      AddVariantJSON(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;
    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 Format<>jsonCompact then
        AddCRAndIndent;
      inc(fHumanReadableLevel);
      Add('[');
      repeat
        if JSON=nil then
          exit;
        if Format<>jsonCompact then
          AddCRAndIndent;
        JSON := AddJSONReformat(JSON,Format,@objEnd);
        if objEnd=']' then
          break;
        Add(objEnd);
      until false;
      dec(fHumanReadableLevel);
      if Format<>jsonCompact then
        AddCRAndIndent;
    end;
    Add(']');
  end;
  '{': begin // object
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    Add('{');
    inc(fHumanReadableLevel);
    if Format<>jsonCompact then
      AddCRAndIndent;
    if JSON^='}' then
      repeat inc(JSON) until not(JSON^ in [#1..' ']) else
    repeat
      Name := GetJSONPropName(JSON);
      if Name=nil then
        exit;
      if (Format=jsonUnquotedPropName) and PropNameValid(Name) then
        AddNoJSONEscape(Name) else begin
        Add('"');
        AddJSONEscape(Name);
        Add('"');
      end;
      if Format=jsonCompact 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 Format<>jsonCompact then
        AddCRAndIndent;
    until false;
    dec(fHumanReadableLevel);
    if Format<>jsonCompact 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); // let wasString=nil
    if Value=nil then
      AddShort('null') else begin
      ValueLen := StrLen(Value);
      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: 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
      AddXmlEscape(Value);
    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(const aDynArray: TDynArray);
var i, n, Len: integer;
    P: Pointer;
    T: TDynArrayKind;
    tmp: RawByteString;
    customWriter: TDynArrayJSONCustomWriter;
    customParser: TJSONRecordAbstract;
    Options: TJSONCustomParserSerializationOptions;
    NestedDynArray: TDynArray;
begin // code below must match TDynArray.LoadFromJSON
  n := aDynArray.Count-1;
  if n<0 then begin
    Add('[',']');
    exit;
  end;
  if GlobalJSONCustomParsers.DynArraySearch(
      aDynArray.ArrayType,aDynArray.ElemType,customWriter,@customParser) then
    T := djCustom else
    T := aDynArray.ToKnownType;
  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
        NestedDynArray.Init(aDynArray.ElemType,P^);
        AddDynArrayJSON(NestedDynArray);
        Add(',');
        inc(PtrUInt(P),aDynArray.ElemSize);
      end;
    end else begin
      tmp := aDynArray.SaveTo;
      WrBase64(pointer(tmp),length(tmp),true); // magic=true
    end;
  djCustom: begin
      if customParser=nil then
        byte(Options) := 0 else
        Options := customParser.Options;
      if soWriteHumanReadable in Options then
        Inc(fHumanReadableLevel);
      for i := 0 to n do begin
        customWriter(self,P^);
        Add(',');
        inc(PtrUInt(P),aDynArray.ElemSize);
      end;
      if soWriteHumanReadable in Options then begin
        dec(fHumanReadableLevel);
        CancelLastComma;
        AddCRAndIndent;
      end;
    end;
  {$ifndef NOVARIANTS}
  djVariant:
    for i := 0 to n do begin
      AddVariantJSON(PVariantArray(P)^[i],twJSONEscape);
      Add(',');
    end;
  {$endif}
  djTimeLog..djSynUnicode: // 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]);
      djRawUTF8:  AddJSONEscape(PPointerArray(P)^[i]);
      djWideString, djSynUnicode: AddJSONEscapeW(PPointerArray(P)^[i]);
      djWinAnsi:
        if PPtrIntArray(P)^[i]<>0 then begin
          Len := PInteger(PPtrIntArray(P)^[i]-sizeof(Integer))^;
          if Len>length(tmp) then
            SetLength(tmp,Len+1024);
          AddJSONEscape(pointer(tmp),
            WinAnsiConvert.AnsiBufferToUTF8(pointer(tmp),PPointerArray(P)^[i],Len)-pointer(tmp));
        end;
      djString:
        {$ifdef UNICODE}
        AddJSONEscapeW(PPointerArray(P)^[i]);
        {$else}
        if PPtrIntArray(P)^[i]<>0 then begin
          Len := PInteger(PPtrIntArray(P)^[i]-sizeof(Integer))^;
          if Len*3>length(tmp) then
            SetLength(tmp,Len*3+2048);
          AddJSONEscape(pointer(tmp),
            CurrentAnsiConvert.AnsiBufferToUTF8(pointer(tmp),PPointerArray(P)^[i],Len)-pointer(tmp));
        end;
        {$endif}
      end;
      Add('"',',');
    end;
  else // numerical JSON
    for i := 0 to n do begin
      case T of
      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]);
      djDouble:   AddDouble(PDoubleArray(P)^[i]);
      djCurrency: AddCurr64(PInt64Array(P)^[i]);
      end;
      Add(',');
    end;
    end;
  CancelLastComma;
  Add(']');
end;

procedure TTextWriter.Add(const Format: RawUTF8; const Values: array of const;
  Escape: TTextWriterKind=twNone);
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;
      13: AddCR;
      ord('%'): break;
      {$ifdef OLDTEXTWRITERFORMAT}
      164: AddCR; // ¤ -> add CR,LF
      167: if B^=',' then dec(B); // §
      ord('|'): begin
        inc(F); // |% -> %
        goto write;
      end;
      ord('$'),163,181: // $,£,µ
        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);
    {$ifdef OLDTEXTWRITERFORMAT}
    ord('$'): with Values[ValuesIndex] do
           if Vtype=vtInteger then Add2(VInteger);
    163: with Values[ValuesIndex] do // £
           if Vtype=vtInteger then Add4(VInteger);
    181: with Values[ValuesIndex] do // µ
           if Vtype=vtInteger then Add3(VInteger);
    {$endif}
    end;
    inc(F);
    inc(ValuesIndex);
  until false;
end;

procedure TTextWriter.AddLine(const Text: shortstring);
begin
  if B+ord(Text[0])+2>=BEnd then
    FlushToStream;
  inc(B);
  move(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.AddPointer(P: PtrUInt);
begin
  if B+sizeof(P)*2>=BEnd then
    FlushToStream;
{$ifdef CPU64}
  if P and $ffffffff00000000<>0 then begin
    BinToHexDisplay(@P,PAnsiChar(B+1),8);
    inc(B,16);
  end else begin // truncate to 8 hexa chars for most heap-allocated pointers
    BinToHexDisplay(@P,PAnsiChar(B+1),4);
    inc(B,8);
  end;
{$else}
  B[8] := HexChars[P and $F]; P := P shr 4;
  B[7] := HexChars[P and $F]; P := P shr 4;
  B[6] := HexChars[P and $F]; P := P shr 4;
  B[5] := HexChars[P and $F]; P := P shr 4;
  B[4] := HexChars[P and $F]; P := P shr 4;
  B[3] := HexChars[P and $F]; P := P shr 4;
  B[2] := HexChars[P and $F]; P := P shr 4;
  B[1] := HexChars[P];
  inc(B,8);
{$endif}
end;

procedure TTextWriter.AddBinToHexDisplay(Bin: pointer; BinBytes: integer);
begin
  if cardinal(BinBytes*2-1)>=cardinal(fTempBufSize) then
    exit;
  if B+BinBytes*2>=BEnd then
    FlushToStream;
  BinToHexDisplay(Bin,PAnsiChar(B+1),BinBytes);
  inc(B,BinBytes*2);
end;

procedure TTextWriter.AddBinToHex(Bin: Pointer; BinBytes: integer);
var ChunkBytes: integer;
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(PtrInt(Bin),ChunkBytes);
    dec(BinBytes,ChunkBytes);
    if BinBytes=0 then break;
    // Flush writes B-buf+1 -> special one below:
    inc(fTotalFileSize,fStream.Write(fTempBuf^,B-fTempBuf));
    B := fTempBuf;
  until false;
  dec(B); // allow CancelLastChar
end;

procedure TTextWriter.AddQuotedStr(Text: PUTF8Char; Quote: AnsiChar;
  TextLen: integer=0);
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 TextLen>0 then begin
          if TextLen=3 then begin
            B[1] := '.'; // indicates truncated
            B[2] := '.';
            B[3] := '.';
            inc(B,3);
            break;
          end else
            dec(TextLen);
        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;

const
  HTML_ESCAPE: set of byte = [0,ord('<'),ord('>'),ord('&'),ord('"')];
  
procedure TTextWriter.AddHtmlEscape(Text: PUTF8Char);
var i,beg: PtrInt;
begin
  if Text=nil then
    exit;
  i := 0;
  repeat
    beg := i;
    if not(ord(Text[i]) in HTML_ESCAPE) then begin
      repeat // it is faster to handle all not-escaped chars at once
        inc(i);
      until ord(Text[i]) in HTML_ESCAPE;
      AddNoJSONEscape(Text+beg,i-beg);
    end;
    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);
var i,beg: PtrInt;
begin
  if (Text=nil) or (TextLen<=0) then
    exit;
  i := 0;
  repeat
    beg := i;
    if not(ord(Text[i]) in HTML_ESCAPE) then begin
      repeat // it is faster to handle all not-escaped chars at once
        inc(i);
      until (ord(Text[i]) in HTML_ESCAPE) or (i>=TextLen);
      AddNoJSONEscape(Text+beg,i-beg);
    end;
    if i=TextLen then
      exit;
    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.AddHtmlEscapeString(const Text: string);
begin
  AddHtmlEscape(pointer(StringToUTF8(Text)));
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);
      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: set of byte = [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');
        Add(HexChars[ord(Text[i]) shr 4],HexChars[ord(Text[i]) and $F]);
        Add(';');
      end;
      '<': AddShort('&lt;');
      '>': AddShort('&gt;');
      '&': AddShort('&amp;');
      '"': AddShort('&quot;');
      '''': AddShort('&apos;');
      else break;
      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 B+1>=BEnd then
    FlushToStream;
  B[1] := HexChars[Value shr 4];
  B[2] := HexChars[Value and $f];
  inc(B,2);
end;

procedure TTextWriter.AddInt18ToChars3(Value: cardinal);
begin
  if B+3>=BEnd 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)=Value);
  inc(B,3);
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; Len: integer);
var i: integer;
begin
  if P=nil then exit;
  if Len=0 then
    Len := StrLen(PUTF8Char(P));
  if Len>0 then begin // no JSONify:
    if B+8>=BEnd then
      FlushToStream;
    inc(B); // allow CancelLastChar
    case Len of
      1: B^ := PAnsiChar(P)^;
      2: begin PWord(B)^ := PWord(P)^; Inc(B); end;
      3: begin PWord(B)^ := PWord(P)^; B[2] := PAnsiChar(P)[2]; Inc(B,2); end;
      4: begin PCardinal(B)^ := PCardinal(P)^; Inc(B,3); end;
      5: begin PCardinal(B)^ := PCardinal(P)^; B[4] := PAnsiChar(P)[4]; Inc(B,4); end;
      6: begin PCardinal(B)^ := PCardinal(P)^; PWordArray(B)[2] := PWordArray(P)[2];
          Inc(B,5); end;
      7: begin PCardinal(B)^ := PCardinal(P)^; PWordArray(B)[2] := PWordArray(P)[2];
          B[6] := PAnsiChar(P)[6]; Inc(B,6); end;
      8: begin PInt64(B)^ := PInt64(P)^; inc(B,7); end;
      else begin
        repeat
          // guess biggest size to be added into buf^ at once
          i := BEnd-B;
          if Len<i then
            i := Len;
          // add UTF-8 bytes
          move(P^,B^,i);
          inc(PtrInt(P),i);
          inc(B,i);
          dec(Len,i);
          if Len=0 then
            break;
          // FlushInc writes B-buf+1 -> special one below:
          inc(fTotalFileSize,fStream.Write(fTempBuf^,B-fTempBuf));
          B := fTempBuf;
        until false;
        dec(B); // allow CancelLastChar
      end;
    end;
  end;
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;
      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);
    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
  AddAnyAnsiString(s,Escape,0);
end;

procedure TTextWriter.AddAnyAnsiString(const s: RawByteString;
  Escape: TTextWriterKind; CodePage: Integer);
var L: PtrInt;
    tmpU8: array[0..256*3] of AnsiChar;
    U8: PUTF8Char;
begin
  L := length(s);
  if L=0 then
    exit;
  if PInteger(s)^ and $ffffff=JSON_BASE64_MAGIC then begin
    WrBase64(pointer(s),L,false); // identified as a BLOB content
    exit;
  end;
  if CodePage<0 then
    {$ifdef UNICODE}
    CodePage := StringCodePage(s);
    {$else}
    CodePage := 0;
    {$endif}
  case CodePage of
  CP_UTF8, CP_RAWBYTESTRING:
    Add(pointer(s),0,Escape);  // direct write of RawUTF8/RawByteString content
  CP_UTF16:
    AddW(pointer(s),0,Escape); // direct write of UTF-16 content
  CP_SQLRAWBLOB: begin
    AddNoJSONEscape(@JSON_BASE64_MAGIC_QUOTE_VAR,4);
    WrBase64(pointer(s),L,false);
  end;
  else begin
    if L>=SizeOf(tmpU8)div 3 then
      Getmem(U8,L*3+1) else
      U8 := @tmpU8;
    L := TSynAnsiConvert.Engine(CodePage).AnsiBufferToUTF8(U8,pointer(s),L)-U8;
    Add(pointer(U8),L,Escape);
    if U8<>@tmpU8 then
      Freemem(U8);
  end;
  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 := PtrUInt(-1) else
    PEnd := PtrUInt(P)+PtrUInt(Len)*sizeof(WideChar);
  while PtrUInt(P)<PEnd do begin
    if B+7>=BEnd 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;

const // see http://www.ietf.org/rfc/rfc4627.txt
  JSON_ESCAPE: set of byte = [0..31,ord('\'),ord('"')];

procedure TTextWriter.AddJSONEscape(P: Pointer; 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(PByteArray(P)[i] in JSON_ESCAPE) then begin
      repeat
        inc(i);
      until (i>=Len) or (PByteArray(P)[i] in JSON_ESCAPE);
      AddNoJSONEscape(PAnsiChar(P)+c,i-c);
    end;
    while i<Len do begin
      c := PByteArray(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');
        Add(HexCharsLower[c shr 4],HexCharsLower[c and $F]);
      end;
      else break;
      end;
      inc(i);
    end;
  end;
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');
        Add(HexCharsLower[c shr 4],HexCharsLower[c and $F]);
      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 UNICODE}vtUnicodeString,{$endif}
    vtPChar, vtChar, vtWideChar, vtWideString, vtClass: begin
      Add('"');
      case VType of
        vtString:     AddJSONEscape(@VString^[1],ord(VString^[0]));
        vtAnsiString: AddJSONEscape(pointer(RawUTF8(VAnsiString)));
    {$ifdef UNICODE}
        vtUnicodeString: AddJSONEscapeW(
          pointer(string(VUnicodeString)),length(string(VUnicodeString)));
    {$endif}
        vtPChar:      AddJSONEscape(VPChar);
        vtChar:       AddJSONEscape(@VChar,1);
        vtWideChar:   AddJSONEscapeW(@VWideChar,1);
        vtWideString: AddJSONEscapeW(VWideString);
        vtClass: if VClass<>nil then
                   AddShort(PShortString(PPointer(PtrInt(VClass)+vmtClassName)^)^);
      end;
      Add('"');
    end;
    vtBoolean:  AddString(JSON_BOOLEAN[VBoolean]);
    vtInteger:  Add(VInteger);
    vtInt64:    Add(VInt64^);
    vtExtended: Add(VExtended^,DOUBLE_PRECISION);
    vtCurrency: AddCurr64(VInt64^);
    vtObject:   WriteObject(VObject);
    {$ifndef NOVARIANTS}
    vtVariant:  AddVariantJSON(VVariant^,twJSONEscape);
    {$endif}
  end;
end;

procedure TTextWriter.Add(const V: TVarRec; Escape: TTextWriterKind);
begin
  with V do
  case Vtype of
  vtInteger:      Add(VInteger);
  vtBoolean:      AddU(byte(VBoolean));
  vtChar:         Add(@VChar,1,Escape);
  vtExtended:     Add(VExtended^,DOUBLE_PRECISION);
  vtString:       Add(@VString^[1],ord(VString^[0]),Escape);
  vtPointer:      AddPointer(PtrUInt(VPointer));
  vtPChar:        Add(PUTF8Char(VPChar),Escape);
  vtObject:       WriteObject(VObject,[woFullExpand]);
  vtClass:
   if VClass<>nil then
     AddShort(PShortString(PPointer(PtrInt(VClass)+vmtClassName)^)^);
  vtWideChar:
   AddW(@VWideChar,1,Escape);
  vtPWideChar:
   AddW(pointer(VPWideChar),StrLenW(VPWideChar),Escape);
  vtAnsiString:
   Add(VAnsiString,Escape); // expect RawUTF8
  vtCurrency:
   AddCurr64(VInt64^);
  vtWideString:
   if VWideString<>nil then
     AddW(VWideString,length(WideString(VWideString)),Escape);
  vtInt64:
   Add(VInt64^);
  {$ifndef NOVARIANTS}
  vtVariant:
   AddVariantJSON(VVariant^,Escape);
  {$endif}
  {$ifdef UNICODE}
  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);
begin
  AddVariantJSON(_JsonFastFmt(Format,Args,Params),twJSONEscape);
end;
{$endif}

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]);
    Add(':');
    inc(a);
    WriteValue;
    inc(a);
  end;
  CancelLastComma;
  Add('}');
end;

procedure TTextWriter.AddNoJSONEscapeString(const s: string);
begin
  if s<>'' then
    {$ifdef UNICODE}
    AddNoJSONEscapeW(pointer(s),length(s));
    {$else}
    AddAnsiString(s,twNone);
    {$endif}
end;

procedure TTextWriter.AddJSONEscapeString(const s: string);
begin
  if s<>'' then
    {$ifdef UNICODE}
    AddJSONEscapeW(pointer(s),Length(s));
    {$else}
    AddAnsiString(s,twJSONEscape);
    {$endif}
end;

procedure TTextWriter.AddJSONEscapeAnsiString(const s: AnsiString);
begin
  AddAnsiString(s,twJSONEscape);
end;

procedure TTextWriter.AddPropName(const PropName: ShortString);
begin
  if ord(PropName[0])=0 then
    exit;
  if B+ord(PropName[0])+3>=BEnd then
    FlushToStream;
  B[1] := '"';
  move(PropName[1],B[2],ord(PropName[0]));
  inc(B,ord(PropName[0])+2);
  PWord(B)^ := ord('"')+ord(':')shl 8;
  inc(B);
end;

procedure TTextWriter.AddFieldName(const FieldName: RawUTF8);
begin
  AddFieldName(Pointer(FieldName),length(FieldName));
end;

procedure TTextWriter.AddFieldName(FieldName: PUTF8Char; FieldNameLen: integer);
begin
  if B+FieldNameLen+3>=BEnd then
    FlushToStream;
  B[1] := '"';
  move(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(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('(');
  AddPointer(PtrUInt(Instance));
  Add(')','"');
  if SepChar<>#0 then
    Add(SepChar);
end;

procedure TTextWriter.AddInstancePointer(Instance: TObject; SepChar: AnsiChar);
begin
  AddShort(PShortString(PPointer(PPtrInt(Instance)^+vmtClassName)^)^);
  Add('(');
  AddPointer(PtrUInt(Instance));
  Add(')');
  if SepChar<>#0 then
    Add(SepChar);
end;

procedure TTextWriter.AddShort(const Text: ShortString);
begin
  if ord(Text[0])=0 then
    exit;
  if B+ord(Text[0])>=BEnd then
    FlushToStream;
  move(Text[1],B[1],ord(Text[0]));
  inc(B,ord(Text[0]));
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 := PInteger(PtrInt(Text)-sizeof(integer))^;
  if L<fTempBufSize then begin
    if B+L>=BEnd then
      FlushToStream;
    move(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 := PInteger(PtrInt(Text)-sizeof(integer))^-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 B+L*count>BEnd then
      FlushToStream;
    for i := 1 to count do begin
      move(pointer(Text)^,B[1],L);
      inc(B,L);
    end;
  end;
end;

procedure TTextWriter.CancelAll;
begin
  if self=nil then
    exit; // avoid GPF
  fTotalFileSize := fStream.Seek(fInitialStreamPosition,soBeginning);
  B := fTempBuf-1;
end;

procedure TTextWriter.CancelLastChar;
begin
  dec(B);
end;

function TTextWriter.LastChar: AnsiChar;
begin
  result := B^;
end;

function TTextWriter.PendingBytes: PtrUInt;
begin
  result := B-fTempBuf;
end;

procedure TTextWriter.CancelLastComma;
begin
  if B^=',' then
    dec(B);
end;

constructor TTextWriter.Create(aStream: TStream; aBufSize: integer);
begin
  SetStream(aStream);
  if aBufSize<256 then
    aBufSize := 256;
  fTempBufSize := aBufSize;
  GetMem(fTempBuf,aBufSize);
  B := fTempBuf-1; // Add() methods will append at B+1
  BEnd := fTempBuf+fTempBufSize-2;
end;

constructor TTextWriter.CreateOwnedStream(aBufSize: integer);
begin
  Create(TRawByteStringStream.Create,aBufSize);
  fStreamIsOwned := true;
end;

constructor TTextWriter.CreateOwnedFileStream(const aFileName: TFileName;
  aBufSize: integer);
begin
  DeleteFile(aFileName);
  Create(TFileStream.Create(aFileName,fmCreate),aBufSize);
  fStreamIsOwned := true;
end;

destructor TTextWriter.Destroy;
begin
  if fStreamIsOwned then
    fStream.Free;
  FreeMem(fTempBuf);
  fInternalJSONWriter.Free; 
  inherited;
end;

class procedure TTextWriter.SetDefaultJSONClass(aClass: TTextWriterClass);
begin
  DefaultTextWriterJSONClass := aClass;
end;

procedure TTextWriter.SetStream(aStream: TStream);
begin
  if fStream<>nil then
    if fStreamIsOwned then
      FreeAndNil(fStream);
  if aStream<>nil then begin
    fStream := aStream;
    fInitialStreamPosition := fStream.Seek(0,soFromCurrent);
    fTotalFileSize := fInitialStreamPosition;
  end;
end;

procedure TTextWriter.FlushToStream;
begin
  if fEchos<>nil then begin
    EchoFlush;
    fEchoStart := 0;
  end;
  inc(fTotalFileSize,fStream.Write(fTempBuf^,B-fTempBuf+1));
  if (not fFlushToStreamNoAutoResize) and (fTempBufSize<49152) and
     (fTotalFileSize-fInitialStreamPosition>1 shl 18) then begin
    FreeMem(fTempBuf); // with big content (256KB) comes bigger buffer (64KB)
    fTempBufSize := 65536;
    GetMem(fTempBuf,65536);
    BEnd := fTempBuf+(65536-2);
  end;
  B := fTempBuf-1;
end;

function TTextWriter.GetLength: cardinal;
begin
  if self=nil then
    result := 0 else
    result := cardinal(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.Write(pointer(text)^,length(text));
  fTotalFileSize := fInitialStreamPosition+cardinal(length(text));
end;

procedure TTextWriter.FlushFinal;
begin
  fFlushToStreamNoAutoResize := true;
  FlushToStream;
end;

procedure TTextWriter.SetText(var result: RawUTF8);
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
      result := DataString else
      SetRawUTF8(result,PAnsiChar(pointer(DataString))+fInitialStreamPosition,Len) else
  if fStream.InheritsFrom(TCustomMemoryStream) then
    with TCustomMemoryStream(fStream) do
    SetRawUTF8(result,PAnsiChar(Memory)+fInitialStreamPosition,Len) else begin
    FastNewRawUTF8(result,Len);
    fStream.Seek(fInitialStreamPosition,soBeginning);
    fStream.Read(pointer(result)^,Len);
  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,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 B+(n+1) shl 2<BEnd 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
          inc(fTotalFileSize,fStream.Write(fTempBuf^,n));
        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: integer;
var L,LI: Integer;
    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); // faster append to fEchoBuf
  SetLength(fEchoBuf,LI+L);
  Move(P^,PByteArray(fEchoBuf)[LI],L);
end;

procedure TTextWriter.EchoReset;
begin
  fEchoBuf := '';
end;


{ TJSONWriter }

procedure TJSONWriter.CancelAllVoid;
const VOIDARRAY: PAnsiChar = '[]'#10;
      VOIDFIELD: PAnsiChar = '{"FieldCount":0}';
begin
  CancelAll; // rewind JSON
  if fExpand then // same as sqlite3_get_table()
    inc(fTotalFileSize,fStream.Write(VOIDARRAY^,3)) else
    inc(fTotalFileSize,fStream.Write(VOIDFIELD^,16));
end;

constructor TJSONWriter.Create(aStream: TStream; Expand, withID: boolean;
  const Fields: TSQLFieldBits);
begin
  Create(aStream,Expand,withID,FieldBitsToIndex(Fields));
end;

constructor TJSONWriter.Create(aStream: TStream; Expand, withID: boolean;
  const Fields: TSQLFieldIndexDynArray);
begin
  if aStream=nil then
    CreateOwnedStream else
    inherited Create(aStream);
  fExpand := Expand;
  fWithID := withID;
  fFields := Fields;
end;

procedure TJSONWriter.AddColumns(aKnownRowsCount: integer);
var i: integer;
begin
  if fExpand then begin
    for i := 0 to High(ColNames) do
      ColNames[i] := '"'+ColNames[i]+'":';
  end else begin
    AddShort('{"fieldCount":');
    Add(length(ColNames));
    if aKnownRowsCount>0 then begin
      AddShort(',"rowCount":');
      Add(aKnownRowsCount);
    end;
    AddShort(',"values":["');
    // first row is FieldNames
    for i := 0 to High(ColNames) do begin
      AddString(ColNames[i]);
      AddNoJSONEscape(PAnsiChar('","'),3);
    end;
    CancelLastChar; // cancel last '"'
    fStartDataPosition := fStream.Position+(B-fTempBuf);
     // B := buf-1 at startup -> need ',val11' position in
     // "values":["col1","col2",val11,' i.e. current pos without the ','
  end;
end;

procedure TJSONWriter.ChangeExpandedFields(aWithID: boolean;
  const aFields: TSQLFieldIndexDynArray);
begin
  if not Expand then
    raise ESynException.CreateUTF8(
      '%.ChangeExpandedFields() called with Expanded=false',[self]);
  fWithID := aWithID;
  fFields := aFields;
end;

procedure TJSONWriter.EndJSONObject(aKnownRowsCount,aRowsCount: integer);
begin
  CancelLastComma; // cancel last ','
  Add(']');
  if not fExpand then begin
    if aKnownRowsCount=0 then begin
      AddShort(',"rowCount":');
      Add(aRowsCount);
    end;
    Add('}');
  end;
  Add(#10);
  FlushFinal;
end;

procedure TJSONWriter.TrimFirstRow;
var P, PBegin, PEnd: PUTF8Char;
begin
  if (self=nil) or not fStream.InheritsFrom(TMemoryStream) or
     fExpand or (fStartDataPosition=0) then
    exit;
  // go to begin of first row
  FlushToStream; // we need the data to be in fStream memory
  // PBegin^=val11 in { "fieldCount":1,"values":["col1","col2",val11,"val12",val21,..] }
  PBegin := TMemoryStream(fStream).Memory;
  PEnd := PBegin+fStream.Position;
  PEnd^ := #0; // mark end of current values
  inc(PBegin,fStartDataPosition+1); // +1 to include ',' of ',val11'
  // jump to end of first row
  P := GotoNextJSONItem(PBegin,length(ColNames));
  if P=nil then exit; // unexpected end
  // trim first row data
  if P^<>#0 then
    move(P^,PBegin^,PEnd-P); // erase content
  fStream.Seek(PBegin-P,soCurrent); // adjust current stream position
end;


function JSONEncode(const NameValuePairs: array of const): RawUTF8;
begin
  if high(NameValuePairs)<1 then
    result := '{}' else // return void JSON object on error
    with DefaultTextWriterJSONClass.CreateOwnedStream do
    try
      AddJSONEscape(NameValuePairs);
      SetText(result);
    finally
      Free
    end;
end;

{$ifndef NOVARIANTS}
function JSONEncode(const Format: RawUTF8; const Args,Params: array of const): RawUTF8; overload;
begin
  with DefaultTextWriterJSONClass.CreateOwnedStream do
  try
    AddJSON(Format,Args,Params);
    SetText(result);
  finally
    Free
  end;
end;
{$endif}

function JSONEncodeArrayDouble(const Values: array of double): RawUTF8;
var W: TTextWriter;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream;
  try
    W.Add('[');
    W.AddCSVDouble(Values);
    W.Add(']');
    result := W.Text;
  finally
    W.Free
  end;
end;

function JSONEncodeArrayUTF8(const Values: array of RawUTF8): RawUTF8;
var W: TTextWriter;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream;
  try
    W.Add('[');
    W.AddCSVUTF8(Values);
    W.Add(']');
    result := W.Text;
  finally
    W.Free
  end;
end;

function JSONEncodeArrayInteger(const Values: array of integer): RawUTF8;
var W: TTextWriter;
begin
  W := DefaultTextWriterJSONClass.CreateOwnedStream;
  try
    W.Add('[');
    W.AddCSVInteger(Values);
    W.Add(']');
    result := W.Text;
  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);
begin
  if length(Values)=0 then
    if WithoutBraces then
      result := '' else
      result := '[]' else
    with DefaultTextWriterJSONClass.CreateOwnedStream do
    try
      if not WithoutBraces then
        Add('[');
      AddCSVConst(Values);
      if not WithoutBraces then
        Add(']');
      result := Text;
    finally
      Free
    end;
end;

procedure JSONDecode(var JSON: RawUTF8;
  const Names: array of PUTF8Char; var Values: TPUtf8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean=false);
begin
  JSONDecode(UniqueRawUTF8(JSON),Names,Values,HandleValuesAsObjectOrArray);
end;

function JSONDecode(P: PUTF8Char; const Names: array of PUTF8Char;
  var Values: TPUtf8CharDynArray; HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char;
var n, i: PtrInt;
    Name, Value: PUTF8Char;
    EndOfObject: AnsiChar;
    NewValues: boolean;
begin
  result := nil;
  n := length(Names);
  NewValues := pointer(Values)=nil;
  SetLength(Values,n);
  if not NewValues then
    fillchar(Values[0],n*sizeof(PUTF8Char),0); // SetLength() could leave it not void
  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);
    if Name=nil then
      exit;  // invalid JSON content
    Value := GetJSONFieldOrObjectOrArray(P,nil,@EndOfObject,HandleValuesAsObjectOrArray);
    if not(EndOfObject in [',','}']) then
      exit; // invalid item separator
    for i := 0 to n do
      if StrIComp(Name,Names[i])=0 then begin
        Values[i] := Value;
        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;
    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);
    if Name=nil then
      exit;  // invalid JSON content
    Value := GetJSONFieldOrObjectOrArray(
      P,wasString,@EndOfObject,HandleValuesAsObjectOrArray);
    if not(EndOfObject in [',','}']) then
      exit; // invalid item separator
    if StrIComp(Name,pointer(aName))=0 then begin
      Result := RawUTF8(Value);
      exit;
    end;
  until (P=nil) or (EndOfObject='}');
end;

function JSONDecode(P: PUTF8Char; out Values: TNameValuePUTF8CharDynArray;
  HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char;
var n: PtrInt;
    Name, Value: PUTF8Char;
    EndOfObject: AnsiChar;
begin
  result := nil;
  n := 0;
  if P<>nil then begin
    while P^<>'{' do
      if P^=#0 then
        exit else
        inc(P);
    inc(P); // jump {
    repeat
      Name := GetJSONPropName(P);
      if Name=nil then
        exit;  // invalid JSON content
      Value := GetJSONFieldOrObjectOrArray(P,nil,@EndOfObject,HandleValuesAsObjectOrArray);
      if not(EndOfObject in [',','}']) then
        exit; // invalid item separator
      if n=length(Values) then
        SetLength(Values,n+32);
      Values[n].Name := Name;
      Values[n].Value := Value;
      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^ in [#1..' '] 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 not(P^ in [#1..' ']);
  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=nil; EndOfObject: PUTF8Char=nil): PUTF8Char;
// this code is very fast
var i,j: integer;
    w: word;
    c4: integer;
label slash;
begin
  if wasString<>nil then
    wasString^ := false; // default is 'no string'
  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^>' ';
  c4 := PInteger(P)^;
  if (c4=NULL_LOW) and (P[4] in EndOfJSONValueField)  then begin
    result := nil; // null -> returns nil and wasString=false
    inc(P,3);
  end else
  if (c4=FALSE_LOW) and (P[4]='e') and (P[5] in EndOfJSONValueField) then begin
    result := P; // false -> returns 'false' and wasString=false
    inc(P,4);
  end else
  if (c4=TRUE_LOW) and (P[4] in EndOfJSONValueField)  then begin
    result := P; // true -> returns 'true' and wasString=false
    inc(P,3);
  end else
  if P^='"' then begin
    // '"string \"\\field"' -> 'string "\field'
    if wasString<>nil then
      wasString^ := true;
    inc(P);
    result := P;
    i := 0;
    j := 0;
    repeat // unescape P^ into U^ (cf. http://www.ietf.org/rfc/rfc4627.txt)
      case P[i] of
      #0:  exit;  // leave PDest=nil for unexpected end
      '"': break; // end of string
      '\': goto slash;
      else begin
        P[j] := P[i]; // 3 stages pipelined process of unescaped chars
        inc(i);
        inc(j);
        case P[i] of
        #0:  exit;
        '"': break;
        '\': goto slash;
        else begin
          P[j] := P[i];
          inc(i);
          inc(j);
          case P[i] of
          #0:  exit;
          '"': break;
          '\': goto slash;
          else begin
            P[j] := P[i];
            inc(i);
            inc(j);
            continue;
          end;
          end;
        end;
        end;
      end;
      end;
slash:inc(i);
      case P[i] of // unescape JSON string
        #0: exit; // to avoid potential buffer overflow issue for \#0
        'b': P[j] := #08;
        't': P[j] := #09;
        'n': P[j] := #$0a;
        'f': P[j] := #$0c;
        'r': P[j] := #$0d;
        'u':
        if HexToBin(pointer(P+i+1),@w,2) and (w<>0) then begin // '\u0123'
          w := swap(w);  // reverse byte order
          if w<=$7f then // speed up UTF-8 encoding for most used chars
            P[j] := ansichar(w) else
            inc(j,WideCharToUtf8(P+j,w)-1);
          inc(i,4);
        end else
          P[j] := '?'; // bad formated hexa number -> '?0123'
        else P[j] := P[i]; // litterals: '\"' -> '"'
      end;
      inc(i);
      inc(j);
    until false;
    // here P[i]='"'
    P[j] := #0; // make zero-terminated
    inc(P,i+1);
    if P^=#0 then
      exit;
  end else begin
    // numerical field: all chars before end of field
    if not (P[0] in DigitFirstChars) then // is first char (at least) a number?
      if (P[0]<>'0') or (P[1] in ['0'..'9']) then // 0123 excluded by JSON!
        exit; // leave PDest=nil for unexpected end
    result := P;
    i := 0;
    repeat
      inc(i);
      if not (P[i] in DigitFloatChars) then
        break;
      inc(i);
    until not (P[i] in DigitFloatChars);
    inc(P,i);
    if P^=#0 then
      exit;
    if P^<=' ' then
      P^ := #0; // force numerical field with no trailing ' '
  end;
  if not (P^ in EndOfJSONField) then begin
    i := 1;
    while not (P[i] in EndOfJSONField) do begin
      inc(i);
      if P[i]=#0 then
        exit; // leave PDest=nil for unexpected end
    end;
    inc(P,i);
  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): PUTF8Char;
var Name: PUTF8Char;
    wasString: boolean;
    EndOfObject: AnsiChar;
begin  // should match GotoNextJSONObjectOrArray()
  result := nil;
  if P=nil then
    exit;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  Name := P; // put here to make some versions of Delphi compiler happy
  case P^ of
  '_','A'..'Z','a'..'z','0'..'9','$': begin // e.g. '{age:{$gt:18}}'
    repeat
      inc(P);
    until not (P^ in ['_','A'..'Z','a'..'z','0'..'9','.']);
    if P^ in [#1..' '] then begin
      P^ := #0;
      inc(P);
    end;
    if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
    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);
    P^ := #0;
    repeat inc(P) until not(P^ in [#1..' ']);
    if P^<>':' then
      exit;
    inc(P);
  end;
  '"': begin
    Name := GetJSONField(P,P,@wasString,@EndOfObject);
    if (Name=nil) or (not wasString) or (EndOfObject<>':') then
      exit;
  end else
    exit;
  end;
  result := Name;
end;

function GotoNextJSONPropName(P: PUTF8Char): PUTF8Char;
label s;
begin  // should match GotoNextJSONObjectOrArray()
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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 (P^ in ['_','A'..'Z','a'..'z','0'..'9','.']);
    if P^ in [#1..' '] then
      inc(P);
    if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
    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 not(P^ in [#1..' ']);
    if P^<>':' then
      exit;
  end else
    exit;
  end;
  repeat inc(P) until not(P^ in [#1..' ']);
  result := P;
end;

function GetJSONFieldOrObjectOrArray(var P: PUTF8Char; wasString: PBoolean=nil;
  EndOfObject: PUTF8Char=nil; HandleValuesAsObjectOrArray: Boolean=false): PUTF8Char;
var Value: PUTF8Char;
    wStr: boolean;
begin
  result := nil;
  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 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);
    if (result<>nil) and (not wStr) and (result^>='f') then
      if PInteger(result)^=TRUE_LOW then
        result := '1' else   // normalize true -> 1
      if PInteger(result)^=FALSE_LOW then
        result := '0';       // normalize false -> 0
    if wasString<>nil then
      wasString^ := wStr;
  end;
end;

function IsString(P: PUTF8Char): boolean;  // test if P^ is a "string" value
begin
  if P=nil then begin
    result := false;
    exit;
  end;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
    if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
    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;
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  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;
    if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
    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;
label next;
begin
 result := nil; // to notify unexpected end
 if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
 // 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;
   if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
   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;
 result := P;
end;

function GetJSONItemAsRawJSON(var P: PUTF8Char; EndOfObject: PAnsiChar=nil): RawJSON;
var B: PUTF8Char;
begin
  result := '';
  B := P;
  P := GotoEndJSONItem(B);
  if P=nil then
    exit;
  SetString(result,PAnsiChar(B),P-B);
  P := GotoNextNotSpace(P);
  if EndOfObject<>nil then
    EndOfObject^ := P^;
  if P^<>#0 then //if P^=',' then
    repeat inc(P) until not(P^ in [#1..' ']);
end;

function GotoNextJSONItem(P: PUTF8Char; NumberOfItemsToJump: cardinal;
  EndOfObject: PAnsiChar): PUTF8Char;
label next;
begin
 result := nil; // to notify unexpected end
 while NumberOfItemsToJump>0 do begin
   if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
   // 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;
     if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
     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
  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 not(P^ in [#1..' ']);
      if P^<>':' then exit;
    end;
    '/': begin
      repeat // allow extended /regex/ syntax
        inc(P);
        if P^=#0 then
          exit;
      until P^='/';
      repeat inc(P) until not(P^ in [#1..' ']);
    end;
    else begin
Prop: if not (P^ in ['_','A'..'Z','a'..'z','0'..'9','$']) then
        exit; // expect e.g. '{age:{$gt:18}}'
      repeat
        inc(P);
       until not (P^ in ['_','A'..'Z','a'..'z','0'..'9','.']);
       while P^ in [#1..' '] do inc(P);
       if P^<>':' then exit;
    end;
    end;
    if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
    if (PMax<>nil) and (P>=PMax) then
      exit; 
  until P^=EndChar;
  result := P+1;
end;

function GotoNextJSONObjectOrArray(P: PUTF8Char; EndChar: AnsiChar=#0): PUTF8Char;
label Prop;
begin // should match GetJSONPropName()
  result := nil; // mark error or unexpected end (#0)
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  if EndChar=#0 then begin
    case P^ of
    '[': EndChar := ']';
    '{': EndChar := '}';
    else exit;
    end;
    repeat inc(P) until not(P^ in [#1..' ']);
  end;
  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)
  if P^ in [#1..' '] then repeat inc(P) until not(P^ in [#1..' ']);
  case P^ of
  '[': EndChar := ']';
  '{': EndChar := '}';
  else exit;
  end;
  repeat inc(P) until not(P^ in [#1..' ']);
  result := GotoNextJSONObjectOrArrayInternal(P,PMax,EndChar);
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;
begin
  if P=nil then
    result := Header else
    with TTextWriter.CreateOwnedStream 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,NameSpace: RawUTF8): RawUTF8;
var tmp: RawUTF8;
begin
  SetString(tmp,PAnsiChar(pointer(JSON)),length(JSON)); // make local copy
  JSONBufferToXML(pointer(tmp),Header,NameSpace,result);
end;

procedure JSONBufferReformat(P: PUTF8Char; out result: RawUTF8;
  Format: TTextWriterJSONFormat);
begin
  if P<>nil then
    with TTextWriter.CreateOwnedStream(65536) do
    try
      AddJSONReformat(P,Format,nil);
      SetText(result);
    finally
      Free;
    end;
end;

function JSONReformat(const JSON: RawUTF8; Format: TTextWriterJSONFormat): RawUTF8;
var tmp: RawUTF8;
    n: Integer;
begin
  n := length(JSON);
  SetString(tmp,PAnsiChar(pointer(JSON)),n); // make local copy
  if n<4096 then
    n := 4096 else // minimal rough estimation of the output buffer size
    inc(n,n shr 4);
  with TTextWriter.CreateOwnedStream(n) do
  try
    AddJSONReformat(pointer(tmp),Format,nil);
    SetText(result);
  finally
    Free;
  end;
end;

function JSONBufferReformatToFile(P: PUTF8Char; const Dest: TFileName;
  Format: TTextWriterJSONFormat=jsonHumanReadable): boolean;
var F: TFileStream;
begin
  try
    F := TFileStream.Create(Dest,fmCreate);
    try
      with TTextWriter.Create(F,256*1024) 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: RawUTF8;
begin
  SetString(tmp,PAnsiChar(pointer(JSON)),length(JSON)); // make local copy
  result := JSONBufferReformatToFile(pointer(tmp),Dest,Format);
end;


{ TSynConnectionDefinition }

constructor TSynConnectionDefinition.CreateFromJSON(const JSON: RawUTF8;
  Key: cardinal);
var privateCopy: RawUTF8;
    values: TPUtf8CharDynArray;
begin
  fKey := Key;
  privateCopy := JSON;
  JSONDecode(privateCopy,['Kind','ServerName','DatabaseName','User','Password'],values);
  UTF8DecodeToString(values[0],StrLen(values[0]),fKind);
  fServerName := values[1];
  fDatabaseName := values[2];
  fUser := values[3];
  fPassWord := values[4];
end;

function TSynConnectionDefinition.SaveToJSON: RawUTF8;
begin
  result := JSONEncode(['Kind',fKind,'ServerName',fServerName,
    'DatabaseName',fDatabaseName,'User',fUser,'Password',fPassword]);
end;

function TSynConnectionDefinition.GetKey: cardinal;
begin
  if self=nil then
    result := 0 else
  if fKey=0 then
    result := $A5abba5A else
    result := fKey;
end;

function TSynConnectionDefinition.GetPassWordPlain: RawUTF8;
begin
  if (self=nil) or (fPassWord='') then
    result := '' else begin
    result := Base64ToBin(fPassWord);
    SymmetricEncrypt(GetKey,RawByteString(result));
  end;
end;

procedure TSynConnectionDefinition.SetPassWordPlain(const Value: RawUTF8);
var data: RawByteString;
begin
  if self=nil then
    exit;
  if Value='' then begin
    fPassWord := '';
    exit;
  end;
  data := Value;
  SymmetricEncrypt(GetKey,data);
  fPassWord := BinToBase64(data);
end;


{ ************ filtering and validation classes and functions }

function IsValidIP4Address(P: PUTF8Char): boolean;
var ndot: PtrInt;
    V: PtrUInt;
begin
  result := false;
  if (P=nil) or not (P^ in ['0'..'9']) then
    exit;
  V := 0;
  ndot := 0;
  repeat
    case P^ of
      #0: break;
      '.': if (P[-1]='.') or (V>255) then
        exit else begin
        inc(ndot);
        V := 0;
      end;
      '0'..'9': V := (V*10)+ord(P^)-48;
      else exit;
    end;
    inc(P);
  until false;
  if (ndot=3) and (V<=255) and (P[-1]<>'.') then
    result := true;
end;

function IsValidEmail(P: PUTF8Char): boolean;
// Initial Author: Ernesto D'Spirito - UTF-8 version by AB
// http://www.howtodothings.com/computers/a1169-validating-email-addresses-in-delphi.html
const
  // Valid characters in an "atom"
  atom_chars: set of AnsiChar = [#33..#255] -
     ['(', ')', '<', '>', '@', ',', ';', ':', '\', '/', '"', '.', '[', ']', #127];
  // Valid characters in a "quoted-string"
  quoted_string_chars: set of AnsiChar = [#0..#255] - ['"', #13, '\'];
  // Valid characters in a subdomain
  letters: set of AnsiChar = ['A'..'Z', 'a'..'z'];
  letters_digits: set of AnsiChar = ['0'..'9', 'A'..'Z', 'a'..'z'];
type
  States = (STATE_BEGIN, STATE_ATOM, STATE_QTEXT, STATE_QCHAR,
    STATE_QUOTE, STATE_LOCAL_PERIOD, STATE_EXPECTING_SUBDOMAIN,
    STATE_SUBDOMAIN, STATE_HYPHEN);
var
  State: States;
  subdomains: integer;
  c: AnsiChar;
  ch: PtrInt;
begin
  State := STATE_BEGIN;
  subdomains := 1;
  if P<>nil then
  repeat
    ch := ord(P^);
    if ch and $80=0 then
      inc(P) else
      ch := GetHighUTF8UCS4(P);
    if (ch<=255) and (WinAnsiConvert.AnsiToWide[ch]<=255) then
      // convert into WinAnsi char
      c := AnsiChar(ch) else
      // invalid char
      c := #127;
    case State of
    STATE_BEGIN:
      if c in atom_chars then
        State := STATE_ATOM else
      if c = '"' then
        State := STATE_QTEXT else
        break;
    STATE_ATOM:
      if c = '@' then
        State := STATE_EXPECTING_SUBDOMAIN else
      if c = '.' then
        State := STATE_LOCAL_PERIOD else
      if not (c in atom_chars) then
        break;
    STATE_QTEXT:
      if c = '\' then
        State := STATE_QCHAR else
      if c = '"' then
        State := STATE_QUOTE else
      if not (c in quoted_string_chars) then
        break;
    STATE_QCHAR:
      State := STATE_QTEXT;
    STATE_QUOTE:
      if c = '@' then
        State := STATE_EXPECTING_SUBDOMAIN else
      if c = '.' then
        State := STATE_LOCAL_PERIOD else
        break;
    STATE_LOCAL_PERIOD:
      if c in atom_chars then
        State := STATE_ATOM else
      if c = '"' then
        State := STATE_QTEXT else
        break;
    STATE_EXPECTING_SUBDOMAIN:
      if c in letters_digits then
        State := STATE_SUBDOMAIN else
        break;
    STATE_SUBDOMAIN:
      if c = '.' then begin
        inc(subdomains);
        State := STATE_EXPECTING_SUBDOMAIN
      end else
      if c = '-' then
        State := STATE_HYPHEN else
      if not (c in letters_digits) then
        break;
    STATE_HYPHEN:
      if c in letters_digits then
        State := STATE_SUBDOMAIN else
      if c <> '-' then
        break;
    end;
    if P^=#0 then begin
      P := nil;
      break;
    end;
  until false;
  Result := (State = STATE_SUBDOMAIN) and (subdomains >= 2);
end;


function IsMatch(const Pattern, Text: RawUTF8; CaseInsensitive: boolean): boolean;
// code below adapted from ZMatchPattern.pas - http://www.zeoslib.sourceforge.net

  type
    TMatch = (mNONE, mABORT, mEND, mLITERAL, mPATTERN, mRANGE, mVALID);
  const
    SINGLE	= '?';
    KLEENE_STAR = '*';
    RANGE_OPEN	= '[';
    RANGE = '-';
    RANGE_CLOSE = ']';
    CARET_NEGATE = '^';
    EXCLAMATION_NEGATE	= '!';

  function MatchAfterStar(Pattern, Text: RawUTF8): TMatch; forward;

  function Matche(const Pattern, Text: RawUTF8): TMatch;
  var RangeStart, RangeEnd, P, T, PLen, TLen: Integer;
      Invert, MemberMatch: Boolean;
  begin
    P := 1;
    T := 1;
    PLen := Length(pattern);
    TLen := Length(text);
    Result := mNONE;
    while ((Result = mNONE) and (P <= PLen)) do begin
      if T > TLen then begin
        if (Pattern[P] = KLEENE_STAR) and (P+1 > PLen) then
          Result := mVALID else
          Result := mABORT;
        exit;
      end else
      case Pattern[P] of
        KLEENE_STAR:
          Result := MatchAfterStar(Copy(Pattern,P,PLen),Copy(Text,T,TLen));
        RANGE_OPEN: begin
          Inc(P);
          Invert := False;
          if (Pattern[P] = EXCLAMATION_NEGATE) or
            (Pattern[P] = CARET_NEGATE) then begin
            Invert := True;
            Inc(P);
          end;
          if (Pattern[P] = RANGE_CLOSE) then begin
            Result := mPATTERN;
            Exit;
          end;
          MemberMatch := False;
          while Pattern[P] <> RANGE_CLOSE do begin
            RangeStart := P;
            RangeEnd := P;
            Inc(P);
            if P > PLen then begin
              Result := mPATTERN;
              Exit;
            end;
            if Pattern[P] = RANGE then begin
              Inc(P);
              RangeEnd := P;
              if (P > PLen) or (Pattern[RangeEnd] = RANGE_CLOSE) then begin
                Result := mPATTERN;
                Exit;
              end;
              Inc(P);
            end;
            if P > PLen then begin
              Result := mPATTERN;
              Exit;
            end;
            if RangeStart < RangeEnd then begin
              if (Text[T] >= Pattern[RangeStart]) and
                 (Text[T] <= Pattern[RangeEnd]) then begin
                MemberMatch := True;
                break;
              end;
            end
            else begin
              if (Text[T] >= Pattern[RangeEnd]) and
                 (Text[T] <= Pattern[RangeStart]) then begin
                MemberMatch := True;
                break;
              end;
            end;
          end;
          if (Invert and MemberMatch) or (not (Invert or MemberMatch)) then begin
            Result := mRANGE;
            Exit;
          end;
          if MemberMatch then
            while (P <= PLen) and (Pattern[P] <> RANGE_CLOSE) do
              Inc(P);
          if P > PLen then begin
            Result := mPATTERN;
            Exit;
          end;
        end;
      else
        if Pattern[P] <> SINGLE then
          if Pattern[P] <> Text[T] then
            Result := mLITERAL;
      end;
      Inc(P);
      Inc(T);
    end;
    if Result = mNONE then
      if T <= TLen then
        Result := mEND else
        Result := mVALID;
  end;

  function MatchAfterStar(Pattern, Text: RawUTF8): TMatch;
  var P, T, PLen, TLen: Integer;
  begin
    Result := mNONE;
    P := 1;
    T := 1;
    PLen := Length(Pattern);
    TLen := Length(Text);
    if TLen = 1 then begin
      Result := mVALID;
      Exit;
    end else
    if (PLen = 0) or (TLen = 0) then begin
      Result := mABORT;
      Exit;
    end;
    while ((T <= TLen) and (P < PLen)) and ((Pattern[P] = SINGLE) or
      (Pattern[P] = KLEENE_STAR)) do begin
      if Pattern[P] = SINGLE then
        Inc(T);
      Inc(P);
    end;
    if T >= TLen then begin
      Result := mABORT;
      Exit;
    end else
    if P >= PLen then begin
      Result := mVALID;
      Exit;
    end;
    repeat
      if (Pattern[P] = Text[T]) or (Pattern[P] = RANGE_OPEN) then begin
        Pattern := Copy(Pattern, P, PLen);
        Text := Copy(Text, T, TLen);
        PLen := Length(Pattern);
        TLen := Length(Text);
        p := 1;
        t := 1;
        Result  := Matche(Pattern, Text);
        if Result <> mVALID then
          Result := mNONE; // retry until end of Text, (check below) or Result valid
      end;
      Inc(T);
      if (T > TLen) or (P > PLen) then begin
        Result := mABORT;
        Exit;
      end;
    until Result <> mNONE;
  end;

begin // IsMatch() main block
  if CaseInsensitive then
    Result := (Matche(LowerCase(Pattern), LowerCase(Text)) = mVALID) else
    Result := (Matche(Pattern, Text) = mVALID);
end;


{ TSynFilterOrValidate }

constructor TSynFilterOrValidate.Create(const aParameters: RawUTF8);
begin
  inherited Create;
  SetParameters(aParameters); // should parse the JSON-encoded parameters
end;

constructor TSynFilterOrValidate.CreateUTF8(const Format: RawUTF8;
  const Args, Params: array of const);
begin
  Create(FormatUTF8(Format,Args,Params,true));
end;

procedure TSynFilterOrValidate.SetParameters(Value: RawUTF8);
begin
  fParameters := Value;
end;

function TSynFilterOrValidate.AddOnce(var aObjArray: TSynFilterOrValidateObjArray;
  aFreeIfAlreadyThere: boolean): TSynFilterOrValidate;
var i: integer;
begin
  if self<>nil then begin
    for i := 0 to length(aObjArray)-1 do
      if (PPointer(aObjArray[i])^=PPointer(self)^) and
         (aObjArray[i].fParameters=fParameters) then begin
        if aFreeIfAlreadyThere then
          Free;
        result := aObjArray[i];
        exit;
      end;
    ObjArrayAdd(aObjArray,self);
  end;
  result := self;
end;


{ TSynFilterUpperCase }

procedure TSynFilterUpperCase.Process(aFieldIndex: integer; var Value: RawUTF8);
begin
  Value := SynCommons.UpperCase(Value);
end;


{ TSynFilterUpperCaseU }

procedure TSynFilterUpperCaseU.Process(aFieldIndex: integer; var Value: RawUTF8);
begin
  Value := UpperCaseU(Value);
end;


{ TSynFilterLowerCase }

procedure TSynFilterLowerCase.Process(aFieldIndex: integer; var Value: RawUTF8);
begin
  Value := LowerCase(Value);
end;


{ TSynFilterLowerCaseU }

procedure TSynFilterLowerCaseU.Process(aFieldIndex: integer; var Value: RawUTF8);
begin
  Value := LowerCaseU(Value);
end;


{ TSynFilterTrim }

procedure TSynFilterTrim.Process(aFieldIndex: integer; var Value: RawUTF8);
begin
  Value := Trim(Value);
end;


{ TSynFilterTruncate}

procedure TSynFilterTruncate.SetParameters(Value: RawUTF8);
var V: TPUtf8CharDynArray;
begin
  JSONDecode(Value,['MaxLength','UTF8Length'],V);
  fMaxLength := GetCardinalDef(V[0],0);
  fUTF8Length := IdemPChar(V[1],'1') or IdemPChar(V[1],'TRUE');
end;

procedure TSynFilterTruncate.Process(aFieldIndex: integer; var Value: RawUTF8);
begin
  if fMaxLength-1<cardinal(maxInt) then
    if fUTF8Length then
      Utf8TruncateToLength(Value,fMaxLength) else
      Utf8TruncateToUnicodeLength(Value,fMaxLength);
end;


{ TSynValidateIPAddress }

function TSynValidateIPAddress.Process(aFieldIndex: integer; const Value: RawUTF8;
  var ErrorMsg: string): boolean;
begin
  result := IsValidIP4Address(pointer(Value));
  if not result then
    ErrorMsg := Format(sInvalidIPAddress,[UTF8ToString(Value)]);
end;


{ TSynValidateEmail }

function TSynValidateEmail.Process(aFieldIndex: integer; const Value: RawUTF8;
  var ErrorMsg: string): boolean;
var TLD,DOM: RawUTF8;
    i: integer;
const TopLevelTLD: array[0..19] of PUTF8Char = (
  // see http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
  'aero','asia','biz','cat','com','coop','edu','gov','info','int','jobs',
  'mil','mobi','museum','name','net','org','pro','tel','travel'); // no xxx !
begin
  if IsValidEmail(pointer(Value)) then
  repeat
    DOM := lowercase(copy(Value,PosEx('@',Value)+1,100));
    if length(DOM)>63 then
      break; // exceeded 63-character limit of a DNS name
    if (ForbiddenDomains<>'') and (FindCSVIndex(pointer(ForbiddenDomains),DOM)>=0) then
      break;
    i := length(Value);
    while (i>0) and (Value[i]<>'.') do dec(i);
    TLD := lowercase(copy(Value,i+1,100));
    if (AllowedTLD<>'') and (FindCSVIndex(pointer(AllowedTLD),TLD)<0) then
      break;
    if (ForbiddenTLD<>'') and (FindCSVIndex(pointer(ForbiddenTLD),TLD)>=0) then
      break;
    if not fAnyTLD then
      if FastFindPUTF8CharSorted(@TopLevelTLD,high(TopLevelTLD),pointer(TLD),@StrComp)<0 then
        if length(TLD)<>2 then
          break; // assume a two chars string is a ISO 3166-1 alpha-2 code
    result := true;
    exit;
  until true;
  ErrorMsg := Format(sInvalidEmailAddress,[UTF8ToString(Value)]);
  result := false;
end;

procedure TSynValidateEmail.SetParameters(Value: RawUTF8);
var V: TPUtf8CharDynArray;
begin
  inherited;
  JSONDecode(Value,['AllowedTLD','ForbiddenTLD','ForbiddenDomains','AnyTLD'],V);
  AllowedTLD := LowerCase(V[0]);
  ForbiddenTLD := LowerCase(V[1]);
  ForbiddenDomains  := LowerCase(V[2]);
  AnyTLD := IdemPChar(V[3],'1') or IdemPChar(V[3],'TRUE');
end;


{ TSynValidatePattern }

function TSynValidatePattern.Process(aFieldIndex: integer; const Value: RawUTF8;
  var ErrorMsg: string): boolean;
begin
  result := IsMatch(fParameters,Value,ClassType=TSynValidatePatternI);
  if not result then
    ErrorMsg := Format(sInvalidPattern,[UTF8ToString(Value)]);
end;


{ TSynValidateNonVoidText }

function Character01n(n: integer): string;
begin
  if n<0 then
    n := 0 else
  if n>1 then
    n := 2;
  result := GetCSVItemString(pointer(string(sCharacter01n)),n);
end;

procedure InvalidTextLengthMin(min: integer; var result: string);
begin
  result := Format(sInvalidTextLengthMin,[1,Character01n(1)]);
end;

function TSynValidateNonVoidText.Process(aFieldIndex: integer; const Value: RawUTF8;
  var ErrorMsg: string): boolean;
begin
  if Value='' then begin
    InvalidTextLengthMin(1,ErrorMsg);
    result := false;
  end else
    result := true;
end;


{ TSynValidateText }

procedure TSynValidateText.SetErrorMsg(fPropsIndex, InvalidTextIndex,
  MainIndex: integer; var result: string);
var P: PChar;
begin
  P := pointer(string(sInvalidTextChar));
  result := GetCSVItemString(P,MainIndex);
  if fPropsIndex>0 then
    result := Format(result,
      [fProps[fPropsIndex],GetCSVItemString(P,InvalidTextIndex),
       Character01n(fProps[fPropsIndex])]);
end;

function TSynValidateText.Process(aFieldIndex: integer; const Value: RawUTF8;
  var ErrorMsg: string): boolean;
var i, L: cardinal;
    Min: array[2..7] of cardinal;
begin
  result := false;
  if fUTF8Length then
    L := length(Value) else
    L := Utf8ToUnicodeLength(pointer(Value));
  if L<MinLength then
    InvalidTextLengthMin(MinLength,ErrorMsg) else
  if L>MaxLength then
    ErrorMsg := Format(sInvalidTextLengthMax,[MaxLength,Character01n(MaxLength)]) else begin
    fillchar(Min,sizeof(Min),0);
    L := length(Value);
    for i := 1 to L do
    case Value[i] of
      ' ':
        inc(Min[7]);
      'a'..'z': begin
        inc(Min[2]);
        inc(Min[5]);
      end;
      'A'..'Z': begin
        inc(Min[2]);
        inc(Min[6]);
      end;
      '0'..'9':
        inc(Min[3]);
      '_','!',';','.',',','/',':','?','%','$','=','"','#','@','(',')','{','}',
      '+','''','-','*':
        inc(Min[4]);
    end;
    for i := 2 to 7 do
      if Min[i]<fProps[i] then begin
        SetErrorMsg(i,i,0,ErrorMsg);
        exit;
      end else
      if Min[i]>fProps[i+8] then begin
        SetErrorMsg(i+8,i,1,ErrorMsg);
        exit;
      end;
    if Value<>'' then begin
      if MaxLeftTrimCount<cardinal(maxInt) then begin
        // if MaxLeftTrimCount is set, check against Value
        i := 0;
        while (i<L) and (Value[i+1]=' ') do inc(i);
        if i>MaxLeftTrimCount then begin
          SetErrorMsg(0,0,8,ErrorMsg);
          exit;
        end;
      end;
      if MaxRightTrimCount<cardinal(maxInt) then begin
        // if MaxRightTrimCount is set, check against Value
        i := 0;
        while (i<L) and (Value[L-i]=' ') do dec(i);
        if i>MaxRightTrimCount then begin
          SetErrorMsg(0,0,9,ErrorMsg);
          exit;
        end;
      end;
    end;
    result := true;
  end;
end;

procedure TSynValidateText.SetParameters(Value: RawUTF8);
var V: TPUtf8CharDynArray;
    i: integer;
const DEFAULT: TSynValidateTextProps = (
  1,maxInt,0,0,0,0,0,0,maxInt,maxInt,maxInt,maxInt,maxInt,maxInt,maxInt,maxInt);
begin
  if (MinLength=0) and (MaxLength=0) then  // if not previously set
    fProps := DEFAULT;
  inherited SetParameters(Value);
  if Value='' then
    exit;
  JSONDecode(Value,['MinLength','MaxLength',
    'MinAlphaCount','MinDigitCount','MinPunctCount',
    'MinLowerCount','MinUpperCount','MinSpaceCount',
    'MaxLeftTrimCount','MaxRightTrimCount',
    'MaxAlphaCount','MaxDigitCount','MaxPunctCount',
    'MaxLowerCount','MaxUpperCount','MaxSpaceCount',
    'UTF8Length'],V);
  if length(V)<>length(fProps)+1 then
    exit;
  for i := 0 to high(fProps) do
    fProps[i] := GetCardinalDef(V[i],fProps[i]);
  fUTF8Length := IdemPChar(V[length(fProps)],'1') or
                 IdemPChar(V[length(fProps)],'TRUE');
end;


{ TSynValidatePassWord }

procedure TSynValidatePassWord.SetParameters(Value: RawUTF8);
const DEFAULT: TSynValidateTextProps = (
  5,20,1,1,1,1,1,0,maxInt,maxInt,maxInt,maxInt,maxInt,maxInt,maxInt,0);
begin
  // set default values for validating a strong password
  fProps := DEFAULT;
  // read custom parameters
  inherited;
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;

procedure ConsoleWaitForEnterKey;
{$ifdef DELPHI5OROLDER}
begin
  readln;
end;
{$else}
  function KeyPressed(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;
var msg: TMsg;
begin
  while not KeyPressed(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
  if ord(color)=TextAttr then
    exit;
  TextAttr := ord(color);
  if ord(color)>=8 then
    write(#27'[1;3') else
    write(#27'[0;3');
  write(AnsiTbl[(ord(color) and 7)+1],'m');
end;
{$I+}

procedure TextBackground(Color: TConsoleColor);
begin // not implemented yet - but not needed either
end;

procedure ConsoleWaitForEnterKey;
begin
  Readln;
end;

{$endif MSWINDOWS}

{$I-}
procedure ConsoleShowFatalException(E: Exception);
begin
  TextColor(ccLightRed);
  write(#13#10'Fatal exception ');
  TextColor(ccWhite);
  write(E.ClassName);
  TextColor(ccLightRed);
  Writeln(' raised with message:'#13#10' ',E.Message);
  TextColor(ccLightGray);
  writeln(#13#10'Program will now abort');
  {$ifndef LINUX}
  writeln('Press [Enter] to quit');
  if ioresult=0 then
    Readln;
  {$endif}
end;
{$I+}


{ ************ Unit-Testing classes and functions }

function KB(bytes: Int64): RawUTF8;
begin
  if bytes>=1024*1024 then begin
    if bytes>=1024*1024*1024 then begin
      bytes := bytes shr 10;
      result := ' GB';
    end else
      result := ' MB';
    result := UInt32ToUtf8(bytes shr 20)+'.'+
              UInt32ToUtf8((PtrUInt(bytes) and pred(1 shl 20))div (102*1024))+
              result;
  end else
  if bytes>1023*9 then
    result := UInt32ToUtf8(PtrUInt(bytes) shr 10)+' KB' else
    result := UInt32ToUtf8(PtrUInt(bytes))+' B';
end;

function IntToThousandString(Value: integer; const ThousandSep: RawUTF8=','): RawUTF8;
var i,L,Len: cardinal;
begin
  Int32ToUtf8(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): RawUTF8;
function TwoDigitToString(value: cardinal): RawUTF8;
var L: integer;
begin
  UInt32ToUtf8(value,result);
  L := length(result);
  if L=1 then
    result := '0.0'+result else // '3' -> '0.03'
  if L=2 then
    result := '0.'+result else // '35' -> '0.35'
    insert('.',result,L-1); // '103' -> '1.03'
end;
begin
  if Micro<=0 then
    result := '0us' else
  if Micro<1000 then
    result := UInt32ToUtf8(Int64Rec(Micro).Lo)+'us' else
  if Micro<1000*1000 then
    result := TwoDigitToString(Micro div 10)+'ms' else
    result := TwoDigitToString(Micro div (10*1000))+'s';
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;


{ TPrecisionTimer }

function TPrecisionTimer.ByCount(Count: QWord): RawUTF8;
begin
  if Count=0 then
    result := '0' else // avoid div per 0 exception
    result := MicroSecToString(iTime div Count);
end;

function TPrecisionTimer.PerSec(const Count: QWord): QWord;
begin
  if iTime<=0 then // avoid negative value in case of incorrect Start/Stop sequence
    result := 0 else // avoid div per 0 exception
    result := (Count*QWord(1000*1000)) div iTime;
end;

procedure TPrecisionTimer.Init;
begin
  FillChar(self,sizeof(self),0);
end;

procedure TPrecisionTimer.Start;
begin
  FillChar(self,sizeof(self),0);
  QueryPerformanceCounter(iStart);
  iLast := iStart;
end;

procedure TPrecisionTimer.ComputeTime;
begin
  QueryPerformanceCounter(iStop);
  if iFreq=0 then begin
    QueryPerformanceFrequency(iFreq);
    if iFreq=0 then begin
      iTime := 0;
      iLastTime := 0;
      exit;
    end;
  end;
  iTime := ((iStop-iStart)*QWord(1000*1000))div iFreq;
  iLastTime := ((iStop-iLast)*QWord(1000*1000))div iFreq;
end;

procedure TPrecisionTimer.FromExternalQueryPerformanceCounters(const CounterDiff: Int64);
begin // very close to ComputeTime
  iLastTime := 0;
  if iFreq=0 then begin
    iTime := 0;
    QueryPerformanceFrequency(iFreq);
    if iFreq=0 then
      exit;
  end;
  if CounterDiff<=0 then
    exit;
  iLastTime := (CounterDiff*QWord(1000*1000))div iFreq;
  inc(iTime,iLastTime);
end;

function TPrecisionTimer.Stop: RawUTF8;
begin
  ComputeTime;
  result := Time;
end;

procedure TPrecisionTimer.Pause;
begin
  QueryPerformanceCounter(iResume);
  dec(iResume,iStart);
  inc(fPauseCount);
end;

procedure TPrecisionTimer.Resume;
begin
  QueryPerformanceCounter(iStart);
  iLast := iStart;
  dec(iStart,iResume);
  iResume := 0;
end;

function TPrecisionTimer.Time: RawUTF8;
begin
  result := MicroSecToString(iTime);
end;

function TPrecisionTimer.LastTime: RawUTF8;
begin
  result := MicroSecToString(iLastTime);
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 iStart=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: RawUTF8;
begin
  result := fTimer.Stop;
end;

constructor TLocalPrecisionTimer.CreateAndStart;
begin
  inherited;
  fTimer.Start;
end;

{ TSynMonitorTime }

function TSynMonitorTime.GetAsText: RawUTF8;
begin
  result := MicroSecToString(fMicroSeconds);
end;

function TSynMonitorTime.PerSecond(const aValue: QWord): QWord;
begin
  if PInt64(@fMicroSeconds)^<=0 then // avoid negative or div per 0
    result := 0 else
    result := (aValue*QWord(1000*1000)) div fMicroSeconds;
end;


{ TSynMonitorSize }

function TSynMonitorSize.GetAsText: RawUTF8;
begin
  result := KB(fBytes);
end;

{ TSynMonitorThroughput }

function TSynMonitorThroughput.GetAsText: RawUTF8;
begin
  result := KB(fBytesPerSec)+'/s';
end;


{$ifdef MSWINDOWS}
{$ifndef DELPHI5OROLDER}

{ TSynFPUException }

{$ifdef FPC}
function TSynFPUException._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TSynFPUException._AddRef: Integer;
{$endif}
begin
  if fRefCount=0 then begin
    fSaved8087 := Get8087CW;
    Set8087CW(fExpected8087); // set FPU exceptions mask
  end;
  inc(fRefCount);
  result := 1; // should never be 0 (mark release of TSynFPUException instance)
end;

{$ifdef FPC}
function TSynFPUException._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TSynFPUException._Release: Integer;
{$endif}
begin
  dec(fRefCount);
  if fRefCount=0 then
    Set8087CW(fSaved8087);
  result := 1; // should never be 0 (mark release of TSynFPUException instance)
end;

{$ifdef FPC}
function TSynFPUException.QueryInterface(
    {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
{$else}
function TSynFPUException.QueryInterface(const IID: TGUID; out Obj): HResult;
{$endif}
begin
  Result := E_NOINTERFACE;
end;

threadvar
  GlobalSynFPUExceptionDelphi,
  GlobalSynFPUExceptionLibrary: TSynFPUException;

constructor TSynFPUException.Create(Expected8087Flag: word);
begin // $1332=Delphi $133F=library (mask all exceptions)
  inherited Create;
  fExpected8087 := Expected8087Flag;
end;

class function TSynFPUException.ForLibraryCode: IUnknown;
begin
  if GlobalSynFPUExceptionLibrary=nil then begin
    GlobalSynFPUExceptionLibrary := TSynFPUException.Create($133F);
    GarbageCollector.Add(GlobalSynFPUExceptionLibrary);
  end;
  result := GlobalSynFPUExceptionLibrary;
end;

class function TSynFPUException.ForDelphiCode: IUnknown;
begin
  if GlobalSynFPUExceptionDelphi=nil then begin
    GlobalSynFPUExceptionDelphi := TSynFPUException.Create($1332);
    GarbageCollector.Add(GlobalSynFPUExceptionDelphi);
  end;
  result := GlobalSynFPUExceptionDelphi;
end;

{$endif DELPHI5OROLDER}
{$endif MSWINDOWS}


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


type
  /// used by TAutoLocker
  TAutoLock = class(TInterfacedObject)
  protected
    fLock: TAutoLocker;
  public
    constructor Create(aLock: TAutoLocker);
    destructor Destroy; override;
  end;

{ TAutoLock }

constructor TAutoLock.Create(aLock: TAutoLocker);
begin
  fLock := aLock;
  fLock.Enter;
end;

destructor TAutoLock.Destroy;
begin
  fLock.Leave;
end;


{ TAutoLocker }

constructor TAutoLocker.Create;
begin
  InitializeCriticalSection(fLock);
end;

destructor TAutoLocker.Destroy;
begin
  DeleteCriticalSection(fLock);
  inherited;
end;

function TAutoLocker.ProtectMethod: IUnknown;
begin
  result := TAutoLock.Create(self);
end;

procedure TAutoLocker.Enter;
begin
  EnterCriticalSection(fLock);
end;

procedure TAutoLocker.Leave;
begin
  LeaveCriticalSection(fLock);
end;


{$ifndef DELPHI5OROLDER} // internal error C3517 under Delphi 5 :(
{$ifndef NOVARIANTS}

{ TLockedDocVariant }

constructor TLockedDocVariant.Create;
begin
  Create(JSON_OPTIONS[true]);
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 begin
      result := false;
      exit;
    end;
    Value := fValue.Values[i];
    result := true;
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.Replace(
  const Name: RawUTF8; const Value: Variant; out LocalValue: Variant);
begin
  SetValue(Name,Value);
  LocalValue := Value;
end;

function TLockedDocVariant.AddExistingProp(const Name: RawUTF8; var Obj: variant): boolean;
var i: integer;
begin
  fLock.Enter;
  try
    i := fValue.GetValueIndex(Name);
    if i<0 then begin
      result := false;
      exit;
    end;
    _ObjAddProps([Name,fValue.Values[i]],Obj);
    result := true;
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.AddNewProp(const Name: RawUTF8; const Value: variant;
  var Obj: variant);
begin
  SetValue(Name,Value);
  _ObjAddProps([Name,Value],Obj);
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.AddValue(Name,Value);
  finally
    fLock.Leave;
  end;
end;

procedure TLockedDocVariant.Clear;
begin
  fLock.Enter;
  try
    fValue.Clear;
    fValue.Init();
  finally
    fLock.Leave;
  end;
end;

{$endif NOVARIANTS}
{$endif DELPHI5OROLDER} 


function GetDelphiCompilerVersion: RawUTF8;
begin
  result :=
{$ifdef FPC}
  'Free Pascal'
  {$ifdef VER2_6_4}+' 2.6.4'{$endif}
  {$ifdef VER2_7_0}+' 2.7.0'{$endif}
  {$ifdef VER2_7_1}+' 2.7.1'{$endif}
  {$ifdef VER3_0_1}+' 3.0.1'{$endif}
  {$ifdef VER3_1_1}+' 3.1.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'
    {$ifend}
  {$endif CONDITIONALEXPRESSIONS}
{$endif}
{$ifdef CPU64}
  +' 64 bit'
{$endif}
end;


{ TSynCriticalSection }

{$ifndef DELPHI5OROLDER}
{$ifndef HASINLINE}
function TSynCriticalSection.TryEnter: boolean;
begin
  result := TryEnterCriticalSection(FSection);
end;
{$endif}
{$endif}


{ TSynCache }

procedure TSynCache.Add(const aValue: RawUTF8; aTag: PtrInt);
begin
  if (self=nil) or (fFindLastAddedIndex<0) then
    // fFindLastAddedIndex should have been set by a previous call to Find() 
    exit;
  inc(fValueSize,length(aValue));
  if fValueSize>fMaxCacheRamUsed then begin
    // if tends to consume too much memory, restart caching (fast in practice)
    Reset;
    exit;
  end;
  // add the cache entry values (text+integer)
  with fNameValue.List[fFindLastAddedIndex] do begin
    Tag := aTag;
    Value := aValue;
  end;
  fFindLastAddedIndex := -1;
end;

constructor TSynCache.Create(aMaxCacheRamUsed: cardinal=16384*1024; aCaseSensitive: boolean=false);
begin
  fNameValue.Init(aCaseSensitive);
  fNameValue.fDynArray.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}Capacity := 200; // some space for future cached entries
  fMaxCacheRamUsed := aMaxCacheRamUsed;
  fFindLastAddedIndex := -1;
end;

function TSynCache.Find(const aKey: RawUTF8; aResultTag: PPtrInt): RawUTF8;
var added: boolean;
begin
  result := '';
  if Self<>nil then
    if aKey='' then
      fFindLastAddedIndex := -1 else begin
      fFindLastAddedIndex := fNameValue.fDynArray.FindHashedForAdding(aKey,added);
      if added then
        fNameValue.List[fFindLastAddedIndex].Name := 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.Reset: boolean;
begin
  result := false;
  if self=nil then
    exit; // avoid GPF
  if Count<>0 then begin
    if fValueSize<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.ReHash; // will force reset all hash content
    result := true; // mark something was flushed
  end;
  fFindLastAddedIndex := -1;
  fValueSize := 0;
end;

{$ifdef VER220}
function TSynCache.Count: integer;
begin
  result := fNameValue.Count;
end;
{$endif}


{ 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 begin
        inc(capacity,256+fCount shr 3);
        SetLength(fList,capacity);
      end;
      fList[result] := aText;
      inc(fCount);
      Changed;
    end else
    result := AddObject(aText,nil);
end;

function TRawUTF8List.AddObjectIfNotExisting(const aText: RawUTF8; aObject: TObject): PtrInt;
begin
  result := IndexOf(aText);
  if result<0 then
    result := AddObject(aText,aObject);
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
    inc(capacity,256+fCount shr 3);
    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);
  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;
  fList[Index] := ''; // release corresponding memory
  dec(fCount);
  if (fObjects<>nil) and fObjectsOwned then
    FreeAndNil(fObjects[Index]);
  if Index<fCount then begin
    move(fList[Index+1],fList[Index],(fCount-Index)*sizeof(fList[0]));
    PPointer(@fList[fCount])^ := nil; // avoid GPF
    if fObjects<>nil then begin
      move(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.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;
var Sep: PUTF8Char;
begin
  result := Get(Index);
  if result='' then
    exit;
  Sep := PosChar(pointer(result),NameValueSep);
  if Sep=nil then
    result := '' else
    SetLength(result,Sep-pointer(result));
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) or (fObjects=nil) then
    result := nil else begin
    ndx := IndexOf(Name);
    if ndx<PtrUInt(fCount) then
      result := fObjects[ndx] else
      result := nil;
  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
      Move(pointer(fList[i])^,P^,Len);
      inc(P,Len);
    end;
    inc(i);
    if i>=fCount then
      Break;
    Move(pointer(Delimiter)^,P^,DelimLen);
    inc(P,DelimLen);
  until false;
end;

procedure TRawUTF8List.SaveToStream(Dest: TStream; const Delimiter: RawUTF8);
var W: TTextWriter;
    i: integer;
begin
  if (self=nil) or (fCount=0) then
    exit;
  W := TTextWriter.Create(Dest,8192); // faster with a 8KB intermediate buffer
  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;
var Sep: PUTF8Char;
begin
  if (self=nil) or (PtrUInt(Index)>=PtrUInt(fCount)) then
    result := '' else
    result := Get(Index);
  if result='' then
    exit;
  Sep := PosChar(pointer(result),NameValueSep);
  if Sep=nil then
    result := '' else
    result := Sep+1; // get 'Value' from 'Name=Value'
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
{$ifdef CPU64}
    for result := 0 to fCount-1 do
      if fObjects[result]=aObject then
        exit;
{$else}
    result := IntegerScanIndex(pointer(fObjects),fCount,cardinal(aObject)) else
{$endif}
  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),Delimiter);
end;

procedure TRawUTF8List.LoadFromFile(const FileName: TFileName);
var Map: TMemoryMap;
    P: pointer;
begin
  if Map.Map(FileName) then
  try
    if Map.Size<>0 then begin
      if TextFileKind(Map)=isUTF8 then // ignore UTF-8 BOM
        P := Map.Buffer+3 else
        P := Map.Buffer;
      SetTextPtr(P,#13#10);
    end;
  finally
    Map.UnMap;
  end;
end;

procedure TRawUTF8List.SetTextPtr(P: 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) then begin
    DelimFirst := Delimiter[1];
    DelimNext := PUTF8Char(pointer(Delimiter))+1;
    repeat
      PBeg := P;
      while P^<>#0 do begin
        if (P^=DelimFirst) and CompareMem(P+1,DelimNext,DelimLen-1) then
          break;
        inc(P);
      end;
      SetString(Line,PBeg,P-PBeg);
      AddObject(Line,nil);
      if P^=#0 then
        break;
      inc(P,DelimLen);
    until P^=#0;
  end;
  EndUpdate;
end;

procedure TRawUTF8List.SetTextCRLF(const Value: RawUTF8);
begin
  SetTextPtr(pointer(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;


{ 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);
  fHashValid := false;
end;

procedure TObjectListHashedAbstract.Delete(aObject: TObject);
begin
  Delete(IndexOf(aObject));
end;



{ TObjectListHashed }

const
  // hashing will start only when List[] reachs 32 items (not worth it before)
  TOBJECTLISTHASHED_START_HASHING_COUNT = 32;

function TObjectListHashed.Add(aObject: TObject; out wasAdded: boolean): integer;
begin
  wasAdded := false;
  if self<>nil then
    if fHashed then begin
      if not fHashValid then begin
        fHash.ReHash;
        fHashValid := true;
      end;
      result := fHash.FindHashedForAdding(aObject,wasAdded);
      if wasAdded then
        fList[result] := aObject;
    end else begin
      for result := 0 to fCount-1 do
        if fList[result]=aObject then
          exit;
      wasAdded := true;
      result := fHash.Add(aObject);
      if fCount>=TOBJECTLISTHASHED_START_HASHING_COUNT then
        fHashed := true;    
    end
  else
    result := -1;
end;

function TObjectListHashed.IndexOf(aObject: TObject): integer;
begin
  if (self<>nil) and (fCount>0) then 
    if fHashed then begin
      if not fHashValid then begin
        fHash.ReHash;
        fHashValid := true;
      end;
      result := fHash.FindHashed(aObject);
      exit;
    end else
    for result := 0 to fCount-1 do
      if fList[result]=aObject then
        exit;
  result := -1;
end;


{ TObjectListPropertyHashed }

constructor TObjectListPropertyHashed.Create(
  aSubPropAccess: TObjectListPropertyHashedAccessProp;
  aHashElement: TDynArrayHashOne; aCompare: TDynArraySortCompare;
  aFreeItems: boolean);
begin
  inherited Create(aFreeItems);
  fSubPropAccess := aSubPropAccess;
  if @aHashElement<>nil then
    fHash.fHashElement := aHashElement;
  if @aCompare<>nil then
    fHash.{$ifdef UNDIRECTDYNARRAY}InternalDynArray.{$endif}fCompare := aCompare;
  fHash.EventCompare := IntComp;
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;

procedure TObjectListPropertyHashed.IntHashValid;
begin
  fHash.ReHash(IntHash);
  fHashValid := true;
end;

function TObjectListPropertyHashed.Add(aObject: TObject; out wasAdded: boolean): integer;
begin
  wasAdded := false;
  if self<>nil then
    if fHashed then begin
      if not fHashValid then 
        IntHashValid;
      result := fHash.FindHashedForAdding(aObject,wasAdded,
        fHash.fHashElement(aObject,fHash.fHasher));
      if wasAdded then
        fList[result] := aObject;
    end else begin
      for result := 0 to fCount-1 do
        if IntComp(fList[result],aObject)=0 then
          exit;
      wasAdded := true;
      result := fHash.Add(aObject);
      if fCount>=TOBJECTLISTHASHED_START_HASHING_COUNT then
        fHashed := true;    
    end
  else
    result := -1;
end;

function TObjectListPropertyHashed.IndexOf(aObject: TObject): integer;
begin
  if (self<>nil) and (fCount>0) then 
    if fHashed then begin
      if not fHashValid then
        IntHashValid;
      result := fHash.HashFind(fHash.fHashElement(aObject,fHash.fHasher),PtrInt(aObject));
      if result>=0 then
        exit; // if found
    end else
    for result := 0 to fCount-1 do
      if IntComp(fList[result],aObject)=0 then
        exit;
  result := -1;
end;


{ TObjectListLocked }

constructor TObjectListLocked.Create(AOwnsObjects: Boolean=true);
begin
  inherited Create(AOwnsObjects);
  InitializeCriticalSection(fLock);
end;

destructor TObjectListLocked.Destroy;
begin
  inherited Destroy;
  DeleteCriticalSection(fLock);
end;

procedure TObjectListLocked.Lock;
begin
  EnterCriticalSection(fLock);
end;

procedure TObjectListLocked.UnLock;
begin
  LeaveCriticalSection(fLock);
end;


{ TRawUTF8ListHashed }

constructor TRawUTF8ListHashed.Create(aOwnObjects: boolean);
begin
  inherited Create(aOwnObjects);
  fHash.Init(TypeInfo(TRawUTF8DynArray),fList,nil,nil,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_SORTFIRSTFIELD[not Value,djRawUTF8];
  fChanged := true; // force re-hash next IndexOf() call
end;

function TRawUTF8ListHashed.IndexOf(const aText: RawUTF8): PtrInt;
begin
  if fChanged then begin
    fHash.ReHash; // rough, but working implementation
    fChanged := false;
  end;
  result := fHash.FindHashed(aText);
end;

function TRawUTF8ListHashed.AddObjectIfNotExisting(
  const aText: RawUTF8; aObject: TObject): PtrInt;
var added: boolean;
begin
  if fChanged then begin
    fHash.ReHash; // rough, but working implementation
    fChanged := false;
  end;
  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;
end;


{ TRawUTF8ListHashedLocked }

constructor TRawUTF8ListHashedLocked.Create(aOwnObjects: boolean);
begin
  inherited Create(aOwnObjects);
  InitializeCriticalSection(fLock);
end;

destructor TRawUTF8ListHashedLocked.Destroy;
begin
  DeleteCriticalSection(fLock);
  inherited;
end;

procedure TRawUTF8ListHashedLocked.Lock;
begin
  EnterCriticalSection(fLock);
end;

procedure TRawUTF8ListHashedLocked.UnLock;
begin
  LeaveCriticalSection(fLock);
end;

function TRawUTF8ListHashedLocked.LockedIndexOf(const aText: RawUTF8): PtrInt;
begin
  Lock;
  try
    result := IndexOf(aText);
  finally
    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
    move(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;


{ TMemoryMap }

function TMemoryMap.Map(aFile: THandle; aCustomSize: cardinal; aCustomOffset: Int64): boolean;
var Available: Int64;
begin
  fBuf := nil;
  {$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) or (fFileSize>maxInt) then
    /// maxInt = $7FFFFFFF = 1.999 GB (2GB would induce PtrInt errors)
    exit;
  if aCustomSize=0 then
    fBufSize := Int64Rec(fFileSize).Lo else begin
    Available := fFileSize-aCustomOffset;
    if Available<0 then
      exit;
    if aCustomSize>Available then
      fBufSize := Int64Rec(Available).Lo;
      fBufSize := aCustomSize;
  end;
  {$ifdef MSWINDOWS}
  with Int64Rec(fFileSize) do
    fMap := CreateFileMapping(fFile,nil,PAGE_READONLY,Hi,Lo,nil);
  if fMap=0 then
    raise ESynException.Create('TMemoryMap.Map: CreateFileMapping()=0');
  with Int64Rec(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 (_SC_PAGE_SIZE-1)<>0 then
      raise ESynException.CreateUTF8('fpmmap(aCustomOffset=%) with pagesize=%',
        [aCustomOffset,_SC_PAGE_SIZE]) else
      aCustomOffset := aCustomOffset div _SC_PAGE_SIZE;
  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: cardinal);
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;
  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 then 
    {$ifdef KYLIX3}munmap{$else}fpmunmap{$endif}(fBuf,fBufSize);
  {$endif}
  fBuf := nil;
  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: integer);
begin
  inherited Create;
  SetPointer(Data,DataLen);
end;

function TSynMemoryStream.Write(const Buffer; Count: Integer): Longint;
begin
  raise EStreamError.Create('TSynMemoryStream.Write');
end;


{ TSynMemoryStreamMapped }

constructor TSynMemoryStreamMapped.Create(const aFileName: TFileName; aCustomSize: cardinal; aCustomOffset: Int64);
begin
  fFileName := aFileName; 
  fFileStream := TFileStream.Create(aFileName,fmOpenRead or fmShareDenyNone);
  Create(fFileStream.Handle);
end;

constructor TSynMemoryStreamMapped.Create(aFile: THandle; aCustomSize: cardinal; aCustomOffset: Int64);
begin
  if not fMap.Map(aFile) 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);
begin
  Create(TFileStream.Create(aFileName,fmCreate),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(fBuf,fBufLen);
end;

constructor TFileBufferWriter.Create(aClass: TStreamClass; BufLen: integer);
begin
  Create(aClass.Create,BufLen);
  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.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  result := fTotalWritten;
  fTotalWritten := 0;
end;

procedure TFileBufferWriter.CancelAll;
begin
  fTotalWritten := 0;
  fPos := 0;
  fStream.Seek(0,soBeginning);
end;

procedure TFileBufferWriter.Write(Data: pointer; DataLen: integer);
begin
  if (DataLen<=0) or (Data=nil) then
    exit;
  if fPos+DataLen>fBufLen then begin
    if fPos>0 then begin
      fStream.Write(pointer(fBuf)^,fPos);
      fPos := 0;
    end;
    if DataLen>fBufLen then begin
      fStream.Write(Data^,DataLen);
      inc(fTotalWritten,PtrUInt(DataLen));
      exit;
    end;
  end;
  move(Data^,PByteArray(fBuf)^[fPos],DataLen);
  inc(fPos,DataLen);
  inc(fTotalWritten,PtrUInt(DataLen));
end;

procedure TFileBufferWriter.Write1(Data: byte); 
begin
  if fPos+1>fBufLen then begin
    fStream.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  PByteArray(fBuf)^[fPos] := Data;
  inc(fPos);
  inc(fTotalWritten);
end;

procedure TFileBufferWriter.Write4(Data: integer);
begin
  if fPos+sizeof(integer)>fBufLen then begin
    fStream.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  PInteger(@PByteArray(fBuf)^[fPos])^ := Data;
  inc(fPos,sizeof(integer));
  inc(fTotalWritten,sizeof(integer));
end;

procedure TFileBufferWriter.Write8(const Data8Bytes);
begin
  if fPos+sizeof(Int64)>fBufLen then begin
    fStream.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  PInt64(@PByteArray(fBuf)^[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);
  WriteVarUInt32(L);
  if L=0 then
    exit;
  Write(pointer(Text),L);
end;

procedure TFileBufferWriter.WriteShort(const Text: ShortString);
begin
  Write1(ord(Text[0]));
  Write(@Text[1],ord(Text[0]));
end;

procedure TFileBufferWriter.WriteBinary(const Data: RawByteString);
begin
  Write(pointer(Data),Length(Data));
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.Write(pointer(fBuf)^,fPos);
    fPos := 0;
    if len>fBufLen then begin
      GetMem(tmp,len);
      buf := tmp;
    end else
      buf := pointer(fBuf);
  end else
    buf := @PByteArray(fBuf)^[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
    FreeMem(tmp);
end;
{$endif}

procedure TFileBufferWriter.WriteRawUTF8DynArray(const Values: TRawUTF8DynArray;
  ValuesCount: integer);
var PI: PPtrUIntArray;
    n, i, fixedsize: integer;
    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 (PInteger(PI^[i]-sizeof(integer))^<>fixedsize) then begin
        fixedsize := 0;
        break;
      end;
  WriteVarUInt32(fixedsize);
  repeat
    P := @PByteArray(fBuf)^[fPos];
    PEnd := @PByteArray(fBuf)^[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 := PInteger(PI^[i]-sizeof(integer))^; // fast length(Values[])
          if PtrUInt(P)+len>=PtrUInt(PEnd) then begin
            n := i;
            break; // avoid buffer overflow
          end;
          P := ToVarUInt32(len,P);
          Move(pointer(PI^[i])^,P^,len);
          inc(P,len);
        end else
      // fixed size strings case
      for i := 0 to ValuesCount-1 do begin
        if PtrUInt(P)+PtrUInt(fixedsize)>=PtrUInt(PEnd) then begin
          n := i;
          break; // avoid buffer overflow
        end;
        Move(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(PtrUInt(PI),n*sizeof(PtrInt));
      dec(ValuesCount,n);
      if ValuesCount=0 then
        break;
    end;
    fStream.Write(pointer(fBuf)^,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.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  pos := fPos;
  fPos := PtrUInt(ToVarUInt32(Value,@PByteArray(fBuf)^[fPos]))-PtrUInt(fBuf);
  inc(fTotalWritten,PtrUInt(fPos-Pos));
end;

procedure TFileBufferWriter.WriteVarInt64(Value: Int64);
var pos: integer;
begin
  if fPos+16>fBufLen then begin
    fStream.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  pos := fPos;
  fPos := PtrUInt(ToVarInt64(Value,@PByteArray(fBuf)^[fPos]))-PtrUInt(fBuf);
  inc(fTotalWritten,PtrUInt(fPos-Pos));
end;

procedure TFileBufferWriter.WriteVarUInt64(Value: QWord);
var pos: integer;
begin
  if fPos+16>fBufLen then begin
    fStream.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  end;
  pos := fPos;
  fPos := PtrUInt(ToVarUInt64(Value,@PByteArray(fBuf)^[fPos]))-PtrUInt(fBuf);
  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);
var n, i, pos, diff: integer;
    P: PByte;
    PI: PIntegerArray;
    PBeg, PEnd: PAnsiChar;
begin
  WriteVarUInt32(ValuesCount);
  if ValuesCount=0 then
    exit;
  PI := pointer(Values);
  PByteArray(fBuf)^[fPos] := ord(DataLayout);
  inc(fPos);
  inc(fTotalWritten);
  if DataLayout in [wkOffsetU, wkOffsetI] then begin
    pos := fPos;
    fPos := PtrUInt(ToVarUInt32(PI^[0],@PByteArray(fBuf)^[fPos]))-PtrUInt(fBuf);
    diff := PI^[1]-PI^[0];
    inc(PtrUInt(PI),4);
    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 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,@PByteArray(fBuf)^[fPos]))-PtrUInt(fBuf);
    inc(fTotalWritten,PtrUInt(fPos-pos));
    if diff<>0 then
      exit; // same offset for all items (fixed sized records) -> quit now
  end;
  repeat
    P := @PByteArray(fBuf)^[fPos];
    PEnd := @PByteArray(fBuf)^[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;
        Move(PI^,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(PI^[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(PI^[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(PI^[i]-PI^[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(PI^[i]-PI^[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(PI),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(PtrUInt(PI),n*4);
      fPos := PtrUInt(P)-PtrUInt(fBuf);
      inc(fTotalWritten,PtrUInt(fPos-pos));
      dec(ValuesCount,n);
      if ValuesCount=0 then
        break;
    end;
    fStream.Write(pointer(fBuf)^,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
    PByteArray(fBuf)^[fPos] := 1;
    fPos := PtrUInt(ToVarUInt64(PI^[0],@PByteArray(fBuf)^[fPos+1]))-PtrUInt(fBuf);
    diff := PI^[1]-PI^[0];
    inc(PtrUInt(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,@PByteArray(fBuf)^[fPos]))-PtrUInt(fBuf);
    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
    PByteArray(fBuf)^[fPos] := 0;
    inc(fPos);
  end;
  inc(fTotalWritten,PtrUInt(fPos-Pos));
  repeat
    P := @PByteArray(fBuf)^[fPos];
    PEnd := @PByteArray(fBuf)^[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 := ToVarUInt32(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(PtrUInt(PI),n*8);
      fPos := PtrUInt(P)-PtrUInt(fBuf);
      inc(fTotalWritten,PtrUInt(fPos-Pos));
      dec(ValuesCount,n);
      if ValuesCount=0 then
        break;
    end;
    fStream.Write(pointer(fBuf)^,fPos);
    fPos := 0;
  until false;
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]);
      fBufLen := maxSize+1024;
      SetString(fBuf,nil,fBufLen);
    end;
  end;
  result := @PByteArray(fBuf)^[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: cardinal);
begin
  fCurrentPos := 0;
  fMap.Map(aBuffer,aBufferSize);
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
        move(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(var 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: pointer;
begin
  if (fMap.fBuf=nil) or (fCurrentPos>=fMap.fBufSize) then
    result := nil else
    result := @fMap.fBuf[fCurrentPos];
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 ((c and $7f) shl n);
    until false;
    result := result or (c shl n);
  end;
end;

function TFileBufferReader.ReadVarInt64: Int64;
begin
  result := ReadVarUInt64;
  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(PtrUInt(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;
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]+integer(FromVarUInt32(P)); 
          dec(count);
          inc(PI);
        end;
      until count<=0;
      {$ifopt C+} inc(PI); {$endif} // to make assert() below work
    end else begin
      // same offset for all items (fixed sized records) 
      for i := 0 to count-1 do
        PIA^[i+1] := PIA^[i]+diff;
      {$ifopt C+} inc(PI,count+1); count := 0; {$endif} // for assert() below 
    end;
  end else
  repeat
    ReadChunk(P,PEnd,BufTemp); // raise ErrorInvalidContent on error
    while (count>0) and (PtrUInt(P)<PtrUInt(PEnd)) do begin
      PI^ := FromVarUInt64(P);
      dec(count);
      inc(PI);
    end;
  until count<=0;
  assert((count=0)and(PI=@Values[result]));
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
        SetString(PI^,PAnsiChar(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
      SetString(PI^,PAnsiChar(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 := Int64Rec(Offset).Lo;
    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;


{ TSynTable }


{$ifndef SORTCOMPAREMETHOD}

function SortU8(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        result := PByte(P1)^-PByte(P2)^;
        exit;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortU16(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        result := PWord(P1)^-PWord(P2)^;
        exit;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortI32(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        result := PInteger(P1)^-PInteger(P2)^;
        exit;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortI64(P1,P2: PUTF8Char): PtrInt;
var V: Int64;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        V := PInt64(P1)^-PInt64(P2)^;
        if V<0 then
          result := -1 else
        if V>0 then
          result := 1 else
          result := 0;
       end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortDouble(P1,P2: PUTF8Char): PtrInt;
var V: Double;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        V := PDouble(P1)^-PDouble(P2)^;
        if V<0 then
          result := -1 else
        if V=0 then
          result := 0 else
          result := 1;
       end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortU24(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        result := PtrInt(PWord(P1)^)+PtrInt(P1[2])shl 16
          -PtrInt(PWord(P2)^)-PtrInt(P2[2]) shl 16;
        exit;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortVarUInt32(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        result := FromVarUInt32(PByte(P1))-FromVarUInt32(PByte(P2));
        exit;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortVarInt32(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        result := FromVarInt32(PByte(P1))-FromVarInt32(PByte(P2));
        exit;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortVarUInt64(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then 
        result := FromVarUInt64(PByte(P1))-FromVarUInt64(PByte(P2)) else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortVarInt64(P1,P2: PUTF8Char): PtrInt;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then
        result := FromVarInt64(PByte(P1))-FromVarInt64(PByte(P2)) else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortStr(P1,P2: PUTF8Char): PtrInt;
var L1, L2, L, i: PtrInt;
    PB1, PB2: PByte;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        if PtrInt(P1^)<=$7F then begin
          L1 := PtrInt(P1^);
          inc(P1);
        end else begin
          PB1 := pointer(P1);
          L1 := FromVarUInt32High(PB1);
          P1 := pointer(PB1);
        end;
        if PtrInt(P2^)<=$7F then begin
          L2 := PtrInt(P2^);
          inc(P2);
        end else begin
          PB2 := pointer(P2);
          L2 := FromVarUInt32High(PB2);
          P2 := pointer(PB2);
        end;
        L := L1;
        if L2>L then
          L := L2;
        for i := 0 to L-1 do begin
          result := PtrInt(P1[i])-PtrInt(P2[i]);
          if Result<>0 then
            exit;
        end;
        result := L1-L2;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

function SortIStr(P1,P2: PUTF8Char): PtrInt;
var L1, L2, L, i: PtrInt;
    PB1, PB2: PByte;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then begin
        if PtrInt(P1^)<=$7F then begin
          L1 := PtrInt(P1^);
          inc(P1);
        end else begin
          PB1 := pointer(P1);
          L1 := FromVarUInt32High(PB1);
          P1 := pointer(PB1);
        end;
        if PtrInt(P2^)<=$7F then begin
          L2 := PtrInt(P2^);
          inc(P2);
        end else begin
          PB2 := pointer(P2);
          L2 := FromVarUInt32High(PB2);
          P2 := pointer(PB2);
        end;
        if L2>L1 then
          L := L2 else
          L := L1;
        for i := 0 to L-1 do // NormToUpperAnsi7 works for both WinAnsi & UTF-8
          if NormToUpperAnsi7[P1[i]]<>NormToUpperAnsi7[P2[i]] then begin
            result := PtrInt(P1[i])-PtrInt(P2[i]);
            exit;
          end;
        result := L1-L2;
      end else
        result := 1 else  // P2=nil
      result := -1 else // P1=nil
    result := 0;      // P1=P2
end;

const
  FIELD_SORT: array[TSynTableFieldType] of TUTF8Compare = (
    nil, // tftUnknown,
    SortU8,    SortU8,  SortU16,  SortU24,  SortI32, SortI64,
 // tftBoolean,tftUInt8,tftUInt16,tftUInt24,tftInt32,tftInt64,
    SortI64,  SortDouble, SortVarUInt32,SortVarInt32,SortVarUInt64,
 // tftCurrency,tftDouble, tftVarUInt32, tftVarInt32,tftVarUInt64,
    SortStr,   SortStr, SortStr,        nil,           SortVarInt64);
 // tftWinAnsi,tftUTF8, tftBlobInternal,tftBlobExternal,tftVarInt64);

{$endif SORTCOMPAREMETHOD}

const
  FIELD_FIXEDSIZE: array[TSynTableFieldType] of Integer = (
     0, // tftUnknown,
     1, 1, 2, 3, 4, 8, 8, 8,
     // tftBoolean, tftUInt8, tftUInt16, tftUInt24, tftInt32, tftInt64, tftCurrency, tftDouble
     -1, -1, -1, // tftVarUInt32, tftVarInt32, tftVarUInt64 have -1 as size
     -2, -2, -2, // tftWinAnsi, tftUTF8, tftBlobInternal have -2 as size
     -3,  // tftBlobExternal has -3 as size
     -1); //tftVarInt64

  // note: boolean is not in this set, because it can be 'true' or 'false'
  FIELD_INTEGER: TSynTableFieldTypes = [
    tftUInt8, tftUInt16, tftUInt24, tftInt32, tftInt64,
    tftVarUInt32, tftVarInt32, tftVarUInt64, tftVarInt64];

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 TSynTable.AddField(const aName: RawUTF8;
  aType: TSynTableFieldType; aOptions: TSynTableFieldOptions): TSynTableFieldProperties;
var aSize: Integer;
begin
  result := nil;
  aSize := FIELD_FIXEDSIZE[aType];
  if (self=nil) or (aSize=0) or IsRowID(pointer(aName)) or
     not PropNameValid(pointer(aName)) or (GetFieldFromName(aName)<>nil) then
    exit;
  result := TSynTableFieldProperties.Create;
  if fAddedField=nil then
    fAddedField := TList.Create;
  fAddedField.Add(result);
  result.Name := aName;
  result.FieldType := aType;
  if tfoUnique in aOptions then
    Include(aOptions,tfoIndex); // create an index for faster Unique field
  if aSize=-3 then // external field has no index available
    aOptions := aOptions-[tfoIndex,tfoUnique];
  result.Options := aOptions;
  if aSize>0 then begin
    // fixed-size field should be inserted left-side of the stream
    if (tfoIndex in aOptions) or (aSize and 3=0) then begin
      // indexed field or size is alignment friendly: put left side
      if not ((tfoIndex in aOptions) and (aSize and 3=0)) then
        // indexed+aligned field -> set first, otherwise at variable or not indexed
        while result.FieldNumber<fField.Count do
          with TSynTableFieldProperties(fField.List[result.FieldNumber]) do
          if (Offset<0) or not (tfoIndex in Options) then
            break else
            Inc(result.FieldNumber);
      end else
      // not indexed field: insert after previous fixed-sized fields
      if fFieldVariableIndex>=0 then
        result.FieldNumber := fFieldVariableIndex else
        result.FieldNumber := fField.Count;
    fField.Insert(result.FieldNumber,result);
  end else begin
    if (tfoIndex in aOptions) and (fFieldVariableIndex>=0) then begin
      // indexed field should be added left side (faster access for sort)
      result.FieldNumber := fFieldVariableIndex;
      while result.FieldNumber<fField.Count do
        with TSynTableFieldProperties(fField.List[result.FieldNumber]) do
        if not (tfoIndex in Options) then
          break else
          Inc(result.FieldNumber);
      fField.Insert(result.FieldNumber,result);
    end else
      // not indexed field: just add at the end of the field list
      result.FieldNumber := fField.Add(result);
  end;
  if tfoUnique in aOptions then begin
    fFieldHasUniqueIndexes := true;
    result.AddFilterOrValidate(TSynValidateTableUniqueField.Create);
  end;
  AfterFieldModif; // set Offset,FieldNumber,FieldSize fFieldVariableIndex/Offset
end;

procedure TSynTable.UpdateFieldData(RecordBuffer: PUTF8Char; RecordBufferLen,
  FieldIndex: integer; var result: TSBFString; const NewFieldData: TSBFString='');
var NewSize, DestOffset, OldSize: integer;
    F: TSynTableFieldProperties;
    NewData, Dest: PAnsiChar;
begin
  if (self<>nil) and ((RecordBuffer=nil) or (RecordBufferLen=0)) then begin
    // no data yet -> use default
    RecordBuffer := pointer(fDefaultRecordData);
    RecordBufferLen := fDefaultRecordLength;
  end;
  if RecordBuffer=pointer(result) then
    // update content code below will fail -> please correct calling code
    raise ETableDataException.CreateUTF8('In-place call of %.UpdateFieldData',[self]);
  if (self=nil) or (cardinal(FieldIndex)>=cardinal(fField.Count)) then begin
    SetString(result,PAnsiChar(RecordBuffer),RecordBufferLen);
    exit;
  end;
  F := TSynTableFieldProperties(fField.List[FieldIndex]);
  NewSize := length(NewFieldData);
  if NewSize=0 then begin
    // no NewFieldData specified -> use default field data to be inserted
    NewData := pointer(F.fDefaultFieldData);
    NewSize := F.fDefaultFieldLength;
  end else
    NewData := pointer(NewFieldData);
  Dest := GetData(RecordBuffer,F);
  DestOffset := Dest-RecordBuffer;
  // update content
  OldSize :=  F.GetLength(Dest);
  dec(RecordBufferLen,OldSize);
  SetLength(Result,RecordBufferLen+NewSize);
  move(RecordBuffer^,PByteArray(result)[0],DestOffset);
  move(NewData^,PByteArray(result)[DestOffset],NewSize);
  move(Dest[OldSize],PByteArray(result)[DestOffset+NewSize],RecordBufferLen-DestOffset);
end;

constructor TSynTable.Create(const aTableName: RawUTF8);
begin
  if not PropNameValid(pointer(aTableName)) then
    raise ETableDataException.CreateUTF8('Invalid %.Create(%)',[self,aTableName]);
  fTableName := aTableName;
  fField := TObjectList.Create;
  fFieldVariableIndex := -1;
end;

procedure TSynTable.LoadFrom(var RD: TFileBufferReader);
var n, i: integer;
    aTableName: RawUTF8;
begin
  fField.Clear;
  RD.Read(aTableName);
  if not PropNameValid(pointer(aTableName)) then
    RD.ErrorInvalidContent;
  fTableName := aTableName;
  n := RD.ReadVarUInt32;
  if cardinal(n)>=MAX_SQLFIELDS then
    RD.ErrorInvalidContent;
  for i := 0 to n-1 do
    fField.Add(TSynTableFieldProperties.CreateFrom(RD));
  AfterFieldModif;
end;

destructor TSynTable.Destroy;
begin
  fField.Free;
  fAddedField.Free;
  inherited;
end;

function TSynTable.GetFieldCount: integer;
begin
  if self=nil then
    result := 0 else
    result := fField.Count;
end;

function TSynTable.GetFieldFromName(const aName: RawUTF8): TSynTableFieldProperties;
var i: integer;
begin
  if self<>nil then
    for i := 0 to fField.Count-1 do begin
      result := TSynTableFieldProperties(fField.List[i]);
      if IdemPropNameU(result.Name,aName) then
        exit;
    end;
  result := nil;
end;

function TSynTable.GetFieldIndexFromName(const aName: RawUTF8): integer;
begin
  if self<>nil then
    for result := 0 to fField.Count-1 do
      if IdemPropNameU(TSynTableFieldProperties(fField.List[result]).Name,aName) then
        exit;
  result := -1;
end;

function TSynTable.GetFieldIndexFromShortName(const aName: ShortString): integer;
begin
  if self<>nil then
    for result := 0 to fField.Count-1 do
      with TSynTableFieldProperties(fField.List[result]) do
      if IdemPropName(aName,pointer(Name),length(Name)) then
        exit;
  result := -1;
end;

function TSynTable.GetFieldType(Index: integer): TSynTableFieldProperties;
begin
  if (self=nil) or (cardinal(Index)>=cardinal(fField.Count)) then
    result := nil else // avoid GPF
    result := fField.List[Index];
end;

{$ifndef DELPHI5OROLDER}

function TSynTable.CreateJSONWriter(JSON: TStream; Expand, withID: boolean;
  const Fields: TSQLFieldBits): TJSONWriter;
begin
  result := CreateJSONWriter(JSON,Expand,withID,FieldBitsToIndex(Fields,fField.Count));
end;

function TSynTable.CreateJSONWriter(JSON: TStream; Expand, withID: boolean;
  const Fields: TSQLFieldIndexDynArray): TJSONWriter;
var i,nf,n: integer;
begin
  if (self=nil) or ((Fields=nil) and not withID) then begin
    result := nil; // no data to retrieve
    exit;
  end;
  result := TJSONWriter.Create(JSON,Expand,withID,Fields);
  // set col names
  if withID then
    n := 1 else
    n := 0;
  nf := length(Fields);
  SetLength(result.ColNames,nf+n);
  if withID then
    result.ColNames[0] := 'ID';
  for i := 0 to nf-1 do
    result.ColNames[i+n] := TSynTableFieldProperties(fField.List[Fields[i]]).Name;
  result.AddColumns; // write or init field names for appropriate JSON Expand
end;

procedure TSynTable.GetJSONValues(aID: integer; RecordBuffer: PUTF8Char;
  W: TJSONWriter);
var i,n: integer;
    buf: array[0..MAX_SQLFIELDS-1] of PUTF8Char;
begin
  if (self=nil) or (RecordBuffer=nil) or (W=nil) then
    exit; // avoid GPF
  if W.Expand then begin
    W.Add('{');
    if W.WithID then
      W.AddString(W.ColNames[0]);
  end;
  if W.WithID then begin
    W.Add(aID);
    W.Add(',');
    n := 1;
  end else
    n := 0;
  for i := 0 to fField.Count-1 do begin
    buf[i] := RecordBuffer;
    inc(RecordBuffer,TSynTableFieldProperties(fField.List[i]).GetLength(RecordBuffer));
  end;
  for i := 0 to length(W.Fields)-1 do begin
    if W.Expand then begin
      W.AddString(W.ColNames[n]); // '"'+ColNames[]+'":'
      inc(n);
    end;
    TSynTableFieldProperties(fField.List[W.Fields[i]]).GetJSON(buf[i],W);
    W.Add(',');
  end;
  W.CancelLastComma; // cancel last ','
  if W.Expand then
    W.Add('}');
end;

function TSynTable.IterateJSONValues(Sender: TObject; Opaque: pointer;
  ID: integer; Data: pointer; DataLen: integer): boolean;
var Statement: TSynTableStatement absolute Opaque;
    F: TSynTableFieldProperties;
    nWhere,fIndex: cardinal;
begin  // note: we should have handled -2 (=COUNT) case already
  nWhere := length(Statement.Where);
  if (self=nil) or (Statement=nil) or (Data=nil) or
     (Statement.Select=nil) or (nWhere>1) or 
     ((nWhere=1)and(Statement.Where[0].ValueSBF='')) then begin
    result := false;
    exit;
  end;
  result := true;
  if nWhere=1 then begin // Where=nil -> all rows
    fIndex := Statement.Where[0].Field;
    if fIndex=SYNTABLESTATEMENTWHEREID then begin
      if ID<>Statement.Where[0].ValueInteger then
        exit;
    end else begin
      dec(fIndex); // 0 is ID, 1 for field # 0, 2 for field #1, and so on...
      if fIndex<cardinal(fField.Count) then begin
        F := TSynTableFieldProperties(fField.List[fIndex]);
        if F.SortCompare(GetData(Data,F),pointer(Statement.Where[0].ValueSBF))<>0 then
          exit;
      end;
    end;
  end;
  GetJSONValues(ID,Data,Statement.Writer);
end;

{$endif DELPHI5OROLDER}

function TSynTable.GetData(RecordBuffer: PUTF8Char; Field: TSynTableFieldProperties): pointer;
var i: integer;
    PB: PByte;
begin
  if Field.Offset>=0 then
    result := RecordBuffer+Field.Offset else begin
    result := RecordBuffer+fFieldVariableOffset;
    for i := fFieldVariableIndex to Field.FieldNumber-1 do
      if i in fFieldIsVarString then begin
        // inlined result := GotoNextVarString(result);
        if PByte(result)^<=$7f then
          inc(PtrUInt(result),PByte(result)^+1) else begin
          PB := result;
          inc(PtrUInt(result),FromVarUInt32High(PB)+PtrUInt(PB)-PtrUInt(result));
        end;
      end else
      if not (i in fFieldIsExternal) then begin
        // inlined result := GotoNextVarInt(result)
        while PByte(result)^>$7f do inc(PtrUInt(result));
        inc(PtrUInt(result));
      end;
  end;
end;

procedure TSynTable.SaveTo(WR: TFileBufferWriter);
var i: Integer;
begin
  WR.Write(fTableName);
  WR.WriteVarUInt32(fField.Count);
  for i := 0 to fField.Count-1 do
    TSynTableFieldProperties(fField.List[i]).SaveTo(WR);
end;

procedure TSynTable.AfterFieldModif;
var i, Offs: integer;
begin
  Int64(fFieldIsVarString) := 0;
  Int64(fFieldIsExternal) := 0;
  fFieldVariableIndex := -1;
  fDefaultRecordLength := 0;
  fFieldHasUniqueIndexes := false;
  Offs := 0;
  for i := 0 to fField.Count-1 do
  with TSynTableFieldProperties(fField.List[i]) do begin
    FieldNumber := i;
    {$ifndef SORTCOMPAREMETHOD}
    SortCompare := FIELD_SORT[FieldType];
    {$endif}
    Owner := self;
    FieldSize := FIELD_FIXEDSIZE[FieldType];
    if FieldSize>=0 then begin
      assert(Offs>=0);
      Offset := Offs;
      inc(Offs,FieldSize);
      inc(fDefaultRecordLength,FieldSize);
      fDefaultFieldLength := FieldSize;
    end else begin
      if FieldSize=-3 then
        Include(fFieldIsExternal,i) else begin
        fDefaultFieldLength := 1;
        inc(fDefaultRecordLength);
        if FieldSize=-2 then
          Include(fFieldIsVarString,i);
        {$ifndef SORTCOMPAREMETHOD}
        if (FieldType in [tftWinAnsi,tftUTF8]) and
           (tfoCaseInsensitive in Options) then
          SortCompare := SortIStr; // works for both WinAnsi and UTF-8 encodings
        {$endif}
      end;
      // we need the Offset even for tftBlobExternal (FieldSize=-3)
      if fFieldVariableIndex<0 then begin
        fFieldVariableIndex := i;
        fFieldVariableOffset := Offs;
        Offs := -1;
      end;
      Offset := Offs;
      dec(Offs);
    end;
    SetLength(fDefaultFieldData,fDefaultFieldLength);
    FillChar(pointer(fDefaultFieldData)^,fDefaultFieldLength,0);
  end;
  SetLength(fDefaultRecordData,fDefaultRecordLength);
  FillChar(pointer(fDefaultRecordData)^,fDefaultRecordLength,0);
end;

procedure TSynTable.FieldIndexModify(aOldIndex, aNewIndex: integer;
  aOldRecordData, aNewRecordData: pointer);
var F: integer;
begin
  for F := 0 to fField.Count-1 do
    with TSynTableFieldProperties(fField.List[F]) do
      if tfoIndex in Options then
        OrderedIndexUpdate(aOldIndex,aNewIndex,aOldRecordData,aNewRecordData);
end;

procedure TSynTable.Filter(var RecordBuffer: TSBFString);
var Old, New: RawUTF8;
    NewRecord: TSBFString; // UpdateFieldData update result in-place
    F, i: integer;
begin
  for F := 0 to fField.Count-1 do
    with TSynTableFieldProperties(fField.List[F]) do
    if Filters<>nil then begin
      Old := GetRawUTF8(pointer(RecordBuffer));
      New := Old;
      for i := 0 to Filters.Count-1 do
        TSynFilter(Filters.List[i]).Process(F,New);
      if Old<>New then begin
        // value was changed -> store modified
        UpdateFieldData(pointer(RecordBuffer),length(RecordBuffer),F,
          NewRecord,SBFFromRawUTF8(New));
        RecordBuffer := NewRecord;
      end;
    end;
end;

{$ifndef NOVARIANTS}
function TSynTable.Data(aID: integer; RecordBuffer: pointer; RecordBufferLen: Integer): Variant;
begin
  if SynTableVariantType=nil then
    SynTableVariantType := SynRegisterCustomVariantType(TSynTableVariantType);
  if not(TVarData(result).VType in VTYPE_STATIC) then
    VarClear(result);
  with TSynTableData(result) do begin
    VType := SynTableVariantType.VarType;
    VID := aID;
    VTable := self;
    if RecordBuffer=nil then
      VValue := DefaultRecordData else begin
      if RecordBufferLen=0 then
        RecordBufferLen := DataLength(RecordBuffer);
      SetString(VValue,PAnsiChar(RecordBuffer),RecordBufferLen);
    end;
  end;
end;
{$endif NOVARIANTS}

function TSynTable.DataLength(RecordBuffer: pointer): integer;
var F: Integer;
    PC: PUTF8Char;
begin
  if (Self<>nil) and (RecordBuffer<>nil) then begin
    PC := RecordBuffer;
    for F := 0 to fField.Count-1 do
      inc(PC,TSynTableFieldProperties(fField.List[F]).GetLength(PC));
    result := PC-RecordBuffer;
  end else
    result := 0;
end;

function TSynTable.UpdateFieldEvent(Sender: TObject; Opaque: pointer;
  ID, Index: integer; Data: pointer; DataLen: integer): boolean;
var Added: PUpdateFieldEvent absolute Opaque;
    F, aSize: integer;
begin // in practice, this data processing is very fast (thanks to WR speed)
  with Added^ do begin
    result := Count<length(IDs);
    if not result then
      exit;
    for F := 0 to fField.Count-1 do
    with TSynTableFieldProperties(fField.List[F]) do
    if F in AvailableFields then begin
      // add previous field content: will handle any field offset change in record
      aSize := Getlength(Data);
      WR.Write(Data,aSize);
      Inc(PtrUInt(Data),aSize);
    end else
      // add default field content for a newly added field
      WR.Write(Pointer(fDefaultFieldData),fDefaultFieldLength);
    if WR.fTotalWritten>1 shl 30 then
      raise ETableDataException.CreateUTF8('%: File size too big (>1GB)',[self]) else
      Offsets64[Count] := WR.fTotalWritten;
    IDs[Count] := ID;
    NewIndexs[Index] := Count;
    inc(Count);
  end;
end;

function TSynTable.UpdateFieldRecord(RecordBuffer: PUTF8Char;
  var AvailableFields: TSQLFieldBits): TSBFString;
var Lens: array[0..MAX_SQLFIELDS-1] of Integer;
    F, Len, TotalLen: integer;
    P: PUTF8Char;
    Dest: PByte;
begin
  // retrieve all field buffer lengths, to speed up record content creation
  TotalLen := 0;
  P := RecordBuffer;
  for F := 0 to fField.Count-1 do
  with TSynTableFieldProperties(fField.List[F]) do
  if F in AvailableFields then begin
    Len := GetLength(P);
    inc(P,Len);
    inc(TotalLen,Len);
    Lens[F] := Len;
  end else
    inc(TotalLen,fDefaultFieldLength);
  // create new record content
  P := RecordBuffer;
  SetString(Result,nil,TotalLen);
  Dest := pointer(Result);
  for F := 0 to fField.Count-1 do
  with TSynTableFieldProperties(fField.List[F]) do
    if F in AvailableFields then begin
      Len := Lens[F];
      move(P^,Dest^,Len);
      inc(P,Len);
      inc(Dest,Len);
    end else begin
      FillChar(Dest^,fDefaultFieldLength,0);
      inc(Dest,fDefaultFieldLength);
    end;
  Assert(PtrUInt(Dest)-PtrUInt(result)=PtrUInt(TotalLen));
end;

function TSynTable.Validate(RecordBuffer: pointer; RecordIndex: integer): string;
var F: integer;
begin
  result := '';
  for F := 0 to fField.Count-1 do
    with TSynTableFieldProperties(fField.List[F]) do
      if Validates<>nil then begin
        result := Validate(RecordBuffer,RecordIndex);
        if result<>'' then
          exit;
      end;
end;


{ TSynTableFieldProperties }

constructor TSynTableFieldProperties.CreateFrom(var RD: TFileBufferReader);
begin
  fOrderedIndexFindAdd := -1;
  RD.Read(Name);
  if not PropNameValid(pointer(Name)) then
    RD.ErrorInvalidContent;
  RD.Read(@FieldType,SizeOf(FieldType));
  RD.Read(@Options,SizeOf(Options));
  if (FieldType>high(FieldType)) then
    RD.ErrorInvalidContent;
  OrderedIndexCount := RD.ReadVarUInt32Array(OrderedIndex);
  if OrderedIndexCount>0 then begin
    if tfoIndex in Options then begin
      assert(OrderedIndexReverse=nil);
      OrderedIndexReverseSet(-1); // compute whole OrderedIndexReverse[] array
    end else
      RD.ErrorInvalidContent;
  end;
  // we allow a void OrderedIndex[] array from disk
end;

destructor TSynTableFieldProperties.Destroy;
begin
  Filters.Free;
  Validates.Free;
  inherited;
end;

{$ifndef DELPHI5OROLDER} // Delphi 5 does not like this code, do not know why :(
function TSynTableFieldProperties.GetJSON(FieldBuffer: pointer;
  W: TTextWriter): pointer;
var len: integer;
    tmp: RawUTF8;
begin
  case FieldType of
  // fixed-sized field value
  tftBoolean:
    W.AddString(JSON_BOOLEAN[PBoolean(FieldBuffer)^]);
  tftUInt8:
    W.Add(PByte(FieldBuffer)^);
  tftUInt16:
    W.Add(PWord(FieldBuffer)^);
  tftUInt24:
    // PInteger()^ and $ffffff -> possible GPF on Memory Mapped file
    W.Add(PWord(FieldBuffer)^+integer(PByteArray(FieldBuffer)^[2])shl 16);
  tftInt32:
    W.Add(PInteger(FieldBuffer)^);
  tftInt64:
    W.Add(PInt64(FieldBuffer)^);
  tftCurrency:
    W.AddCurr64(PInt64(FieldBuffer)^);
  tftDouble:
    W.AddDouble(PDouble(FieldBuffer)^);
  // some variable-size field value
  tftVarUInt32:
    W.Add(FromVarUInt32(PByte(FieldBuffer)));
  tftVarInt32:
    W.Add(FromVarInt32(PByte(FieldBuffer)));
  tftVarUInt64:
    W.Add(Int64(FromVarUInt64(PByte(FieldBuffer))));
  tftVarInt64:
    W.Add(FromVarInt64(PByte(FieldBuffer)));
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi, tftUTF8: begin
    W.Add('"');
    len := FromVarUInt32(PByte(FieldBuffer));
    if len>0 then
      if FieldType=tftUTF8 then
        W.AddJSONEscape(PAnsiChar(FieldBuffer),len) else begin
        SetLength(tmp,len*3); // in-place decoding and appending
        W.AddJSONEscape(pointer(tmp),WinAnsiBufferToUtf8(pointer(tmp),PAnsiChar(FieldBuffer),len)-pointer(tmp));
      end;
    W.Add('"');
    result := PAnsiChar(FieldBuffer)+len;
    exit;
  end;
  tftBlobInternal: begin
    W.AddShort('"X''');
    len := FromVarUInt32(PByte(FieldBuffer));
    W.AddBinToHex(PByte(FieldBuffer),len);
    W.Add('''','"');
  end;
  tftBlobExternal:
    ; // BLOB fields are not handled here, but must be directly accessed
  end;
  result := PAnsiChar(FieldBuffer)+FieldSize; // // tftWinAnsi,tftUTF8 already done
end;
{$endif}

function TSynTableFieldProperties.GetLength(FieldBuffer: pointer): Integer;
var PB: PByte;
begin
  if FieldSize>=0 then
    result := FieldSize else
    case FieldSize of
    -1: begin // variable-length data
      result := 0;
      while PByteArray(FieldBuffer)^[result]>$7f do inc(result);
      inc(result);
    end;
    -2: begin // tftWinAnsi, tftUTF8, tftBlobInternal records
      result := PByte(FieldBuffer)^;
      if result<=$7F then
        inc(Result) else begin
        PB := FieldBuffer;
        result := FromVarUInt32High(PB)+PtrUInt(PB)-PtrUInt(FieldBuffer);
      end;
    end;
    else
      result := 0; // tftBlobExternal is not stored in FieldBuffer
    end;
end;

{$ifndef NOVARIANTS}
function TSynTableFieldProperties.GetVariant(FieldBuffer: pointer): Variant;
begin
  GetVariant(FieldBuffer,result);
end;

procedure TSynTableFieldProperties.GetVariant(FieldBuffer: pointer; var result: Variant);
var len: integer;
    PB: PByte absolute FieldBuffer;
    PA: PAnsiChar absolute FieldBuffer;
    PU: PUTF8Char absolute FieldBuffer;
    tmp: RawByteString;
    {$ifndef UNICODE}
    WS: WideString;
    {$endif}
begin
  case FieldType of
  // fixed-sized field value
  tftBoolean:
    result := PBoolean(FieldBuffer)^;
  tftUInt8:
    result := PB^;
  tftUInt16:
    result := PWord(FieldBuffer)^;
  tftUInt24:
    // PInteger()^ and $ffffff -> possible GPF on Memory Mapped file
    result := PWord(FieldBuffer)^+integer(PByteArray(FieldBuffer)^[2])shl 16;
  tftInt32:
    result := PInteger(FieldBuffer)^;
  tftInt64:
    result := PInt64(FieldBuffer)^;
  tftCurrency:
    result := PCurrency(FieldBuffer)^;
  tftDouble:
    result := PDouble(FieldBuffer)^;
  // some variable-size field value
  tftVarUInt32:
    result := FromVarUInt32(PB);
  tftVarInt32:
    result := FromVarInt32(PB);
  tftVarUInt64:
    result := FromVarUInt64(PB);
  tftVarInt64:
    result := FromVarInt64(PB);
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi: begin
    len := FromVarUInt32(PB);
    if len>0 then
      {$ifdef UNICODE}
      result := WinAnsiToUnicodeString(PA,len)
      {$else}
      result := CurrentAnsiConvert.AnsiToAnsi(WinAnsiConvert,PA,len)
      {$endif} else
      result := '';
  end;
  tftUTF8: begin
    len := FromVarUInt32(PB);
    if len>0 then
      {$ifdef UNICODE}
      result := UTF8DecodeToUnicodeString(PU,len)
      {$else} begin
        UTF8ToSynUnicode(PU,len,WS);
        result := WS;
      end
      {$endif} else
      result := '';
  end;
  tftBlobInternal: begin
    len := FromVarUInt32(PB);
    SetString(tmp,PA,len);
    result := tmp; // return internal BLOB content as string
  end
  else
    result := ''; // tftBlobExternal fields e.g. must be directly accessed
  end;
end;
{$endif}

function TSynTableFieldProperties.GetValue(FieldBuffer: pointer): RawUTF8;
var len: integer;
    PB: PByte absolute FieldBuffer;
    PC: PAnsiChar absolute FieldBuffer;
begin
  case FieldType of
  // fixed-sized field value
  tftBoolean:
    result := JSON_BOOLEAN[PBoolean(FieldBuffer)^];
  tftUInt8:
    UInt32ToUtf8(PB^,result);
  tftUInt16:
    UInt32ToUtf8(PWord(FieldBuffer)^,result);
  tftUInt24:
    // PInteger()^ and $ffffff -> possible GPF on Memory Mapped file
    UInt32ToUtf8(PWord(FieldBuffer)^+integer(PByteArray(FieldBuffer)^[2])shl 16,result);
  tftInt32:
    Int32ToUtf8(PInteger(FieldBuffer)^,result);
  tftInt64:
    Int64ToUtf8(PInt64(FieldBuffer)^,result);
  tftCurrency:
    Curr64ToStr(PInt64(FieldBuffer)^,result);
  tftDouble:
    ExtendedToStr(PDouble(FieldBuffer)^,DOUBLE_PRECISION,result);
  // some variable-size field value
  tftVarUInt32:
    UInt32ToUtf8(FromVarUInt32(PB),result);
  tftVarInt32:
    Int32ToUtf8(FromVarInt32(PB),result);
  tftVarUInt64:
    Int64ToUtf8(FromVarUInt64(PB),result);
  tftVarInt64:
    Int64ToUtf8(FromVarInt64(PB),result);
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi, tftUTF8, tftBlobInternal: begin
    len := FromVarUInt32(PB);
    if len>0 then
      if FieldType<>tftWinAnsi then
        SetString(result,PC,len) else
        result := WinAnsiConvert.AnsiBufferToRawUTF8(PC,len) else
      result := '';
  end;
  else
    result := ''; // tftBlobExternal fields e.g. must be directly accessed
  end;
end;

procedure TSynTableFieldProperties.OrderedIndexReverseSet(aOrderedIndex: integer);
var nrev, ndx, n: PtrInt;
begin
  n := length(OrderedIndex);
  nrev := length(OrderedIndexReverse);
  if nrev=0 then
    if n=0 then
      exit else begin
      // void OrderedIndexReverse[]
      nrev := MaxInteger(OrderedIndex,OrderedIndexCount,n)+1;
      SetLength(OrderedIndexReverse,nrev);
      FillChar(OrderedIndexReverse[0],nrev*4,255); // all to -1
      Reverse(OrderedIndex,OrderedIndexCount,pointer(OrderedIndexReverse));
    end;
  if PtrUInt(aOrderedIndex)>=PtrUInt(OrderedIndexCount) then
    exit; // e.g. CreateFrom() will call OrderedIndexReverseSet(-1)
  if nrev<n then begin
    SetLength(OrderedIndexReverse,n); // resize if needed
    nrev := n;
  end;
  ndx := OrderedIndex[aOrderedIndex];
  if ndx>=nrev then
    SetLength(OrderedIndexReverse,ndx+256) else
  OrderedIndexReverse[ndx] := aOrderedIndex;
end;

procedure TSynTableFieldProperties.OrderedIndexSort(L, R: PtrInt);
var I, J, P: PtrInt;
    TmpI, TmpJ: integer;
begin
  if (L<R) and Assigned(Owner.GetRecordData) then
  repeat
    I := L; J := R;
    P := (L + R) shr 1;
    repeat
      with Owner do begin
        SortPivot := GetData(GetRecordData(OrderedIndex[P],DataTemp1),self);
        while SortCompare(GetData(GetRecordData(OrderedIndex[I],DataTemp2),self),
          SortPivot)<0 do Inc(I);
        while SortCompare(GetData(GetRecordData(OrderedIndex[J],DataTemp2),self),
          SortPivot)>0 do Dec(J);
      end;
      if I <= J then begin
        if I < J then begin
          TmpJ := OrderedIndex[J];
          TmpI := OrderedIndex[I];
          OrderedIndex[J] := TmpI;
          OrderedIndex[I] := TmpJ;
          // keep OrderedIndexReverse[OrderedIndex[i]]=i
          OrderedIndexReverse[TmpJ] := I;
          OrderedIndexReverse[TmpI] := J;
        end;
        if P = I then P := J else if P = J then P := I;
        Inc(I); Dec(J);
      end;
    until I > J;
    if L < J then
      OrderedIndexSort(L, J);
    L := I;
  until I >= R;
end;

procedure TSynTableFieldProperties.OrderedIndexRefresh;
begin
  if (self=nil) or not OrderedIndexNotSorted then
    exit; // already sorted
  OrderedIndexSort(0,OrderedIndexCount-1);
  OrderedIndexNotSorted := false;
end;

function TSynTableFieldProperties.OrderedIndexFind(Value: pointer): PtrInt;
var L,R: PtrInt;
    cmp: PtrInt;
begin
  if OrderedIndexNotSorted then
    OrderedIndexRefresh;
  L := 0;
  R := OrderedIndexCount-1;
  with Owner do
    if (R>=0) and Assigned(GetRecordData) then
    repeat
      result := (L + R) shr 1;
      cmp := SortCompare(GetData(GetRecordData(OrderedIndex[result],DataTemp1),self),Value);
      if cmp=0 then
        exit;
      if cmp<0 then
        L := result + 1 else
        R := result - 1;
    until (L > R);
  result := -1
end;

function TSynTableFieldProperties.OrderedIndexFindAdd(Value: pointer): PtrInt;
var L,R,i: PtrInt;
    cmp: PtrInt;
begin
  if OrderedIndexNotSorted then
    OrderedIndexRefresh;
  R := OrderedIndexCount-1;
  if R<0 then
    result := 0 else
    with Owner do begin
      fOrderedIndexFindAdd := -1;
      L := 0;
      result := -1; // return -1 if found
      repeat
        i := (L + R) shr 1;
        cmp := SortCompare(GetData(GetRecordData(OrderedIndex[i],DataTemp1),self),Value);
        if cmp=0 then
          exit;
        if cmp<0 then
          L := i + 1 else
          R := i - 1;
      until (L > R);
      while (i>=0) and
            (SortCompare(GetData(GetRecordData(OrderedIndex[i],DataTemp1),self),Value)>=0) do
        dec(i);
      result := i+1; // return the index where to insert
    end;
  fOrderedIndexFindAdd := result; // store inserting index for OrderedIndexUpdate 
end;

function TSynTableFieldProperties.OrderedIndexMatch(WhereSBFValue: pointer;
  var MatchIndex: TIntegerDynArray; var MatchIndexCount: integer; Limit: Integer=0): Boolean;
var i, L,R: PtrInt;
begin
  result := false;
  if (self=nil) or (WhereSBFValue=nil) or not Assigned(Owner.GetRecordData) or
     (OrderedIndex=nil) or not (tfoIndex in Options) then
    exit;
  i := OrderedIndexFind(WhereSBFValue);
  if i<0 then
    exit; // WHERE value not found
  if (tfoUnique in Options) or (Limit=1) then begin
    // unique index: direct fastest binary search
    AddSortedInteger(MatchIndex,MatchIndexCount,OrderedIndex[i]);
    // AddSortedInteger() will fail if OrderedIndex[i] already exists
  end else
  with Owner do begin
    // multiple index matches possible: add matching range
    L := i;
    repeat
      dec(L);
    until (L<0) or (SortCompare(GetData(GetRecordData(
      OrderedIndex[L],DataTemp1),self),WhereSBFValue)<>0);
    R := i;
    repeat
      inc(R);
    until (R>=OrderedIndexCount) or
      (SortCompare(GetData(GetRecordData(OrderedIndex[R],DataTemp1),self),WhereSBFValue)<>0);
    if Limit=0 then
      Limit := MaxInt; // no LIMIT set -> retrieve all rows
    for i := L+1 to R-1 do begin
      AddSortedInteger(MatchIndex,MatchIndexCount,OrderedIndex[i]);
      dec(Limit);
      if Limit=0 then
        Break; // reach LIMIT upperbound result count 
    end;
  end;
  result := true;
end;

function TSynTableFieldProperties.OrderedIndexUpdate(aOldIndex, aNewIndex: integer;
  aOldRecordData, aNewRecordData: pointer): boolean;
var aOldIndexIndex: integer;
begin
  result := false;
  if (self=nil) or not Assigned(Owner.GetRecordData) then
    exit; // avoid GPF
  // update content
  if aOldIndex<0 then
    if aNewIndex<0 then begin
      // both indexes equal -1 -> force sort
      OrderedIndexSort(0,OrderedIndexCount-1);
      OrderedIndexNotSorted := false;
    end else begin
      // added record
      if tfoUnique in Options then begin
        if fOrderedIndexFindAdd<0 then
          raise ETableDataException.CreateUTF8(
            '%.CheckConstraint call needed before %.OrderedIndexUpdate',[self,Name]);
        OrderedIndexReverseSet(InsertInteger(OrderedIndex,OrderedIndexCount,
          aNewIndex,fOrderedIndexFindAdd));
      end else begin
        AddInteger(OrderedIndex,OrderedIndexCount,aNewIndex);
        OrderedIndexReverseSet(OrderedIndexCount-1);
        OrderedIndexNotSorted := true; // -> OrderedIndexSort() call on purpose
      end;
    end else begin
    // aOldIndex>=0: update a value
    // retrieve position in OrderedIndex[] to be deleted/updated
    if OrderedIndexReverse=nil then
      OrderedIndexReverseSet(0) else // do OrderedIndexReverse[OrderedIndex[i]] := i
      assert(aOldIndex<length(OrderedIndexReverse));
    //assert(IntegerScanIndex(Pointer(OrderedIndex),OrderedIndexCount,aOldIndex)=OrderedIndexReverse[aOldIndex]);
    aOldIndexIndex := OrderedIndexReverse[aOldIndex]; // use FAST reverse array
    if aOldIndexIndex<0 then
      exit; // invalid Old index
    if aNewIndex<0 then begin
      // deleted record
      DeleteInteger(OrderedIndex,OrderedIndexCount,aOldIndexIndex);
      Reverse(OrderedIndex,OrderedIndexCount,pointer(OrderedIndexReverse));
      // no need to refresh OrderedIndex[], since data will remain sorted
    end else begin
      // updated record
      OrderedIndex[aOldIndexIndex] := aNewIndex;
      OrderedIndexReverseSet(aOldIndexIndex);
      if (aOldRecordData<>nil) or (aOldIndex<>aNewIndex) then // not in-place update
        with Owner do begin
          if aOldRecordData=nil then
            aOldRecordData := GetRecordData(aOldIndex,DataTemp1);
          if aNewRecordData=nil then
            aNewRecordData := GetRecordData(aNewIndex,DataTemp2);
          if SortCompare(GetData(aOldRecordData,self),GetData(aNewRecordData,self))=0 then begin
            // only sort if field content was modified -> MUCH faster in most case
            result := true;
            exit;
          end;
        end;
      if tfoUnique in Options then begin
        if fOrderedIndexFindAdd>=0 then begin
          // we know which OrderedIndex[] has to be changed -> manual update
          // - this is still a bottleneck in the current implementation, but
          // I was not able to find out how to make it faster, and still
          // being able to check unique field constraints without changing the
          // OrderedIndex[] content from a simple list into e.g. a red-black
          // tree: such a structure performs better, but uses much more memory
          // and is to be implemented
          // - it's still fast, faster than any DB AFAIK, around 500 updates
          // per second with 1,000,000 records on a Core i7
          // - it's still faster to refresh OrderedIndex[] than iterating
          // through all items to validate the unique constraint
          DeleteInteger(OrderedIndex,OrderedIndexCount,aOldIndexIndex);
          if fOrderedIndexFindAdd>aOldIndexIndex then
            dec(fOrderedIndexFindAdd);
          InsertInteger(OrderedIndex,OrderedIndexCount,aNewIndex,fOrderedIndexFindAdd);
          Reverse(OrderedIndex,OrderedIndexCount,pointer(OrderedIndexReverse));
        end else
          // slow full sort - with 1,000,000 items it's about 100 times slower
          // (never called with common usage in SynBigTable unit)
          OrderedIndexSort(0,OrderedIndexCount-1);
      end else
        OrderedIndexNotSorted := true; // will call OrderedIndexSort() on purpose
    end;
  end;
  fOrderedIndexFindAdd := -1; // consume this value
  result := true;
end;

procedure TSynTableFieldProperties.SaveTo(WR: TFileBufferWriter);
begin
  WR.Write(Name);
  WR.Write(@FieldType,SizeOf(FieldType));
  WR.Write(@Options,SizeOf(Options));
  WR.WriteVarUInt32Array(OrderedIndex,OrderedIndexCount,wkVarUInt32);
end;

function TSynTableFieldProperties.SBF(const Value: Int64): TSBFString;
var tmp: array[0..15] of AnsiChar;
begin
  case FieldType of
    tftInt32: begin // special version for handling negative values
      PInteger(@tmp)^ := Value;
      SetString(Result,tmp,sizeof(Integer));
    end;
    tftUInt8, tftUInt16, tftUInt24, tftInt64:
      SetString(Result,PAnsiChar(@Value),FieldSize);
    tftVarUInt32:
      SetString(Result,tmp,PAnsiChar(ToVarUInt32(Value,@tmp))-tmp);
    tftVarInt32:
      SetString(Result,tmp,PAnsiChar(ToVarInt32(Value,@tmp))-tmp);
    tftVarUInt64:
      SetString(Result,tmp,PAnsiChar(ToVarUInt64(Value,@tmp))-tmp);
    tftVarInt64:
      SetString(Result,tmp,PAnsiChar(ToVarInt64(Value,@tmp))-tmp);
    else
      result := '';
  end;
end;

function TSynTableFieldProperties.SBF(const Value: Integer): TSBFString;
var tmp: array[0..15] of AnsiChar;
begin
  case FieldType of
    tftUInt8, tftUInt16, tftUInt24, tftInt32:
      SetString(Result,PAnsiChar(@Value),FieldSize);
    tftInt64: begin // special version for handling negative values
      PInt64(@tmp)^ := Value;
      SetString(Result,tmp,sizeof(Int64));
    end;
    tftVarUInt32:
      if Value<0 then // expect an unsigned integer
        result := '' else
        SetString(Result,tmp,PAnsiChar(ToVarUInt32(Value,@tmp))-tmp);
    tftVarInt32:
      SetString(Result,tmp,PAnsiChar(ToVarInt32(Value,@tmp))-tmp);
    tftVarUInt64:
      if cardinal(Value)>cardinal(maxInt) then
        result := '' else // expect a 32 bit integer
        SetString(Result,tmp,PAnsiChar(ToVarUInt64(Value,@tmp))-tmp);
    tftVarInt64:
      SetString(Result,tmp,PAnsiChar(ToVarInt64(Value,@tmp))-tmp);
    else
      result := '';
  end;
end;

const
  SBF_BOOL: array[boolean] of TSBFString =
   (#0,#1);

{$ifndef NOVARIANTS}
function TSynTableFieldProperties.SBF(const Value: Variant): TSBFString;
var V64: Int64;
    VC: Currency absolute V64;
    VD: Double absolute V64;
begin // VarIsOrdinal/VarIsFloat/VarIsStr are buggy -> use field type
  case FieldType of
    tftBoolean:
      result := SBF_BOOL[boolean(Value)];
    tftUInt8, tftUInt16, tftUInt24, tftInt32, tftInt64,
    tftVarUInt32, tftVarInt32, tftVarUInt64, tftVarInt64: begin
      if not VariantToInt64(Value,V64) then
        V64 := 0;
      result := SBF(V64);
    end;
    tftCurrency: begin
      VC := Value;
      SetString(result,PAnsiChar(@VC),sizeof(VC));
    end;
    tftDouble: begin
      VD := Value;
      SetString(result,PAnsiChar(@VD),sizeof(VD));
    end;
    tftWinAnsi:
      ToSBFStr(WinAnsiConvert.UTF8ToAnsi(VariantToUTF8(Value)),result);
    tftUTF8:
      ToSBFStr(VariantToUTF8(Value),result);
    else
      result := '';
  end;
  if result='' then
    result := SBFDefault;
end;
{$endif}

function TSynTableFieldProperties.SBF(const Value: Boolean): TSBFString;
begin
  if FieldType<>tftBoolean then
    result := '' else
    result := SBF_BOOL[Value];
end;

function TSynTableFieldProperties.SBFCurr(const Value: Currency): TSBFString;
begin
  if FieldType<>tftCurrency then
    result := '' else
    SetString(Result,PAnsiChar(@Value),sizeof(Value));
end;

procedure ToSBFStr(const Value: RawByteString; out Result: TSBFString);
var tmp: array[0..15] of AnsiChar;
    Len, Head: integer;
begin
  if PtrUInt(Value)=0 then
    Result := #0 else begin
    Len := PInteger(PtrUInt(Value)-sizeof(integer))^; // inlined length(Value)
    Head := PAnsiChar(ToVarUInt32(Len,@tmp))-tmp;
    SetLength(Result,Len+Head);
    Move(tmp,PByteArray(Result)[0],Head);
    Move(pointer(Value)^,PByteArray(Result)[Head],Len);
  end;
end;

function TSynTableFieldProperties.SBF(const Value: RawUTF8): TSBFString;
begin
  case FieldType of
    tftUTF8:
      ToSBFStr(Value,Result);
    tftWinAnsi:
      ToSBFStr(Utf8ToWinAnsi(Value),Result);
    else
      result := '';
  end;
end;

function TSynTableFieldProperties.SBF(Value: pointer; ValueLen: integer): TSBFString;
var tmp: array[0..15] of AnsiChar;
    Head: integer;
begin
  if FieldType<>tftBlobInternal then
    result := '' else
  if (Value=nil) or (ValueLen=0) then
    result := #0 else begin // inlined ToSBFStr() code
    Head := PAnsiChar(ToVarUInt32(ValueLen,@tmp))-tmp;
    SetString(Result,nil,ValueLen+Head);
    Move(tmp,PByteArray(Result)[0],Head);
    Move(Value^,PByteArray(Result)[Head],ValueLen);
  end;
end;

function TSynTableFieldProperties.SBFFloat(const Value: Double): TSBFString;
begin
  if FieldType<>tftDouble then
    result := '' else
    SetString(Result,PAnsiChar(@Value),sizeof(Value));
end;

function TSynTableFieldProperties.SBFFromRawUTF8(const aValue: RawUTF8): TSBFString;
var Curr: Currency;
begin
  case FieldType of
  tftBoolean:
    if (SynCommons.GetInteger(pointer(aValue))<>0) or
       IdemPropNameU(aValue,JSON_BOOLEAN[true]) then
      result := #1 else
      result := #0; // store false by default
  tftUInt8, tftUInt16, tftUInt24, tftInt32, tftVarInt32:
    result := SBF(SynCommons.GetInteger(pointer(aValue)));
  tftVarUInt32, tftInt64, tftVarUInt64, tftVarInt64:
    result := SBF(SynCommons.GetInt64(pointer(aValue)));
  tftCurrency: begin
    PInt64(@Curr)^ := StrToCurr64(pointer(aValue));
    result := SBFCurr(Curr);
  end;
  tftDouble:
    result := SBFFloat(GetExtended(pointer(aValue)));
  // text storage - WinAnsi could use less space than UTF-8
  tftUTF8, tftWinAnsi:
    result := SBF(aValue);
  else
    result := ''; // tftBlob* fields e.g. must be handled directly
  end;
end;

function TSynTableFieldProperties.GetInteger(RecordBuffer: pointer): Integer;
begin
  if (self=nil) or (RecordBuffer=nil) or (Owner=nil) then
    result := 0 else begin
    RecordBuffer := Owner.GetData(RecordBuffer,self);
    case FieldType of
    tftBoolean, tftUInt8:
      result := PByte(RecordBuffer)^;
    tftUInt16:
      result := PWord(RecordBuffer)^;
    tftUInt24:
      // PInteger()^ and $ffffff -> possible GPF on Memory Mapped file
      result := PWord(RecordBuffer)^+integer(PByteArray(RecordBuffer)^[2])shl 16;
    tftInt32:
      result := PInteger(RecordBuffer)^;
    tftInt64:
      result := PInt64(RecordBuffer)^;
    // some variable-size field value
    tftVarUInt32:
      result := FromVarUInt32(PByte(RecordBuffer));
    tftVarInt32:
      result := FromVarInt32(PByte(RecordBuffer));
    tftVarUInt64:
      result := FromVarUInt64(PByte(RecordBuffer));
    tftVarInt64:
      result := FromVarInt64(PByte(RecordBuffer));
    else
      result := 0;
    end;
  end;
end;

function TSynTableFieldProperties.GetInt64(RecordBuffer: pointer): Int64;
var PB: PByte;
begin
  if (self=nil) or (RecordBuffer=nil) or (Owner=nil) then
    result := 0 else begin
    PB := Owner.GetData(RecordBuffer,self);
    case FieldType of
    tftInt64:
      result := PInt64(PB)^;
    tftVarUInt64:
      result := FromVarUInt64(PB);
    tftVarInt64:
      result := FromVarInt64(PB);
    else
      result := GetInteger(RecordBuffer);
    end;
  end;
end;

function TSynTableFieldProperties.GetBoolean(RecordBuffer: pointer): Boolean;
begin
  result := boolean(GetInteger(RecordBuffer));
end;

function TSynTableFieldProperties.GetCurrency(RecordBuffer: pointer): Currency;
begin
  if (self=nil) or (RecordBuffer=nil) or (Owner=nil) then
    result := 0 else
    case FieldType of
    tftCurrency:
      result := PCurrency(Owner.GetData(RecordBuffer,self))^;
    else
      result := GetInt64(RecordBuffer);
    end;
end;

function TSynTableFieldProperties.GetDouble(RecordBuffer: pointer): Double;
begin
  if (self=nil) or (RecordBuffer=nil) or (Owner=nil) then
    result := 0 else
    case FieldType of
    tftDouble:
      result := PDouble(Owner.GetData(RecordBuffer,self))^;
    else
      result := GetInt64(RecordBuffer);
    end;
end;

function TSynTableFieldProperties.GetRawUTF8(RecordBuffer: pointer): RawUTF8;
begin
  if (self=nil) or (RecordBuffer=nil) or (Owner=nil) then
    result := '' else begin
    RecordBuffer := Owner.GetData(RecordBuffer,self);
    if RecordBuffer<>nil then
      result := GetValue(RecordBuffer) else // will do conversion to text
      result := '';
  end;
end;

function TSynTableFieldProperties.AddFilterOrValidate(aFilter: TSynFilterOrValidate): TSynFilterOrValidate;
procedure Add(var List: TObjectList);
begin
  if List=nil then
    List := TObjectList.Create;
  List.Add(result);
end;
begin
  result := aFilter;
  if (self=nil) or (result=nil) then
    result := nil else
  if aFilter.InheritsFrom(TSynFilter) then
    Add(Filters) else
  if aFilter.InheritsFrom(TSynValidate) then
    Add(Validates) else
    result := nil;
end;

function TSynTableFieldProperties.Validate(RecordBuffer: pointer;
  RecordIndex: integer): string;
var i: integer;
    Value: RawUTF8;
    aValidate: TSynValidate;
    aValidateTable: TSynValidateTable absolute aValidate;
begin
  result := '';
  if (self=nil) or (Validates=nil) then
    exit;
  Value := GetRawUTF8(RecordBuffer); // TSynTableValidate needs RawUTF8 text
  for i := 0 to Validates.Count-1 do begin
    aValidate := Validates.List[i];
    if aValidate.InheritsFrom(TSynValidateTable) then begin
      aValidateTable.ProcessField := self;
      aValidateTable.ProcessRecordIndex := RecordIndex;
    end;
    if not aValidate.Process(FieldNumber,Value,result) then begin
      if result='' then
        // no custom message -> show a default message
        result := format(sValidationFailed,[
          GetCaptionFromClass(aValidate.ClassType)]);
      break;
    end;
  end;
end;

{$ifdef SORTCOMPAREMETHOD}
function TSynTableFieldProperties.SortCompare(P1, P2: PUTF8Char): PtrInt;
var i, L: integer;
label minus,plus,zer;
begin
  if P1<>P2 then
    if P1<>nil then
      if P2<>nil then
      case FieldType of
      tftBoolean, tftUInt8:
        result := PByte(P1)^-PByte(P2)^;
      tftUInt16:
        result := PWord(P1)^-PWord(P2)^;
      tftUInt24:
        result := PtrInt(PWord(P1)^)+PtrInt(P1[2])shl 16
          -PtrInt(PWord(P2)^)-PtrInt(P2[2]) shl 16;
      tftInt32:
        result := PInteger(P1)^-PInteger(P2)^;
      tftInt64, tftCurrency: begin
        PInt64(@SortCompareTmp)^ := PInt64(P1)^-PInt64(P2)^;
        if PInt64(@SortCompareTmp)^<0 then
          goto minus else
        if PInt64(@SortCompareTmp)^>0 then
          goto plus else
          goto zer;
      end;
      tftDouble: begin
        PDouble(@SortCompareTmp)^ := PDouble(P1)^-PDouble(P2)^;
        if PDouble(@SortCompareTmp)^<0 then
          goto minus else
        if PDouble(@SortCompareTmp)^>0 then
          goto plus else
          goto zer;
      end;
      tftVarUInt32:
      with SortCompareTmp do begin
        PB1 := Pointer(P1);
        PB2 := Pointer(P2);
        result := FromVarUInt32(PB1)-FromVarUInt32(PB2);
      end;
      tftVarInt32:
      with SortCompareTmp do begin
        PB1 := Pointer(P1);
        PB2 := Pointer(P2);
        result := FromVarInt32(PB1)-FromVarInt32(PB2);
      end;
      tftVarUInt64:
      with SortCompareTmp do begin
        PB1 := Pointer(P1);
        PB2 := Pointer(P2);
        result := FromVarUInt64(PB1)-FromVarUInt64(PB2);
      end;
      tftVarInt64:
      with SortCompareTmp do begin
        PB1 := Pointer(P1);
        PB2 := Pointer(P2);
        result := FromVarInt64(PB1)-FromVarInt64(PB2);
      end;
      tftWinAnsi, tftUTF8, tftBlobInternal:
      begin
        with SortCompareTmp do begin
          if PtrInt(P1^)<=$7F then begin
            L1 := PtrInt(P1^);
            inc(P1);
          end else begin
            PB1 := pointer(P1);
            L1 := FromVarUInt32High(PB1);
            P1 := pointer(PB1);
          end;
          if PtrInt(P2^)<=$7F then begin
            L2 := PtrInt(P2^);
            inc(P2);
          end else begin
            PB2 := pointer(P2);
            L2 := FromVarUInt32High(PB2);
            P2 := pointer(PB2);
          end;
        end;
        with SortCompareTmp do begin
          L := L1;
          if L2>L then
            L := L2;
        end;
        if tfoCaseInsensitive in Options then begin
          i := 0;
          while i<L do begin
            result := PtrInt(NormToUpperAnsi7[P1[i]])-PtrInt(NormToUpperAnsi7[P2[i]]);
            if result<>0 then
              exit else
              inc(i);
          end;
        end else begin
          i := 0;
          while i<L do begin
            result := PtrInt(P1[i])-PtrInt(P2[i]);
            if result<>0 then
              exit else
              inc(i);
          end;
        end;
        with SortCompareTmp do
          result := L1-L2;
      end;
      else
        goto zer;
      end else
plus:   result := 1 else  // P2=nil
minus:result := -1 else // P1=nil
zer:result := 0;      // P1=P2
end;
{$endif}

function CompareOperator(FieldType: TSynTableFieldType; SBF, SBFEnd: PUTF8Char;
  Value: Int64; Oper: TCompareOperator): boolean; overload;
var V: Int64;
    PB: PByte absolute SBF;
begin
  result := true;
  if PB<>nil then
  repeat
    case FieldType of
      tftBoolean, tftUInt8:
        V := PB^;
      tftUInt16:
        V := PWord(PB)^;
      tftUInt24:
        // PInteger()^ and $ffffff -> possible GPF on Memory Mapped file
        V := PWord(PB)^+integer(PByteArray(PB)^[2])shl 16;
      tftInt32:
        V := PInteger(PB)^;
      tftInt64:
        V := PInt64(PB)^;
      // some variable-size field value
      tftVarUInt32:
        V := FromVarUInt32(PB);
      tftVarInt32:
        V := FromVarInt32(PB);
      tftVarUInt64:
        V := FromVarUInt64(PB);
      tftVarInt64:
        V := FromVarInt64(PB);
      else V := 0;  // makes compiler happy
    end;
    case Oper of
      soEqualTo:              if V=Value then exit;
      soNotEqualTo:           if V<>Value then exit;
      soLessThan:             if V<Value then exit;
      soLessThanOrEqualTo:    if V<=Value then exit;
      soGreaterThan:          if V>Value then exit;
      soGreaterThanOrEqualTo: if V>=Value then exit;
      else break;
    end;
    // not found: go to next value
    if SBFEnd=nil then
      break; // only one value to be checked
    if FIELD_FIXEDSIZE[FieldType]>0 then
      inc(SBF,FIELD_FIXEDSIZE[FieldType]); // FromVar*() already updated PB/SBF
  until SBF>=SBFEnd;
  result := false; // not found
end;

function CompareOperator(SBF, SBFEnd: PUTF8Char;
  Value: double; Oper: TCompareOperator): boolean; overload;
begin
  result := true;
  if SBF<>nil then
  repeat
    case Oper of
      soEqualTo:              if PDouble(SBF)^=Value then exit;
      soNotEqualTo:           if PDouble(SBF)^<>Value then exit;
      soLessThan:             if PDouble(SBF)^<Value then exit;
      soLessThanOrEqualTo:    if PDouble(SBF)^<=Value then exit;
      soGreaterThan:          if PDouble(SBF)^>Value then exit;
      soGreaterThanOrEqualTo: if PDouble(SBF)^>=Value then exit;
      else break;
    end;
    // not found: go to next value
    if SBFEnd=nil then
      break; // only one value to be checked
    Inc(SBF,sizeof(Value));
  until SBF>=SBFEnd;
  result := false; // not found
end;

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;
begin
  i := 0;
  repeat
    if NormToUpperAnsi7[P1[i]]=NormToUpperAnsi7[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;

var
  /// a temporary buffer, big enough for using the SoundEx algorithm
  SoundExtTmp: array[byte] of AnsiChar;
  
function CompareOperator(FieldType: TSynTableFieldType; SBF, SBFEnd: PUTF8Char;
  Value: PUTF8Char; ValueLen: integer; Oper: TCompareOperator;
  CaseSensitive: boolean): boolean; overload;
var L, Cmp: PtrInt;
    PB: PByte;
begin
  result := true;
  if SBF<>nil then
  repeat
    // get length of text in the SBF encoded buffer
    if integer(SBF^)<=$7f then begin
      L := integer(SBF^);
      inc(SBF);
    end else begin
      PB := Pointer(SBF);
      L := FromVarUInt32(PB);
      SBF := pointer(PB);
    end;
    // perform comparison: returns nil on match
    case Oper of
      soEqualTo..soGreaterThanOrEqualTo: begin
        Cmp := L-ValueLen;
        if Cmp<0 then
          L := ValueLen;
        if CaseSensitive then
          Cmp := StrCompL(SBF,Value,L,Cmp) else
          Cmp := StrCompIL(SBF,Value,L,Cmp);
        case Oper of
          soEqualTo:              if Cmp=0 then exit;
          soNotEqualTo:           if Cmp<>0 then exit;
          soLessThan:             if Cmp<0 then exit;
          soLessThanOrEqualTo:    if Cmp<=0 then exit;
          soGreaterThan:          if Cmp>0 then exit;
          soGreaterThanOrEqualTo: if Cmp>=0 then exit;
        end;
      end;
      soBeginWith:
        if ValueLen>=L then
          if CaseSensitive then begin
            if StrCompL(SBF,Value,ValueLen,0)=0 then
              exit;
          end else
            if StrCompIL(SBF,Value,ValueLen,0)=0 then
              exit;
      soContains: begin
        dec(L,ValueLen);
        while L>=0 do begin
          while (L>=0) and not(byte(SBF^) in IsWord) do begin
            dec(L);
            inc(SBF);
          end; // begin of next word reached
          if L<0 then
            Break; // not enough chars to contain the Value
          if CaseSensitive then begin
            if StrCompL(SBF,Value,ValueLen,0)=0 then
              exit;
          end else
            if StrCompIL(SBF,Value,ValueLen,0)=0 then
              exit;
          while (L>=0) and (byte(SBF^) in IsWord) do begin
            dec(L);
            inc(SBF);
          end; // end of word reached
        end;
        if SBFEnd=nil then
          break; // only one value to be checked
        inc(SBF,ValueLen); // custom inc(SBF,L);
        if SBF<SBFEnd then
          continue else break;
      end;
      soSoundsLikeEnglish,
      soSoundsLikeFrench,
      soSoundsLikeSpanish: begin
        if L>high(SoundExtTmp) then
          cmp := high(SoundExtTmp) else
          cmp := L;
        SoundExtTmp[cmp] := #0; // TSynSoundEx expect the buffer to be #0 terminated
        move(SBF^,SoundExtTmp,cmp);
        case FieldType of
        tftWinAnsi:
          if PSynSoundEx(Value)^.Ansi(SoundExtTmp) then
            exit;
        tftUTF8:
          if PSynSoundEx(Value)^.UTF8(SoundExtTmp) then
            exit;
        else break;
        end;
      end;
      else break;
    end;
    // no match -> go to the end of the SBF buffer
    if SBFEnd=nil then
      exit; // only one value to be checked
    inc(SBF,L);
    if SBF>=SBFEnd then
      break;
  until false;
end;


{ TSynValidateTableUniqueField }

function TSynValidateTableUniqueField.Process(aFieldIndex: integer;
  const Value: RawUTF8; var ErrorMsg: string): boolean;
var S: TSBFString;
begin
  result := false;
  if (self=nil) or (Value='') or (ProcessField=nil) then
    exit; // void field can't be unique
  if not (tfoIndex in ProcessField.Options) then
    exit; // index should be always created by TSynTable.AfterFieldModif
  S := ProcessField.SBFFromRawUTF8(Value);
  if S='' then
    exit; // void field can't be unique
  if ProcessField.OrderedIndexFindAdd(Pointer(S))>=0 then
    // there is some place to insert the Value -> not existing yet -> OK
    result := true else begin
    // RecordIndex=-1 in case of adding, or the physical index of the updated record
    if (ProcessRecordIndex>=0) and
       (ProcessField.OrderedIndex[ProcessField.OrderedIndexFind(Pointer(S))]=
         ProcessRecordIndex) then
      // allow update of the record
      result := true else
      // found a dupplicated value
      ErrorMsg := sValidationFieldDuplicate;
  end;
end;


{ TSynTableStatement }

function IsRowID(FieldName: PUTF8Char): boolean;
begin
  if FieldName=nil then
    result := false else
    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')));
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
  SetRawUTF8(Prop,B,P-B);
  while P^ in [#1..' ',';'] do inc(P);
  result := Prop<>'';
end;


constructor TSynTableStatement.Create(const SQL: RawUTF8;
  GetFieldIndex: TSynTableFieldIndex; SimpleFieldsBits: TSQLFieldBits=[0..MAX_SQLFIELDS-1];
  FieldProp: TSynTableFieldProperties=nil);
var Prop: RawUTF8;
    P, B: PUTF8Char;
    ndx,err,len,selectCount,whereCount: integer;
    whereWithOR,whereNotClause: boolean;

function GetPropIndex: integer;
begin
  if not GetNextFieldProp(P,Prop) then
    result := -1 else
  if IsRowID(pointer(Prop)) then
    result := 0 else begin // 0 = ID field
    result := GetFieldIndex(Prop);
    if result>=0 then // -1 = no valid field name
      inc(result);  // otherwise: PropertyIndex+1
  end;
end;
function SetFields: boolean;
var select: TSynTableStatementSelect;
begin
  result := false;
  fillchar(select,sizeof(select),0);
  select.Field := GetPropIndex; // 0 = ID, otherwise PropertyIndex+1
  if select.Field<0 then begin
    if P^<>'(' then // Field not found -> try function(field)
      exit;
    P := GotoNextNotSpace(P+1);
    select.FunctionName := Prop;
    inc(fSelectFunctionCount);
    if IdemPropNameU(Prop,'COUNT') and (P^='*') then begin
      select.Field := 0; // count(*) -> count(ID)
      select.FunctionKnown := funcCountStar;
      P := GotoNextNotSpace(P+1);
    end else begin
      if IdemPropNameU(Prop,'DISTINCT') then
        select.FunctionKnown := funcDistinct;
      select.Field := GetPropIndex;
      if select.Field<0 then
        exit;
    end;
    if P^<>')' then
      exit;
    P := GotoNextNotSpace(P+1);
  end;
  if P^ in ['+','-'] then begin
    select.ToBeAdded := GetNextItemInteger(P,' ');
    if select.ToBeAdded=0 then
      exit;
    P := GotoNextNotSpace(P);
  end;
  if IdemPChar(P,'AS ') then begin
    inc(P,3);
    if not GetNextFieldProp(P,select.Alias) then
      exit;
  end;
  SetLength(fSelect,selectCount+1);
  fSelect[selectCount] := select;
  inc(selectCount);
  result := true;
end;
function GetWhereValue(var Where: TSynTableStatementWhere): boolean;
begin
  result := false;
  P := GotoNextNotSpace(P);
  Where.ValueSQL := P;
  if PWord(P)^=ord(':')+ord('(') shl 8 then
    inc(P,2); // ignore :(...): parameter (no prepared statements here)
  if P^ in ['''','"'] then begin
    // SQL String statement
    P := UnQuoteSQLStringVar(P,Where.Value);
    if P=nil then
      exit; // end of string before end quote -> incorrect
    {$ifndef NOVARIANTS}
    RawUTF8ToVariant(Where.Value,Where.ValueVariant);
    {$endif}
    if FieldProp<>nil then
      // create a SBF formatted version of the WHERE value
      Where.ValueSBF := FieldProp.SBFFromRawUTF8(Where.Value);
  end else
  if (PInteger(P)^ and $DFDFDFDF=NULL_UPP) and (P[4] in [#0..' ',';']) then begin
    // NULL statement
    Where.Value := 'null'; // not void
    {$ifndef NOVARIANTS}
    SetVariantNull(Where.ValueVariant);
    {$endif}
  end else begin
    // numeric statement or 'true' or 'false' (OK for NormalizeValue)
    B := P;
    repeat
      inc(P);
    until P^ in [#0..' ',';',')'];
    SetString(Where.Value,B,P-B);
    {$ifndef NOVARIANTS}
    Where.ValueVariant := VariantLoadJSON(Where.Value);
    {$endif}
    Where.ValueInteger := GetInteger(pointer(Where.Value),err);
    if FieldProp<>nil then
      if Where.Value<>'?' then
        if (FieldProp.FieldType in FIELD_INTEGER) and (err<>0) then
          // we expect a true INTEGER value here
          Where.Value := '' else
          // create a SBF formatted version of the WHERE value
          Where.ValueSBF := FieldProp.SBFFromRawUTF8(Where.Value);
  end;
  if PWord(P)^=ord(')')+ord(':')shl 8 then
    inc(P,2); // ignore :(...): parameter
  Where.ValueSQLLen := P-Where.ValueSQL;
  P := GotoNextNotSpace(P);
  result := true;
end;
function GetWhereExpression(FieldIndex: integer; var Where: TSynTableStatementWhere): boolean;
begin
  result := false;
  Where.JoinedOR := whereWithOR;
  Where.NotClause := whereNotClause;
  Where.Field := FieldIndex; // 0 = ID, otherwise PropertyIndex+1
  case P^ of
  '=': Where.Operator := opEqualTo;
  '>': if P[1]='=' then begin
         inc(P);
         Where.Operator := opGreaterThanOrEqualTo;
       end else
         Where.Operator := opGreaterThan;
  '<': case P[1] of
       '=': begin
         inc(P);
         Where.Operator := opLessThanOrEqualTo;
       end;
       '>': begin
         inc(P);
         Where.Operator := opNotEqualTo;
       end;
       else
         Where.Operator := opLessThan;
       end;
  'i','I':
    case P[1] of
    's','S': begin
      P := GotoNextNotSpace(P+2);
      if IdemPChar(P,'NULL') then begin
        Where.Value := 'null';
        Where.Operator := opIsNull;
        Where.ValueSQL := P;
        Where.ValueSQLLen := 4;
        {$ifndef NOVARIANTS}
        TVarData(Where.ValueVariant).VType := varNull;
        {$endif}
        inc(P,4);
        result := true;
      end else
      if IdemPChar(P,'NOT NULL') then begin
        Where.Value := 'not null';
        Where.Operator := opIsNotNull;
        Where.ValueSQL := P;
        Where.ValueSQLLen := 8;
        {$ifndef NOVARIANTS}
        TVarData(Where.ValueVariant).VType := varNull;
        {$endif}
        inc(P,8);
        result := true; // leave ValueVariant=unassigned
      end;
      exit;
    end;
    {$ifndef NOVARIANTS}
    'n','N': begin
       Where.Operator := opIn;
       P := GotoNextNotSpace(P+2);
       if P^<>'(' then
         exit; // incorrect SQL statement
       B := P; // get the IN() clause as JSON - without :(...): by now
       inc(P);
       while P^<>')' do
         if P^=#0 then
           exit else
           inc(P);
       inc(P);
       SetString(Where.Value,PAnsiChar(B),P-B);
       Where.ValueSQL := B;
       Where.ValueSQLLen := P-B;
       Where.Value[1] := '[';
       Where.Value[P-B] := ']';
       TDocVariantData(Where.ValueVariant).InitJSONInPlace(
         pointer(Where.Value),JSON_OPTIONS[true]);
       result := true;
       exit;
    end;
    {$endif}
    end; // 'i','I':
  'l','L':
    if IdemPChar(P+1,'IKE') then begin
      inc(P,3);
      Where.Operator := opLike;
    end else
    exit;
  else exit; // unknown operator
  end;
  // we got 'WHERE FieldName operator ' -> handle value
  inc(P);
  result := GetWhereValue(Where);
end;

label lim,lim2;
begin
  P := pointer(SQL);
  if (P=nil) or (self=nil) then
    exit; // avoid GPF
  P := GotoNextNotSpace(P); // trim left
  if not IdemPChar(P,'SELECT ') then
    exit else // handle only SELECT statement
    inc(P,7);
  // 1. get SELECT clause: set bits in Fields from CSV field IDs in SQL
  selectCount := 0;
  P := GotoNextNotSpace(P); // trim left
  if P^=#0 then
    exit; // no SQL statement
  if P^='*' then begin // all simple (not TSQLRawBlob/TSQLRecordMany) fields
    inc(P);
    SetLength(fSelect,GetBitsCount(SimpleFieldsBits,MAX_SQLFIELDS)+1);
    selectCount := 1; // Select[0].Field := 0 -> ID
    for ndx := 0 to MAX_SQLFIELDS-1 do
      if ndx in SimpleFieldsBits then begin
        fSelect[selectCount].Field := ndx+1;
        inc(selectCount);
      end;
    GetNextFieldProp(P,Prop);
  end else
  if not SetFields then
    exit else // we need at least one field name
    if P^<>',' then
      GetNextFieldProp(P,Prop) else
      repeat
        while P^ in [',',#1..' '] do inc(P); // trim left
      until not SetFields; // add other CSV field names
  // 2. get FROM clause
  if not IdemPropNameU(Prop,'FROM') then exit; // incorrect SQL statement
  GetNextFieldProp(P,Prop);
  fTableName := Prop;
  // 3. get WHERE clause
  whereCount := 0;
  whereWithOR := false;
  whereNotClause := false;
  GetNextFieldProp(P,Prop);
  if IdemPropNameU(Prop,'WHERE') then begin
    repeat
      B := P;
      ndx := GetPropIndex;
      if ndx<0 then begin
        if IdemPropNameU(Prop,'NOT') then begin
          whereNotClause := true;
          continue;
        end;
        if P^='(' then begin
          inc(P);
          SetLength(fWhere,whereCount+1);
          with fWhere[whereCount] do begin
            JoinedOR := whereWithOR;
            FunctionName := UpperCase(Prop);
            // Byte/Word/Integer/Cardinal/Int64/CurrencyDynArrayContains(BlobField,I64)
            len := length(Prop);
            if (len>16) and
               IdemPropName('DynArrayContains',PUTF8Char(@PByteArray(Prop)[len-16]),16) then
              Operator := opContains else
              Operator := opFunction;
            B := P;
            Field := GetPropIndex;
            if Field<0 then
              P := B else
              if P^<>',' then
                break else
                P := GotoNextNotSpace(P+1);
            if (P^=')') or
               (GetWhereValue(fWhere[whereCount]) and (P^=')')) then begin
              inc(P);
              break;
            end;
          end;
        end;
        P := B;
        break;
      end;
      SetLength(fWhere,whereCount+1);
      if not GetWhereExpression(ndx,fWhere[whereCount]) then
        exit; // invalid SQL statement
      inc(whereCount);
      GetNextFieldProp(P,Prop);
      if IdemPropNameU(Prop,'OR') then
        whereWithOR := true else
      if IdemPropNameU(Prop,'AND') then
        whereWithOR := false else
        goto lim2;
      whereNotClause := false;
    until false;
    // 4. get optional LIMIT/OFFSET/ORDER clause
lim:P := GotoNextNotSpace(P);
    while (P<>nil) and not(P^ in [#0,';']) do begin
      GetNextFieldProp(P,Prop);
lim2: if IdemPropNameU(Prop,'LIMIT') then
        fLimit := GetNextItemCardinal(P,' ') else
      if IdemPropNameU(Prop,'OFFSET') then
        fOffset := GetNextItemCardinal(P,' ') else
      if IdemPropNameU(Prop,'ORDER') then begin
        GetNextFieldProp(P,Prop);
        if IdemPropNameU(Prop,'BY') then begin
          repeat
            ndx := GetPropIndex; // 0 = ID, otherwise PropertyIndex+1
            if ndx<0 then
              exit; // incorrect SQL statement
            AddFieldIndex(fOrderByField,ndx);
            if P^<>',' then begin // check ORDER BY ... ASC/DESC
              B := P;
              if GetNextFieldProp(P,Prop) then
                if IdemPropNameU(Prop,'DESC') then
                  fOrderByDesc := true else
                if not IdemPropNameU(Prop,'ASC') then
                  P := B;
              break;
            end;
            P := GotoNextNotSpace(P+1);
          until P^ in [#0,';'];
        end else
        exit; // incorrect SQL statement
      end else
      if IdemPropNameU(Prop,'GROUP') then begin
        GetNextFieldProp(P,Prop);
        if IdemPropNameU(Prop,'BY') then begin
          repeat
            ndx := GetPropIndex; // 0 = ID, otherwise PropertyIndex+1
            if ndx<0 then
              exit; // incorrect SQL statement
            AddFieldIndex(fGroupByField,ndx);
            if P^<>',' then
              break;
            P := GotoNextNotSpace(P+1);
          until P^ in [#0,';'];
        end else
        exit; // incorrect SQL statement
      end else
      if Prop<>'' then
        exit else // incorrect SQL statement
        break; // reached the end of the statement
    end;
  end else
  if Prop<>'' then
    goto lim2; // handle LIMIT OFFSET ORDER
  fSQLStatement := SQL; // make a private copy e.g. for Where[].ValueSQL
end;

procedure TSynTableStatement.SelectFieldBits(var Fields: TSQLFieldBits; var withID: boolean);
var i: integer;
begin
  fillchar(Fields,sizeof(Fields),0);
  withID := false;
  for i := 0 to Length(Select)-1 do
    if Select[i].Field=0 then
      withID := true else
      include(Fields,Select[i].Field-1);
end;


{$ifndef DELPHI5OROLDER}

{ TSynTableData }

procedure TSynTableData.CheckVTableInitialized;
begin
  if VTable=nil then
    raise ETableDataException.Create('TSynTableData non initialized');
end;

{$ifndef NOVARIANTS}

function TSynTableData.GetFieldValue(const FieldName: RawUTF8): Variant;
begin
  GetFieldVariant(FieldName,result);
end;

procedure TSynTableData.GetFieldVariant(const FieldName: RawUTF8; var result: Variant);
var aField: TSynTableFieldProperties;
begin
  if IsRowID(Pointer(FieldName)) then
    result := VID else begin
    CheckVTableInitialized;
    aField := VTable.FieldFromName[FieldName];
    if aField=nil then
      raise ETableDataException.CreateUTF8('Unknown % property',[FieldName]) else
    aField.GetVariant(VTable.GetData(pointer(VValue),aField),result);
  end;
end;

function TSynTableData.GetFieldValue(aField: TSynTableFieldProperties): Variant;
begin
  CheckVTableInitialized;
  aField.GetVariant(VTable.GetData(pointer(VValue),aField),result);
end;

{$endif NOVARIANTS}

procedure TSynTableData.FilterSBFValue;
begin
  CheckVTableInitialized;
  VTable.Filter(VValue);
end;

function TSynTableData.GetFieldSBFValue(aField: TSynTableFieldProperties): TSBFString;
var FieldBuffer: PAnsiChar;
begin
  CheckVTableInitialized;
  FieldBuffer := VTable.GetData(pointer(VValue),aField);
  SetString(Result,FieldBuffer,aField.GetLength(FieldBuffer));
end;

procedure TSynTableData.Init(aTable: TSynTable; aID: Integer);
begin
  VTable := aTable;
  VID := aID;
  VValue := VTable.DefaultRecordData;
  {$ifdef UNICODE}FillChar(Filler,sizeof(Filler),0);{$endif}
end;

procedure TSynTableData.Init(aTable: TSynTable; aID: Integer;
  RecordBuffer: pointer; RecordBufferLen: integer);
begin
  VTable := aTable;
  if (RecordBufferLen=0) or (RecordBuffer=nil) then begin
    VID := 0;
    VValue := VTable.DefaultRecordData;
  end else begin
    VID := aID;
    SetString(VValue,PAnsiChar(RecordBuffer),RecordBufferLen);
  end;
end;

{$ifndef NOVARIANTS}
procedure TSynTableData.SetFieldValue(const FieldName: RawUTF8;
  const Value: Variant);
var F: TSynTableFieldProperties;
begin
  CheckVTableInitialized;
  if IsRowID(Pointer(FieldName)) then
    VID := Value else begin
    F := VTable.FieldFromName[FieldName];
    if F=nil then
      raise ETableDataException.CreateUTF8('Unknown % property',[FieldName]) else
      SetFieldValue(F,Value);
  end;
end;

procedure TSynTableData.SetFieldValue(aField: TSynTableFieldProperties; const Value: Variant);
begin
  SetFieldSBFValue(aField,aField.SBF(Value));
end;
{$endif}

procedure TSynTableData.SetFieldSBFValue(aField: TSynTableFieldProperties;
  const Value: TSBFString);
var NewValue: TSBFString;
begin
  CheckVTableInitialized;
  if (aField.FieldSize>0) and (VValue<>'') then begin
    // fixed size content: fast in-place update
    Move(pointer(Value)^,VValue[aField.Offset+1],aField.FieldSize)
    // VValue[F.Offset+1] above will call UniqueString(VValue), even under FPC
  end else begin
    // variable-length update
    VTable.UpdateFieldData(pointer(VValue),length(VValue),
      aField.FieldNumber,NewValue,Value);
    VValue := NewValue;
  end;
end;

function TSynTableData.ValidateSBFValue(RecordIndex: integer): string;
begin
  CheckVTableInitialized;
  Result := VTable.Validate(Pointer(VValue),RecordIndex);
end;

{$endif DELPHI5OROLDER}


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
  inc(P,Len);
  with PSynLZTrailer(P-sizeof(TSynLZTrailer))^ do
    if (Magic=aMagic) and (HeaderRelativeOffset<Len) and
       (PSynLZHead(P-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: pointer;
    P: pointer;
    Head: TSynLZHead;
    Trailer: TSynLZTrailer;
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;
  Getmem(P,SynLZcompressdestlen(DataLen));
  try
    Head.Magic := Magic;
    Head.UnCompressedSize := DataLen;
    Head.HashUncompressed := Hash32(S,DataLen);
    result := SynLZcompress1(S,DataLen,P); 
    Head.CompressedSize := result;
    Head.HashCompressed := Hash32(P,result);
    Dest.Write(Head,sizeof(Head));
    Dest.Write(P^,Head.CompressedSize);
    Trailer.HeaderRelativeOffset := result+(sizeof(Head)+sizeof(Trailer));
    Trailer.Magic := Magic;
    Dest.Write(Trailer,sizeof(Trailer));
    result := Head.CompressedSize+(sizeof(Head)+sizeof(Trailer));
  finally
    Freemem(P);
  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 := TFileStream.Create(Source,fmOpenRead or fmShareDenyNone);
    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 := TFileStream.Create(Source,fmOpenRead or fmShareDenyNone);
    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 dst='' then
            SetString(dst,nil,Head.UnCompressedSize);
          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 (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 StreamUnSynLZ(const Source: TFileName; Magic: cardinal): TMemoryStream; overload;
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: pointer;
    sourcePosition,resultSize: PtrInt;
    sourceSize: Int64;
    Head: TSynLZHead;
    Trailer: TSynLZTrailer;
    buf: RawByteString;
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
    Source.Read(Head,sizeof(Head));
    if Head.Magic<>Magic then begin
      // Source not positioned as expected -> try from the end
      Source.Position := sourceSize-sizeof(Trailer);
      Source.Read(Trailer,sizeof(Trailer));
      if Trailer.Magic<>Magic then
        exit;
      sourcePosition := sourceSize-Trailer.HeaderRelativeOffset;
      Source.Position := sourcePosition;
      Source.Read(Head,sizeof(Head));
      inc(sourcePosition,sizeof(Head));
      if 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 will now point after all data
    if (SynLZdecompressdestlen(S)<>Head.UnCompressedSize) or
       (Hash32(S,Head.CompressedSize)<>Head.HashCompressed) then
      exit;
    if result=nil then
      result := THeapMemoryStream.Create else begin
      {$ifndef CPU64}
      if Int64(resultSize)+Head.UnCompressedSize>maxInt then begin
        FreeAndNil(result); // result TMemoryStream should stay in memory!
        break;
      end;
      {$endif}
    end;
    result.Size := resultSize+Head.UnCompressedSize;
    D := PAnsiChar(result.Memory)+resultSize;
    inc(resultSize,Head.UnCompressedSize);
    if (SynLZdecompress1(S,Head.CompressedSize,D)<>Head.UnCompressedSize) or
       (Hash32(D,Head.UnCompressedSize)<>Head.HashUncompressed) then begin
      FreeAndNil(result);
      break;
    end;
  until sourcePosition>=sourceSize;
end;

const
  SYNLZCOMPRESS_STORED = #0;
  SYNLZCOMPRESS_SYNLZ = #1;

function SynLZCompress(const Data: RawByteString; CompressionSizeTrigger: integer): RawByteString;
begin
  SynLZCompress(pointer(Data),length(Data),result,CompressionSizeTrigger);
end;

procedure SynLZCompress(P: PAnsiChar; PLen: integer; out Result: RawByteString;
  CompressionSizeTrigger: integer);
var len: integer;
    R: PAnsiChar;
    crc: cardinal;
begin
  if PLen=0 then
    exit;
  crc := crc32c(0,P,PLen);
  if PLen<CompressionSizeTrigger then begin
    SetString(result,nil,PLen+9);
    R := pointer(result);
    PCardinal(R)^ := crc;
    R[4] := SYNLZCOMPRESS_STORED;
    PCardinal(R+5)^ := crc;
    move(P^,R[9],PLen);
  end else begin
    SetString(result,nil,SynLZcompressdestlen(PLen)+9);
    R := pointer(result);
    PCardinal(R)^ := crc;
    R[4] := SYNLZCOMPRESS_SYNLZ;
    len := SynLZcompress1(P,PLen,R+9);
    PCardinal(R+5)^ := crc32c(0,pointer(R+9),len);
    SetLength(result,len+9);
  end;
end;

function SynLZDecompress(const Data: RawByteString): RawByteString;
begin
  SynLZDecompress(pointer(Data),Length(Data),result);
end;

procedure SynLZDecompress(P: PAnsiChar; PLen: integer; out Result: RawByteString);
var len: integer;
begin
  if (PLen<=9) or (crc32c(0,pointer(P+9),PLen-9)<>PCardinal(P+5)^) then
    exit;
  case P[4] of
  SYNLZCOMPRESS_STORED:
    if PCardinal(P)^=PCardinal(P+5)^ then
      SetString(result,P+9,PLen-9);
  SYNLZCOMPRESS_SYNLZ: begin
    len := SynLZdecompressdestlen(P+9);
    SetLength(result,len);
    if (len<>0) and
       ((SynLZdecompress1(P+9,PLen-9,pointer(result))<>len) or
       (crc32c(0,pointer(result),len)<>PCardinal(P)^)) then
      result := '';
  end;
  end;
end;

function SynLZCompressToBytes(const Data: RawByteString;
  CompressionSizeTrigger: integer): TByteDynArray;
begin
  result := SynLZCompressToBytes(pointer(Data),length(Data),CompressionSizeTrigger);
end;

function SynLZCompressToBytes(P: PAnsiChar; PLen,CompressionSizeTrigger: integer): TByteDynArray; overload;
var len: integer;
    R: PAnsiChar;
    crc: cardinal;
begin
  if PLen=0 then
    exit;
  crc := crc32c(0,P,PLen);
  if PLen<CompressionSizeTrigger then begin
    SetLength(result,PLen+9);
    R := pointer(result);
    PCardinal(R)^ := crc;
    R[4] := SYNLZCOMPRESS_STORED;
    PCardinal(R+5)^ := crc;
    move(P^,R[9],PLen);
  end else begin
    SetLength(result,SynLZcompressdestlen(PLen)+9);
    R := pointer(result);
    PCardinal(R)^ := crc;
    R[4] := SYNLZCOMPRESS_SYNLZ;
    len := SynLZcompress1(P,PLen,R+9);
    PCardinal(R+5)^ := crc32c(0,pointer(R+9),len);
    SetLength(result,len+9);
  end;
end;

function SynLZDecompress(const Data: TByteDynArray): RawByteString; overload;
begin
  SynLZDecompress(pointer(Data),length(Data),result);
end;


{ ESynException }

constructor ESynException.CreateUTF8(const Format: RawUTF8; const Args: array of const);
begin
  inherited Create(UTF8ToString(FormatUTF8(Format,Args)));
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;
begin
  i := length(Header);
  if i>0 then
    Dest.Write(pointer(Header)^,i);
  if fMap.Size>0 then
    Dest.Write(fMap.Buffer^,fMap.Size);
  if fAppendedLinesCount=0 then
    exit;
  W := TTextWriter.Create(Dest);
  try
    if (fMap.Size>0) and (fMap.Buffer[fMap.Size-1]>=' ') then
      W.Add(#13);
    for i := 0 to fAppendedLinesCount-1 do begin
      W.AddString(fAppendedLines[i]);
      W.Add(#13);
    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
    SetString(result,PAnsiChar(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: integer;
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 not (AnsiChar(i) in ANSICHARNOT01310) then break;
    if NormToUpperAnsi7Byte[i]=ord(up^) then goto Fnd;
    inc(p);
    if p>=pEnd then break;
    i := ord(p^);
    if not (AnsiChar(i) in ANSICHARNOT01310) then break;
    if NormToUpperAnsi7Byte[i]=ord(up^) then goto Fnd;
    inc(p);
    if p>=pEnd then break;
    i := ord(p^);
    if not (AnsiChar(i) in ANSICHARNOT01310) then break;
    if NormToUpperAnsi7Byte[i]=ord(up^) then goto Fnd;
    inc(p);
    if p>=pEnd then break;
    i := ord(p^);
    if not (AnsiChar(i) in ANSICHARNOT01310) 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 (P^ in ANSICHARNOT01310) 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
    inc(fLinesMax,256+fLinesMax shr 3);
    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;
    move(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));
    move(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 := PosEx('=',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.Init(aCaseSensitive: boolean);
begin
  fillchar(self,sizeof(Self),0);
  fDynArray.Init(
    TypeInfo(TSynNameValueItemDynArray),List,nil,nil,nil,@Count,not aCaseSensitive);
end;

function TSynNameValue.Find(const aName: RawUTF8): integer;
begin
  result := fDynArray.FindHashed(aName);
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.Value(const aName: RawUTF8; const aDefaultValue: RawUTF8=''): RawUTF8;
var i: integer;
begin
  i := fDynArray.FindHashed(aName);
  if i<0 then
    result := aDefaultValue else
    result := List[i].Value;
end;

function TSynNameValue.Initialized: boolean;
begin
  result := fDynArray.fValue=@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;


{ TSynAuthenticationAbstract }

constructor TSynAuthenticationAbstract.Create;
begin
  fLock := TAutoLocker.Create;
  fTokenSeed := GetTickCount64*PtrUInt(self)*Random(maxInt);
  fSessionGenerator := abs(fTokenSeed*PtrUInt(ClassType));
end;

destructor TSynAuthenticationAbstract.Destroy;
begin
  fLock.Free;
  inherited;
end;

class function TSynAuthenticationAbstract.ComputeHash(Token: Int64;
  const UserName,PassWord: RawUTF8): cardinal;
begin // rough authentication - better than nothing
  result := length(UserName);
  result := crc32c(crc32c(crc32c(result,@Token,sizeof(Token)),
    pointer(UserName),result),pointer(Password),length(PassWord));
end;

function TSynAuthenticationAbstract.ComputeCredential(previous: boolean;
  const UserName,PassWord: RawUTF8): cardinal;
var tok: Int64;
begin
  tok := GetTickCount64 div 10000;
  if previous then
    dec(tok);
  result := ComputeHash(tok xor fTokenSeed,UserName,PassWord);
end;

function TSynAuthenticationAbstract.CurrentToken: Int64;
begin
  result := (GetTickCount64 div 10000) xor fTokenSeed;
end;

procedure TSynAuthenticationAbstract.AuthenticateUser(const aName, aPassword: RawUTF8);
begin
  raise ESynException.CreateFmt('%.AuthenticateUser() is not implemented',[self]);
end;

procedure TSynAuthenticationAbstract.DisauthenticateUser(const aName: RawUTF8);
begin
  raise ESynException.CreateFmt('%.DisauthenticateUser() is not implemented',[self]);
end;

function TSynAuthenticationAbstract.CreateSession(const User: RawUTF8; Hash: cardinal): integer;
var password: RawUTF8;
begin
  result := 0;
  fLock.Enter;
  try
    // check the credentials
    if not GetPassword(User,password) then
      exit;
    if (ComputeCredential(false,User,password)<>Hash) and
       (ComputeCredential(true,User,password)<>Hash) then
      exit;
    // create the new session
    repeat
      result := fSessionGenerator;
      inc(fSessionGenerator);
    until result<>0;
    AddSortedInteger(fSessions,fSessionsCount,result);
  finally
    fLock.Leave;
  end;
end;

function TSynAuthenticationAbstract.SessionExists(aID: integer): boolean;
begin
  fLock.Enter;
  result := FastFindIntegerSorted(pointer(fSessions),fSessionsCount-1,aID)>=0;
  fLock.Leave;
end;

procedure TSynAuthenticationAbstract.RemoveSession(aID: integer);
var i: integer;
begin
  fLock.Enter;
  i := FastFindIntegerSorted(pointer(fSessions),fSessionsCount-1,aID);
  if i>=0 then
    DeleteInteger(fSessions,fSessionsCount,i);
  fLock.Leave;
end;


{ TSynAuthentication }

constructor TSynAuthentication.Create(const aUserName,aPassword: RawUTF8);
begin
  inherited Create;
  fCredentials.Init(true);
  if aUserName<>'' then
    AuthenticateUser(aUserName,aPassword);
end;

function TSynAuthentication.GetPassword(const UserName: RawUTF8;
  out Password: RawUTF8): boolean;
var i: integer;
begin
  i := fCredentials.Find(UserName);
  if i<0 then begin
    result := false;
    exit;
  end;
  password := fCredentials.List[i].Value;
  result := true;
end;

function TSynAuthentication.GetUsersCount: integer;
begin
  result := fCredentials.Count;
end;

procedure TSynAuthentication.AuthenticateUser(const aName, aPassword: RawUTF8);
begin
  fLock.Enter;
  fCredentials.Add(aName,aPassword);
  fLock.Leave;
end;

procedure TSynAuthentication.DisauthenticateUser(const aName: RawUTF8);
begin
  fLock.Enter;
  fCredentials.Delete(aName);
  fLock.Leave;
end;


{ TSynBackgroundThreadAbstract }

{$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: 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 FPC}
  exit;
  {$endif}
  {$ifdef NOSETTHREADNAME}
  exit;
  {$endif}
  {$ifdef MSWINDOWS}
  if not IsDebuggerPresent then
    exit;
  {$endif}
  name := CurrentAnsiConvert.UTF8ToAnsi(FormatUTF8(Format,Args));
  {$ifdef ISDELPHIXE2}
  TThread.NameThreadForDebugging(name,ThreadID);
  {$else}
  {$ifdef MSWINDOWS}
  info.FType := $1000;
  info.FName := pointer(name);
  info.FThreadID := ThreadID;
  info.FFlags := 0;
  try
    RaiseException($406D1388,0,SizeOf(info) div SizeOf(LongWord),@info);
  except {ignore} end;
  {$endif}
  {$endif}
end;

constructor TSynBackgroundThreadAbstract.Create(aOnIdle: TOnIdleSynBackgroundThread;
  const aThreadName: RawUTF8);
begin
  fOnIdle := aOnIdle;
  fProcessEvent := TEvent.Create(nil,false,false,'');
  fCallerEvent := TEvent.Create(nil,false,false,'');
  fThreadName := aThreadName;
  inherited Create(false);
  InitializeCriticalSection(fPendingProcessLock);
end;

{$ifdef KYLIX3}
type
  // see http://stackoverflow.com/a/3085509/458259 about the Kylix only bug
  TEventHack = class(THandleObject) // should match EXACTLY SyncObjs.pas source!
  private
    FEvent: TSemaphore;
    FManualReset: Boolean;
  end;

function FixedWaitFor(Event: TEvent; Timeout: LongWord): TWaitResult;
var E: TEventHack absolute Event;
procedure SetResult(res: integer);
begin
  if res=0 then
    result := wrSignaled else
  if errno in [EAGAIN,ETIMEDOUT] then
    result := wrTimeOut else begin
    write(TimeOut,':',errno,' ');
    result := wrError;
  end;
end;
{.$define USESEMTRYWAIT}
// sem_timedwait() is slower than sem_trywait(), but consuming much less CPU
{$ifdef USESEMTRYWAIT}
var time: timespec;
{$else}
var start,current: Int64;
    elapsed: LongWord;
{$endif}
begin
  if Timeout=INFINITE then begin
    SetResult(sem_wait(E.FEvent));
    exit;
  end;
  if TimeOut=0 then begin
    SetResult(sem_trywait(E.FEvent));
    exit;
  end;
  {$ifdef USESEMTRYWAIT}
  clock_gettime(CLOCK_REALTIME,time);
  inc(time.tv_sec,TimeOut div 1000);
  inc(time.tv_nsec,(TimeOut mod 1000)*1000000);
  while time.tv_nsec>1000000000 do begin
    inc(time.tv_sec);
    dec(time.tv_nsec,1000000000);
  end;
  SetResult(sem_timedwait(E.FEvent,time));
  {$else}
  start := GetTickCount64;
  repeat
     if sem_trywait(E.FEvent)=0 then begin
       result := wrSignaled;
       break;
     end;
     current := GetTickCount64;
     elapsed := current-start;
     if elapsed=0 then
       sched_yield else
     if elapsed>TimeOut then begin
       result := wrTimeOut;
       break;
     end else
     if elapsed<5 then
       usleep(50) else
       usleep(1000);
  until false;
  {$endif}
  if E.FManualReset then begin
    repeat until sem_trywait(E.FEvent)<>0; // reset semaphore state
    sem_post(E.FEvent);
  end;
end;

{$else KYLIX3} // original FPC or Windows is OK:

function FixedWaitFor(Event: TEvent; Timeout: LongWord): TWaitResult;
begin
  result := Event.WaitFor(TimeOut);
end;

{$endif KYLIX3}

procedure FixedWaitForever(Event: TEvent);
begin
  FixedWaitFor(Event,INFINITE);
end;

destructor TSynBackgroundThreadAbstract.Destroy;
begin
  SetPendingProcess(flagDestroying);
  fProcessEvent.SetEvent;  // notify terminated
  FixedWaitForever(fCallerEvent);
  FreeAndNil(fProcessEvent);
  FreeAndNil(fCallerEvent);
  DeleteCriticalSection(fPendingProcessLock);
  inherited Destroy;
end;

function TSynBackgroundThreadAbstract.GetPendingProcess: TSynBackgroundThreadProcessStep;
begin
  EnterCriticalSection(fPendingProcessLock);
  result := fPendingProcessFlag;
  LeaveCriticalSection(fPendingProcessLock);
end;

procedure TSynBackgroundThreadAbstract.SetPendingProcess(State: TSynBackgroundThreadProcessStep);
begin
  EnterCriticalSection(fPendingProcessLock);
  fPendingProcessFlag := State;
  LeaveCriticalSection(fPendingProcessLock);
end;

procedure TSynBackgroundThreadAbstract.Execute;
begin
  if fThreadName='' then
    SetCurrentThreadName('%(%)',[self,pointer(self)]) else
    SetCurrentThreadName('%',[fThreadName]);
  if Assigned(fOnBeforeExecute) then
    fOnBeforeExecute(self);
  try
    while not Terminated do
      case FixedWaitFor(fProcessEvent,INFINITE) of
        wrSignaled:
          case GetPendingProcess of
          flagDestroying: begin
            fCallerEvent.SetEvent;
            break;
          end;
          flagStarted:
          try
            fBackgroundException := nil;
            try
              if Assigned(fOnBeforeProcess) then
                fOnBeforeProcess(self);
              try
                Process;
              finally
                if Assigned(fOnAfterProcess) then
                  fOnAfterProcess(self);
              end;
            except
              {$ifdef DELPHI5OROLDER}
              on E: Exception do
                fBackgroundException := ESynException.CreateUTF8(
                  'Redirected %: "%"',[E,E.Message]);
              {$else}
              fBackgroundException := AcquireExceptionObject;
              {$endif}
            end;
          finally
            SetPendingProcess(flagFinished);
            fCallerEvent.SetEvent;
          end;
         end;
      end;
  finally
    if Assigned(fOnAfterExecute) then
      fOnAfterExecute(self);
  end;
end;

function TSynBackgroundThreadAbstract.RunAndWait(OpaqueParam: pointer): boolean;
var start: Int64;
    ThreadID: TThreadID;
    E: Exception;
    IsIdle: boolean;
function OnIdleProcessNotify: integer;
begin
  result := GetTickCount64-start;
  if result<0 then
    result := MaxInt; // should happen only under XP -> ignore
  if Assigned(fOnIdle) then
    fOnIdle(self,result) ;
end;
begin
  result := false;
  ThreadID := GetCurrentThreadId;
  if (self=nil) or (ThreadID=fCallerThreadID) then
    // avoid endless loop when waiting in same thread (e.g. UI + OnIdle)
    exit;
  // 1. wait for any previous request to be finished (should not happen often)
  if Assigned(fOnIdle) then
    fOnIdle(self,0); // notify started
  start := GetTickCount64;
  repeat
    EnterCriticalSection(fPendingProcessLock);
    try
      if fPendingProcessFlag=flagDestroying then
        exit;
      IsIdle := fPendingProcessFlag=flagIdle;
      if IsIdle then
        fPendingProcessFlag := flagStarted; // atomic set "started" flag
    finally
      LeaveCriticalSection(fPendingProcessLock);
    end;
    if IsIdle then
      break;
    case OnIdleProcessNotify of // Windows.GetTickCount64 res is 10-16 ms
    0..20:    SleepHiRes(0);
    21..100:  SleepHiRes(1);
    101..900: SleepHiRes(5);
    else      SleepHiRes(50);
    end;
  until false;
  // 2. process execution in the background thread
  fBackgroundException := nil;
  fCallerThreadID := ThreadID;
  fParam := OpaqueParam;
  try
    fProcessEvent.SetEvent; // notify background thread for Call pending process
    {$ifdef MSWINDOWS} // do process the OnIdle only if UI
    if Assigned(fOnIdle) then begin
      while FixedWaitFor(fCallerEvent,100)<>wrSignaled do
        OnIdleProcessNotify;
    end else
    {$endif}
      FixedWaitForever(fCallerEvent);
    assert(fPendingProcessFlag=flagFinished);
    if fBackgroundException<>nil then begin
      E := fBackgroundException;
      fBackgroundException := nil;
      raise E; // raise background exception in the calling scope
    end;
    result := true;
  finally
    fParam := nil;
    fCallerThreadID := 0;
    FreeAndNil(fBackgroundException);
    SetPendingProcess(flagIdle);
    if Assigned(fOnIdle) then
      fOnIdle(self,-1); // notify finished
  end;
end;

function TSynBackgroundThreadAbstract.GetOnIdleBackgroundThreadActive: boolean;
begin
  result := (self<>nil) and Assigned(fOnIdle) and (GetPendingProcess<>flagIdle);
end;


{ TSynBackgroundThreadEvent }

constructor TSynBackgroundThreadEvent.Create(aOnProcess: TOnProcessSynBackgroundThread;
  aOnIdle: TOnIdleSynBackgroundThread; const aThreadName: RawUTF8);
begin
  inherited Create(aOnIdle,aThreadName);
  fOnProcess := aOnProcess;
end;

procedure TSynBackgroundThreadEvent.Process;
begin
  if not Assigned(fOnProcess) then
    raise ESynException.CreateUTF8('Invalid %.RunAndWait() call',[self]);
  fOnProcess(self,fParam);
end;


{ TSynBackgroundThreadMethod }

procedure TSynBackgroundThreadMethod.Process;
var Method: ^TThreadMethod;
begin
  if fParam=nil then
    raise ESynException.CreateUTF8('Invalid %.RunAndWait() call',[self]);
  Method := fParam;
  Method^();
end;

procedure TSynBackgroundThreadMethod.RunAndWait(Method: TThreadMethod);
var Met: TMethod absolute Method;
begin
  inherited RunAndWait(@Met);
end;


{ TSynBackgroundThreadProcedure }

constructor TSynBackgroundThreadProcedure.Create(aOnProcess: TOnProcessSynBackgroundThreadProc;
  aOnIdle: TOnIdleSynBackgroundThread; const aThreadName: RawUTF8);
begin
  inherited Create(aOnIdle,aThreadName);
  fOnProcess := aOnProcess;
end;

procedure TSynBackgroundThreadProcedure.Process;
begin
  if not Assigned(fOnProcess) then
    raise ESynException.CreateUTF8('Invalid %.RunAndWait() call',[self]);
  fOnProcess(fParam);
end;


{ MultiEvent* functions }

function MultiEventFind(var EventList; const Event: TMethod): integer;
var Events: TMethodDynArray absolute EventList;
begin
  if Event.Code<>nil then
    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;
  if Event.Code=nil then
    exit; // callback not assigned
  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);
var Events: TMethodDynArray absolute EventList;
    max,i: integer;
begin
  if Event.Code=nil then
    exit; // callback not assigned
  i := MultiEventFind(EventList,Event);
  if i>=0 then begin
    max := length(Events)-1;
    move(Events[i+1],Events[i],(max-i)*sizeof(Events[i]));
    SetLength(Events,max);
    exit;
  end;
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;
  GlobalCriticalSectionInitialized: boolean;

procedure GlobalLock;
begin
  if not GlobalCriticalSectionInitialized then begin
    InitializeCriticalSection(GlobalCriticalSection);
    GlobalCriticalSectionInitialized := true;
  end;
  EnterCriticalSection(GlobalCriticalSection);
end;

procedure GlobalUnLock;
begin
  if GlobalCriticalSectionInitialized then
    LeaveCriticalSection(GlobalCriticalSection);
end;

procedure InitSynCommonsConversionTables;
var i,n: integer;
    v: byte;
    crc: cardinal;
{$ifdef NOTPUREPASCALNORCPU64DELPHI}
  regs: TRegisters;
{$endif}
{$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}
begin
  JSON_CONTENT_TYPE_VAR := JSON_CONTENT_TYPE;
  JSON_CONTENT_TYPE_HEADER_VAR := JSON_CONTENT_TYPE_HEADER;
  {$ifdef FPC}
  {$ifdef ISFPC27}
  DefaultSystemCodepage := CODEPAGE_US;
  {$endif}
  {$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}
{$endif}
  for i := 0 to 255 do
    NormToUpperAnsi7Byte[i] := i;
  for i := ord('a') to ord('z') do
    dec(NormToUpperAnsi7Byte[i],32);
{$ifdef OWNNORMTOUPPER}
  // initialize custom NormToUpper[] and NormToLower[] arrays
  move(NormToUpperAnsi7,NormToUpper,138);
  move(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
  fillchar(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;
  // initialize our internaly used TSynAnsiConvert engines
  TSynAnsiConvert.Engine(0);
  // initialize tables for crc32cfast()
  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,byte(crc)];
      crc32ctab[n,i] := crc;
    end;
  end;
  {$ifdef NOTPUREPASCALNORCPU64DELPHI}
  fillchar(regs,sizeof(regs),0);
  GetCPUID(1,regs);
  PIntegerArray(@CpuFeatures)^[0] := regs.edx;
  PIntegerArray(@CpuFeatures)^[1] := regs.ecx;
  if cfSSE42 in CpuFeatures then
    crc32c := @crc32csse42 else
  {$endif}
    crc32c := @crc32cfast;
  DefaultHasher := crc32c;
end;


initialization
  // initialization of global variables
  GarbageCollectorFreeAndNilList := TList.Create;
  GarbageCollectorFreeAndNil(GarbageCollector,TObjectList.Create);
  {$ifndef FPC}
  {$ifndef CPUARM}
  {$ifndef USEPACKAGES}
  InitRedirectCode;
  {$endif USEPACKAGES}
  {$endif CPUARM}
  {$endif FPC}
  InitSynCommonsConversionTables;
  {$ifdef MSWINDOWS}
  RetrieveSystemInfo;
  {$endif MSWINDOWS}
  SetExecutableVersion(0,0,0);
  // some type definition assertions
  Assert(SizeOf(TSynTableFieldType)=1); // as expected by TSynTableFieldProperties
  Assert(SizeOf(TSynTableFieldOptions)=1);
  {$ifndef NOVARIANTS}
  Assert(SizeOf(TSynTableData)=sizeof(TVarData));
  Assert(SizeOf(TDocVariantData)=sizeof(TVarData));
  {$endif NOVARIANTS}
  {$warnings OFF}
  Assert((MAX_SQLFIELDS>=64)and(MAX_SQLFIELDS<=256));
  {$warnings ON}

finalization
  GarbageCollectorFree;
  if GlobalCriticalSectionInitialized then
    DeleteCriticalSection(GlobalCriticalSection);
end.
