St: TStream;
    tmp: TIntegerDynArray;
    ok: boolean;
begin
  result := false;
  SetLength(Deleted,Random(100)+10);
  fillchar(Deleted[0],length(Deleted)*4,0);
  start('Deleting '+IntToStr(length(Deleted))+' elements');
  for i := 0 to high(Deleted) do
  repeat
    repeat
      id := Random(n)+1;
    until (T.IDToIndex(id)>=0) and
      (IntegerScanIndex(pointer(Deleted),length(Deleted),id)<0); // no dup
    Deleted[i] := id;
................................................................................
    for i := 1 to n do
      if T.Get(i,Data) and not TestString(i,Data) then
        exit else
      if withString then
      if TS.Get(Int32ToUTF8(i),Data) and not TestString(i,Data) then
        exit;
  nu := Random(100)+10;
  start('Updating '+IntToStr(nu)+' elements');
  for i := 0 to nu-1 do
  repeat
    repeat
      id := Random(n)+1;
    until (T.IDToIndex(id)>=0) and
      (FastFindIntegerSorted(pointer(Updated),UpdatedCount-1,id)<0); // no dup
    AddSortedInteger(Updated,UpdatedCount,id);
................................................................................
//  RandSeed := 1000;
  start('');
  Finalize(By8);
  n := Random(50)*50+1500;
  UpdatedCount := 0;
  FN := ChangeFileExt(paramstr(0),'.syn');
  DeleteFile(FN);
  start('Creating a TSynBigTable with '+IntToStr(n)+' elements');
  T := TSynBigTable.Create(FN);
  if true then
  try
    for i := 1 to n do
      if T.Add(TTestBigTable.CreateString(i))<>i then
        exit else
      if T.CurrentInMemoryDataSize>10 shl 20 then // write on disk every 10 MB
................................................................................
  start('');
  dec(n,1000);
  FN := FN+'2';
  UpdatedCount := 0;
  DeleteFile(FN);
  TS := TSynBigTableString.Create(FN);
  try
    start('Creating a GUID-indexed TSynBigTableString with '+IntToStr(Length(FileN))+' * 4MB elements');
    for i := 0 to high(FileN) do
      repeat // avoid duplicates (Add=0 if FileN[i] was already there)
        guid.D1 := Random(maxInt);
        guid.D2 := Random(65535);
        guid.D3 := Random(65535);
        Int64(guid.D4) := Int64(Random(maxInt))*Random(maxInt);
        FileN[i] := RawUTF8(GuidToString(guid));
................................................................................
    if not TS.Get(FileN[id],data) or not TestString(777,Data) then
      exit;
    st := stats(T);
    start('Clear');
    TS.Clear;
    UpdatedCount := 0;
    start(st+#13#10#10'Creating a string-indexed TSynBigTableString with '+
      IntToStr(n)+' elements');
    for i := 1 to n do
      if TS.Add(TTestBigTable.CreateString(i),Int32ToUTF8(i))<>i then
        exit else
      if TS.CurrentInMemoryDataSize>10 shl 20 then // write on disk every 10 MB
        TS.UpdateToFile;
    if TS.Count<>n then
      exit;
................................................................................
    WriteBuffer.WriteVarUInt32Array(fDeleted,fDeletedCount,wkSorted);
    WriteBuffer.WriteVarUInt32Array(fAliasSource,fAliasCount,wkSorted);
    WriteBuffer.WriteVarUInt32Array(fAliasReal,fAliasCount,wkVarUInt32);
    UseOffset64 := pointer(fOffset64)<>nil;
    WriteBuffer.Write(@UseOffset64,1);
    if UseOffset64 then
      WriteBuffer.WriteVarUInt64DynArray(fOffset64,fCount,true) else
      WriteBuffer.WriteVarUInt32Array(fOffset32,fCount,wkOffset);
    Offs := WriteBuffer.TotalWritten-Offs+8;
    //assert(Offs<maxInt);
    WriteBuffer.Write(@Offs,4);
    WriteBuffer.Write(@magic,4);
    WriteBuffer.Flush;
    SetEndOfFile(fFile); // always force truncate at end of header
    if forceFlushOnDisk then

    St: TStream;
    tmp: TIntegerDynArray;
    ok: boolean;
begin
  result := false;
  SetLength(Deleted,Random(100)+10);
  fillchar(Deleted[0],length(Deleted)*4,0);
  start('Deleting '+IntToString(length(Deleted))+' elements');
  for i := 0 to high(Deleted) do
  repeat
    repeat
      id := Random(n)+1;
    until (T.IDToIndex(id)>=0) and
      (IntegerScanIndex(pointer(Deleted),length(Deleted),id)<0); // no dup
    Deleted[i] := id;
................................................................................
    for i := 1 to n do
      if T.Get(i,Data) and not TestString(i,Data) then
        exit else
      if withString then
      if TS.Get(Int32ToUTF8(i),Data) and not TestString(i,Data) then
        exit;
  nu := Random(100)+10;
  start('Updating '+IntToString(nu)+' elements');
  for i := 0 to nu-1 do
  repeat
    repeat
      id := Random(n)+1;
    until (T.IDToIndex(id)>=0) and
      (FastFindIntegerSorted(pointer(Updated),UpdatedCount-1,id)<0); // no dup
    AddSortedInteger(Updated,UpdatedCount,id);
................................................................................
//  RandSeed := 1000;
  start('');
  Finalize(By8);
  n := Random(50)*50+1500;
  UpdatedCount := 0;
  FN := ChangeFileExt(paramstr(0),'.syn');
  DeleteFile(FN);
  start('Creating a TSynBigTable with '+IntToString(n)+' elements');
  T := TSynBigTable.Create(FN);
  if true then
  try
    for i := 1 to n do
      if T.Add(TTestBigTable.CreateString(i))<>i then
        exit else
      if T.CurrentInMemoryDataSize>10 shl 20 then // write on disk every 10 MB
................................................................................
  start('');
  dec(n,1000);
  FN := FN+'2';
  UpdatedCount := 0;
  DeleteFile(FN);
  TS := TSynBigTableString.Create(FN);
  try
    start('Creating a GUID-indexed TSynBigTableString with '+IntToString(Length(FileN))+' * 4MB elements');
    for i := 0 to high(FileN) do
      repeat // avoid duplicates (Add=0 if FileN[i] was already there)
        guid.D1 := Random(maxInt);
        guid.D2 := Random(65535);
        guid.D3 := Random(65535);
        Int64(guid.D4) := Int64(Random(maxInt))*Random(maxInt);
        FileN[i] := RawUTF8(GuidToString(guid));
................................................................................
    if not TS.Get(FileN[id],data) or not TestString(777,Data) then
      exit;
    st := stats(T);
    start('Clear');
    TS.Clear;
    UpdatedCount := 0;
    start(st+#13#10#10'Creating a string-indexed TSynBigTableString with '+
      IntToString(n)+' elements');
    for i := 1 to n do
      if TS.Add(TTestBigTable.CreateString(i),Int32ToUTF8(i))<>i then
        exit else
      if TS.CurrentInMemoryDataSize>10 shl 20 then // write on disk every 10 MB
        TS.UpdateToFile;
    if TS.Count<>n then
      exit;
................................................................................
    WriteBuffer.WriteVarUInt32Array(fDeleted,fDeletedCount,wkSorted);
    WriteBuffer.WriteVarUInt32Array(fAliasSource,fAliasCount,wkSorted);
    WriteBuffer.WriteVarUInt32Array(fAliasReal,fAliasCount,wkVarUInt32);
    UseOffset64 := pointer(fOffset64)<>nil;
    WriteBuffer.Write(@UseOffset64,1);
    if UseOffset64 then
      WriteBuffer.WriteVarUInt64DynArray(fOffset64,fCount,true) else
      WriteBuffer.WriteVarUInt32Array(fOffset32,fCount,wkOffsetU);
    Offs := WriteBuffer.TotalWritten-Offs+8;
    //assert(Offs<maxInt);
    WriteBuffer.Write(@Offs,4);
    WriteBuffer.Write(@magic,4);
    WriteBuffer.Flush;
    SetEndOfFile(fFile); // always force truncate at end of header
    if forceFlushOnDisk then

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




  - great performance improvement in TSynTableFieldProperties for update process
  - now TTextWriter can have a custom internal buffer size (default 1024 bytes)
  - 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

}
................................................................................
function UTF8ToWideString(const Text: RawUTF8): WideString;

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

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





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

/// fast Format() function replacement, optimized for RawUTF8
// - only supported token is %, which works only for integer and string type of
................................................................................

{$ifndef PURE_PASCAL}
{$ifndef ISDELPHI2007ANDUP}
/// faster implementation of Move() for Delphi versions with no FastCode inside
procedure Move(const Source; var Dest; Count: Integer);
{$endif}
{$endif}










{$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()
................................................................................
    // - 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 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
................................................................................
  // - 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 1 between two values (therefore is very optimized
  // to store an array of IDs)
  // - wkOffset will write the difference between two successive values, handling
  // constant difference in an optimized manner
  TFileBufferWriterKind = (wkUInt32, wkVarUInt32, wkVarInt32, wkSorted, wkOffset);


  PFileBufferWriter = ^TFileBufferWriter;

  /// this structure 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
  // - is defined either as an object either as a record, due to a bug
................................................................................
    // used by ReadChunk() method
    fBufTemp: RawByteString;
    /// get Isize + buffer from current memory map or fBufTemp into (P,PEnd)
    procedure ReadChunk(var P, PEnd: PByte);
  public
    /// initialize the buffer, and specify a file to use for reading
    procedure Open(aFile: THandle);



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




/// 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 encoded text
................................................................................
function GetDelphiCompilerVersion: RawUTF8;



{ ************ Logging classes and functions }

type












































































  /// the available logging events, as handled by TSynLog
  // - sllError will log errors
  // - sllInfo will log general information events
  // - sllDebug will log detailed debugging information
  // - 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,
................................................................................
      Instance: TObject=nil); overload;
    /// call this method to add some information to the log at a specified level
    // - if Instance is set and Text is not '', it will log the corresponding
    // class name and address (to be used e.g. if you didn't call TSynLog.Enter()
    // method first)
    // - if Instance is set and Text is '', will behave the same as
    // Log(Level,Instance), i.e. write the Instance as JSON content
    procedure Log(Level: TSynLogInfo; const Text: RawUTF8='';
      Instance: TObject=nil); overload;
    /// call this method to add the content of an object to the log at a
    // specified level
    // - TSynLog will write the class and hexa address - TSQLLog will write the
    // object JSON content
    procedure Log(Level: TSynLogInfo; Instance: TObject); overload;
    /// call this method to add the content of most low-level types to the log
    // at a specified level
    // - TSynLog will handle enumerations and dynamic array; TSQLLog will be
    // able to write TObject/TSQLRecord and sets content as JSON
    procedure Log(Level: TSynLogInfo; aName: PWinAnsiChar;
      aTypeInfo: pointer; var aValue); overload;




    /// retrieve the associated logging instance
    function Instance: TSynLog;
  end;

  {{ regroup several logs under an unique family name
   - you should usualy use one family per application or per architectural
     module: e.g. a server application may want to log in separate files the
................................................................................
    fIdent: integer;
    fDestinationPath: TFileName;
    fBufferSize: integer;
    fHRTimeStamp: boolean;
    fWithUnitName: boolean;
    fAutoFlush: cardinal;
    fHandleExceptions: boolean;


    function CreateSynLog: TSynLog;
    procedure SetAutoFlush(TimeOut: cardinal);
    procedure SetLevel(const aLevel: TSynLogInfos);
  public
    /// intialize for a TSynLog class family
    // - add it in the global SynLogFileFamily[] list
    constructor Create(aSynLog: TSynLogClass);
    /// release associated memory
    destructor Destroy; override;
    /// retrieve the corresponding log file of this thread and family
    // - creates the TSynLog if not already existing for this current thread
    function SynLog: TSynLog;



  published
    /// the associated TSynLog class
    property SynLogClass: TSynLogClass read fSynLogClass;
    /// index in global SynLogFileFamily[] and threadvar SynLogFileIndex[] lists
    property Ident: integer read fIdent;
    /// the current level of logging information for this family
    property Level: TSynLogInfos read fLevel write SetLevel;
................................................................................
    // disk, whatever the current content size is
    // - by default, the log file will be written for every 4 KB of log - this
    // will ensure that the main application won't be slow down by logging
    // - in order not to loose any log, a background thread can be created
    // and will be responsible of flushing all pending log content every
    // period of time (e.g. every 10 seconds)
    property AutoFlushTimeOut: cardinal read fAutoFlush write SetAutoFlush;




  end;
  
  /// used to store the identification of one recursivity level
  TSynLogCurrentIdent = packed record
    Instance: TObject;
    ClassType: TClass;
    Method: PUTF8Char;

  end;
  PSynLogCurrentIdent = ^TSynLogCurrentIdent;
  /// used to store the identification of all recursivity levels
  TSynLogCurrentIdents = array[0..maxInt div sizeof(TSynLogCurrentIdent)-1] of TSynLogCurrentIdent;
  PSynLogCurrentIdents = ^TSynLogCurrentIdents;

  /// a per-family and/or per-thread log file content
  // - you should create a sub class per kind of log file
  // ! TSynLogDB = class(TSynLog);
  // - the TSynLog instance won't be allocated in heap, but will share a
  // per-thread (if Family.PerThreadLog=TRUE) or global private log file instance
  // - was very optimized for speed, if no logging is written, and even during
  // log write (using an internal TTextWriter)


  TSynLog = class(TObject, ISynLog)
  protected
    fWriter: TTextWriter;
    fFamily: TSynLogFamily;
    fWriterStream: TStream;
    fHeaderWritten: boolean;
    fLockCS: PRTLCriticalSection;
    fStartTimeStamp: Int64;
    fFileName: TFileName;
    /// set by Enter() method
    fRecursionCount: integer;
    fRecursionMax: integer;
    fRecursion: PSynLogCurrentIdents;

    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    class function FamilyCreate: TSynLogFamily;
    procedure DoEnterLeave(aLevel: TSynLogInfo);
    procedure CreateLogWriter; virtual;
    procedure LogInternal(Level: TSynLogInfo; TextFmt: PWinAnsiChar;
................................................................................
     - if you just need to access the log inside the method block, you may
     not need any ISynLog interface:
     ! procedure TMyDB.SQLFlush;
     ! begin
     !   TSynLogDB.Enter(self,'SQLFlush');
     !   // do some stuff
     ! end;











     - Enter() will write the class name (and the unit name for classes with
     published properties, if TSynLogFamily.WithUnitName is true) for both
     enter (+) and leave (-) events:
      $ 20110325 19325801  +    MyDBUnit.TMyDB(004E11F4).SQLExecute
      $ 20110325 19325801 info   SQL=SELECT * FROM Table;
      $ 20110325 19325801  -    MyDBUnit.TMyDB(004E11F4).SQLExecute }
    class function Enter(aInstance: TObject; aMethodName: PUTF8Char): ISynLog; overload;
    {{ to be called and assigned to a ISynLog interface at the beginning
     of a method
     - this is the main method to be called within a class method:
     ! class function TMyDB.SQLValidate(const SQL: RawUTF8): boolean;
     ! var ILog: ISynLog;
     ! begin
     !   ILog := TSynLogDB.Enter(self,'SQLValidate');
................................................................................
     - if you just need to access the log inside the method block, you may
     not need any ISynLog interface:
     ! class procedure TMyDB.SQLFlush;
     ! begin
     !   TSynLogDB.Enter(self,'SQLFlush');
     !   // do some stuff
     ! end;











     - Enter() will write the class name (and the unit name for classes with
     published properties, if TSynLogFamily.WithUnitName is true) for both
     enter (+) and leave (-) events:
      $ 20110325 19325801  +    MyDBUnit.TMyDB.SQLValidate
      $ 20110325 19325801 info   SQL=SELECT * FROM Table returned 1;
      $ 20110325 19325801  -    MyDBUnit.TMyDB.SQLValidate }
    class function Enter(aClassType: TClass; aMethodName: PUTF8Char): ISynLog; overload;
    /// retrieve the current instance of this TSynLog class
    // - to be used for direct logging, without any Enter/Leave:
    // ! TSynLogDB.Add.Log(llError,'The % statement didn't work',[SQL]);
    // - is just a wrapper around Family.SynLog - the same code will work:
    // ! TSynLogDB.Family.SynLog.Log(llError,'The % statement didn't work',[SQL]);
    class function Add: TSynLog;
      {$ifdef HASINLINE}inline;{$endif}
................................................................................
    // class name and address (to be used e.g. if you didn't call TSynLog.Enter()
    // method first) - for instance
    // ! TSQLLog.Add.Log(sllDebug,'GarbageCollector',GarbageCollector);
    // will append this line to the log:
    // $ 0000000000002DB9 debug TObjectList(00425E68) GarbageCollector
    // - if Instance is set and Text is '', will behave the same as
    // Log(Level,Instance), i.e. write the Instance as JSON content
    procedure Log(Level: TSynLogInfo; const Text: RawUTF8='';
      aInstance: TObject=nil); overload;
    /// call this method to add the content of an object to the log at a
    // specified level
    // - this default implementation will just write the class name and its hexa
    // pointer value, and handle TList, TCollections and TStrings - for instance:
    // ! TSynLog.Add.Log(sllDebug,GarbageCollector);
    // will append this line to the log:
................................................................................
    /// call this method to add the content of most low-level types to the log
    // at a specified level
    // - this overriden implementation will write the value content,
    // written as human readable JSON: handle dynamic arrays and enumerations
    // - TSQLLog from SQLite3Commons unit will be able to write
    // TObject/TSQLRecord and sets content as JSON
    procedure Log(Level: TSynLogInfo; aName: PWinAnsiChar;
      aTypeInfo: pointer; var aValue); overload; 




  published
    /// the associated logging family
    property GenericFamily: TSynLogFamily read fFamily;
    /// the associated file name containing the log
    // - this is accurate only with the default implementation of the class:
    // any child may override it with a custom logging mechanism
    property FileName: TFileName read fFileName;
................................................................................
var L2: integer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if L=0 then
    L := StrLen(P);
  if L=0 then
    exit;
  SetLength(result,L); // maximum posible unicode size (if all <#128)
  L2 := UTF8ToWideChar(pointer(result),P,L) shr 1;
  if L2<>L then
    SetLength(result,L2);
end;

function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: integer): UnicodeString;
var i: integer;
begin
  SetLength(result,WinAnsiLen);
  for i := 0 to WinAnsiLen-1 do
    PWordArray(result)[i] := WinAnsiTableA[WinAnsi[i]]; // very fast conversion
end;
{$endif}

{$ifdef UNICODE}
function Ansi7ToString(const Text: RawByteString): string;
var i: integer;
begin
  SetLength(result,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 StringToAnsi7(const Text: string): RawByteString;
var i: integer;
begin
  SetLength(result,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
................................................................................
  SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;
var i, L: integer;
begin
  L := length(S);
  SetLength(result,L*2+1); // +1 for last wide #0
  if GetACP<>1252 then begin
    // low-level MBCS RTL function including last widechar #0
    SetLength(result,MultiByteToWideChar(GetACP, 0, Pointer(s), L, pointer(result), L));
  end else
    // fast WinAnsi conversion
    for i := 0 to L do // includes S[L]=#0 -> last widechar #0
      PWordArray(result)[i] := WinAnsiTable[PByteArray(S)[i]];
................................................................................
// this Pos() is seldom used, it was decided to only define it under
// Delphi 2009/2010/XE (which expect such a RawUTF8 specific overloaded version)

function Pos(const substr, str: RawUTF8): Integer; overload;
begin
  Result := PosEx(substr, str, 1);
end;

























































{$endif UNICODE}

{$ifndef ISDELPHI2007ANDUP}
/// faster implementation of Move() for Delphi versions with no FastCode inside
procedure Move(const Source; var Dest; Count: Integer);
asm // eax=source edx=dest ecx=count
................................................................................
      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 HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean;
var I: Integer;
    B,C: byte;
begin
  result := false; // return false if any invalid char
  if Pointer(ConvertHexToBin)=nil then
................................................................................
var F: THandle;
    Size: integer;
begin
  result := '';
  if FileName='' then
    exit;
  F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if F<>THandle(-1) then begin
{$ifdef LINUX}
    Size := FileSeek(F,0,soFromEnd);
    FileSeek(F,0,soFromBeginning);
{$else}
    Size := GetFileSize(F,nil);
{$endif}
    SetLength(result,Size);
................................................................................
function FileFromString(const Content: RawByteString; const FileName: TFileName;
  FlushOnDisk: boolean=false): boolean;
var F: THandle;
    L: integer;
begin
  result := false;
  F := FileCreate(FileName);
  if F=THandle(-1) 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
................................................................................
    SetString(result,tmp,15);
  end;
end;

function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8;
// we use YYYYMMDDTdate format
begin
  result := '';
  SetLength(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
  result := '';
  SetLength(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): RawUTF8;
// we use Thhmmss format
begin
  result := '';
  SetLength(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);
end;

function DateTimeToIso8601Text(DT: TDateTime): RawUTF8;
................................................................................
{$ifdef MSWINDOWS}
    Now: TSystemTime; {$else}
    D: TDateTime;     {$endif}
begin
  if aFileName='' then
    exit;
  F := FileOpen(aFileName,fmOpenWrite);
  if F=THandle(-1) then begin
    F := FileCreate(aFileName);
    if F=THandle(-1) then
      exit;
  end;
   // append to end of file
  if FileSeek(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 F=THandle(-1) 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,' ');
................................................................................
          BuildYear := SystemTime.wYear;
        end;
      end;
    finally
      Freemem(Pt);
    end;
  end;
  Main := SysUtils.IntToStr(Major) + '.' + SysUtils.IntToStr(Minor);
  Detailed := Main+ '.' + SysUtils.IntToStr(Release) + '.' + SysUtils.IntToStr(Build);
  if BuildDateTime=0 then // get build date from file age
    BuildDateTime := FileAgeToDateTime(FileName);
end;

function TFileVersion.Version32: integer;
begin
  result := Major shl 16+Minor shl 8+Release;
................................................................................
    exit; // avoid GPF if void
  SetCount(result+1);
  P := pointer(PtrUInt(Value^)+PtrUInt(result)*ElemSize);
  if ElemType=nil then
    move(Elem,P^,ElemSize) else
    CopyArray(P,@Elem,ElemType,1);
end;









procedure TDynArray.Insert(Index: Integer; const Elem);
var n: integer;
    P: PByteArray;
begin
  if Value=nil then
    exit; // avoid GPF if void
................................................................................
    result := Hasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-4)^*2);
end;

procedure TDynArrayHashed.Init(aTypeInfo: pointer; var aValue;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil);
var FieldTable: PFieldTable;

begin
  inherited Init(aTypeInfo,aValue,aCountPointer);
  if @aHasher=nil then begin
    if @DefaultHasher=nil then
      DefaultHasher := @kr32;
     fHasher := DefaultHasher;
  end else
................................................................................
    case PByte(ElemType)^ of
      tkLString:
        aHashElement := HashAnsiString;
      tkWString{$ifdef UNICODE}, tkUString{$endif}:
        aHashElement := HashUnicodeString;
      tkRecord: begin
        FieldTable := ElemType;
        inc(PtrUInt(FieldTable),ord(FieldTable^.Name[0]));
        if FieldTable^.Count>0 then
        with FieldTable^.Fields[0] do
          if Offset=0 then
          case TypeInfo^^.Kind of
            tkLString:
              aHashElement := HashAnsiString;
            tkWString{$ifdef UNICODE}, tkUString{$endif}:
              aHashElement := HashUnicodeString;




          end;
      end;
    end;
  fHashElement := aHashElement;
  if @aCompare=nil then begin
    aCompare := SORTFIRSTFIELD[TypeInfoToKnown(aTypeInfo)];
    if @aCompare=nil then
      // will match default HashOne algo, i.e. hash first field of record
      if (ElemType<>nil) and (PByte(ElemType)^=tkRecord) then begin
        FieldTable := ElemType;
        inc(PtrUInt(FieldTable),ord(FieldTable^.Name[0]));
        if FieldTable^.Count=0 then
        case ElemSize of
          1: aCompare := @SortDynArrayByte;
          2: aCompare := @SortDynArrayWord;
          4: aCompare := @SortDynArrayCardinal;
          8: aCompare := @SortDynArrayInt64;
        end else
................................................................................
            8: aCompare := @SortDynArrayInt64;
          end else
          case TypeInfo^^.Kind of
          tkLString:
            aCompare := @SortDynArrayAnsiString;
          tkWString{$ifdef UNICODE}, tkUString{$endif}:
            aCompare := @SortDynArrayUnicodeString;




          end;
      end;
  end;
  fCompare := aCompare;
  ReHash;
end;

................................................................................
      end;
  until false;
  result := -1; // mark not found
end;

function TDynArrayHashed.HashOne(const Elem): cardinal;
var FieldTable: PFieldTable;
label Bin, LStr, WStr;
begin
  if @fHashElement<>nil then
    result := fHashElement(Elem,fHasher) else
  if ElemType=nil then
    goto Bin else
    case PByte(ElemType)^ of
    tkLString:
................................................................................
        result := fHasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-4)^);
    tkWString{$ifdef UNICODE}, tkUString{$endif}:
WStr: if PtrUInt(Elem)=0 then
        result := 0 else
        result := fHasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-4)^*2);
    tkRecord: begin
      FieldTable := ElemType;
      inc(PtrUInt(FieldTable),ord(FieldTable^.Name[0]));
      if FieldTable^.Count=0 then
        // only binary content -> hash full content
Bin:    case ElemSize of 
          1: result := byte(Elem);
          2: result := word(Elem);
          4: result := cardinal(Elem);
          8: result := Int64Rec(Elem).Lo xor Int64Rec(Elem).Hi;
................................................................................
      if Offset<>0 then
        // hash whole starting binary content of record
        result := fHasher(0,@Elem,Offset) else
        // hash first string field of record
        case TypeInfo^^.Kind of
        tkLString: goto LStr;
        tkWString{$ifdef UNICODE}, tkUString{$endif}: goto WStr;




        else result := 0; // unhandled type 
        end;
    end;
    else result := 0;
    end;
  if result=0 then
    result := 1; // never return 0 (indicates a free position in fHashs[])
................................................................................
  fOwner := Owner;
end;

function TSynTestCase.RandomString(CharCount: Integer): RawByteString;
var V: cardinal;
    P: PAnsiChar;
begin
  Result := '';
  SetLength(Result,CharCount);
  P := pointer(Result);
  while CharCount>0 do begin
    if CharCount>5 then begin
      V := Random(maxInt); // fast: one random compute per 5 chars
      P[0] := AnsiChar(32+V and 127); V := V shr 7;
      P[1] := AnsiChar(32+V and 127); V := V shr 7;
      P[2] := AnsiChar(32+V and 127); V := V shr 7;
................................................................................
    Check(Cities[i].Name=''); // ForAddind = not added
    Cities[i] := City;
  end;
  Check(ACities.Count=3);
  Check(City.Name='Iasi');
  Check(ACities.FindHashed(City)>=0);
  for i := 1 to 2000 do begin
    City.Name := IntToStr(i);
    City.Latitude := i*3.14;
    City.Longitude := i*6.13;
    Check(ACities.FindHashedAndUpdate(City,true)=i+2,'multiple ReHash');
    Check(ACities.FindHashed(City)=i+2);
  end;
  ACities.Capacity := CITIES_MAX+3; // make it as fast as possible
  for i := 2001 to CITIES_MAX do begin
    City.Name := IntToStr(i);
    City.Latitude := i*3.14;
    City.Longitude := i*6.13;
    Check(ACities.FindHashedAndUpdate(City,true)=i+2,'use Capacity: no ReHash');
    Check(ACities.FindHashed(City.Name)=i+2);
  end;
  for i := 1 to CITIES_MAX do begin
    N := IntToStr(i);
    j := ACities.FindHashed(N);
    Check(j=i+2,'hashing with string not City.Name');
    Check(Cities[j].Name=N);
    CheckSame(Cities[j].Latitude,i*3.14);
    CheckSame(Cities[j].Longitude,i*6.13);
  end;
end;
................................................................................
    JSON_BASE64_MAGIC_UTF8: RawUTF8;
procedure Fill(var F: TFileVersion; i: integer);
begin
  F.Major := i;
  F.Minor := i+1;
  F.Release := i+2;
  F.Build := i+3;
  F.Main := IntToStr(i+1000);
  F.Detailed := IntToStr(2000-i);
  F.BuildDateTime := 36215.12;
  F.BuildYear := i+2011;
end;
begin
  W := TTextWriter.CreateOwnedStream;
  // validate TIntegerDynArray 
  AIP.Init(TypeInfo(TIntegerDynArray),AI);
................................................................................
  Check(RecordEquals(F,AF[100],TypeInfo(TFileVersion)));
  for i := 0 to 1000 do
    with AF[i] do begin
      Check(Major=i);
      Check(Minor=i+1);
      Check(Release=i+2);
      Check(Build=i+3);
      Check(Main=IntToStr(i+1000));
      Check(Detailed=IntToStr(2000-i));
      CheckSame(BuildDateTime,36215.12);
      Check(BuildYear=i+2011);
    end;
  for i := 0 to 1000 do begin
    Fill(F,i);
    Check(AFP.IndexOf(F)=i);
  end;
................................................................................
{$endif}
  for i := 1 to 10000 do begin
    j := Random(maxInt)-Random(maxInt);
    str(j,a);
    s := RawUTF8(a);
    Check(kr32(0,pointer(s),length(s))=kr32pas(pointer(s),length(s)));
    u := string(a);
    Check(IntToStr(j)=u);
    Check(Int32ToUtf8(j)=s);
    Check(format('%d',[j])=u);
    Check(GetInteger(pointer(s))=j);
    Check(FormatUTF8('%',[j])=s);
    k := Int64(j)*Random(MaxInt);
    str(k,a);
    s := RawUTF8(a);
    u := string(a);
    Check(IntToStr(k)=u);
    Check(Int64ToUtf8(k)=s);
    Check(format('%d',[k])=u);
    Check(FormatUTF8('%',[k])=s);
    err := 1;
    l := GetInt64(pointer(s),err);
    Check((err=0)and(l=k));
    str(j,a);
    Check(IntToStr(j)=string(a));
    Check(format('%d',[j])=string(a));
    Check(format('%.8x',[j])=IntToHex(j,8));
    d := Random*1E-17-Random*1E-9;
    str(d,a);
    s := RawUTF8(a);
    e := GetExtended(Pointer(s),err);
    Check(SameValue(e,d)); // test str()
................................................................................
    Check(T.AddField('double',tftDouble)<>nil);
    Check(T.AddField('varint',tftVarUInt32)<>nil);
    Check(T.AddField('text',tftUTF8,[tfoUnique])<>nil);
    Check(T.AddField('ansi',tftWinAnsi,[])<>nil);
    Check(T.AddField('currency',tftCurrency)<>nil);
    Test;
    FN := ChangeFileExt(paramstr(0),'.syntable');

    f := FileCreate(FN); // manual storage of TSynTable header
    W.AssignToFile(f);
    T.SaveTo(W);
    W.Flush;
    FileClose(f);
    T.Free;
    f := FileOpen(FN,fmOpenRead);
................................................................................
  WriteVarUInt32(ValuesCount);
  if ValuesCount=0 then
    exit;
  PI := pointer(Values);
  PByteArray(fBuf)^[fPos] := ord(DataLayout);
  inc(fPos);
  inc(fTotalWritten);
  if DataLayout=wkOffset 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));
................................................................................
      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,wkOffset: 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);
................................................................................
          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;
        wkOffset:
          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;
        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));
................................................................................
  end;
end;

procedure TFileBufferReader.ErrorInvalidContent;
begin
  raise Exception.Create('TFileBufferReader: invalid content');
end;










procedure TFileBufferReader.Open(aFile: THandle);
begin
  fCurrentPos := 0;
  fBuf := nil;
  fMap := 0;
  fFile := aFile;
................................................................................
  end;
end;

function TFileBufferReader.Read(Data: pointer; DataLen: integer): integer;
var len: integer;
begin
  if DataLen>0 then
    if fMap<>0 then begin
      // file up to 2 GB: use fast memory map
      len := fBufSize-fCurrentPos;
      if len>DataLen then
        len := DataLen;
      move(fBuf[fCurrentPos],Data^,len);
      inc(fCurrentPos,len);
      result := len;
................................................................................
    ErrorInvalidContent;
  PEnd := pointer(PtrUInt(P)+PtrUInt(len));
end;

function TFileBufferReader.ReadPointer(DataLen: PtrUInt;
  var aTempData: RawByteString): pointer;
begin
  if fMap=0 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(fFile,pointer(aTempData)^,DataLen))<>DataLen then
      result := nil else // invalid content
................................................................................

{$ifndef LVCL}
function TFileBufferReader.ReadStream: TCustomMemoryStream;
var DataLen: PtrUInt;
begin
  DataLen := ReadVarUInt32;
  if DataLen<>0 then
    if fMap=0 then begin
      // use temporary TMemoryStream only if not in memory map buffer
      result := TMemoryStream.Create;
      result.Size := DataLen;
      if PtrUInt(FileRead(fFile,result.Memory^,DataLen))<>DataLen then
        FreeAndNil(result); // invalid content
    end else
    if DataLen+fCurrentPos>fBufSize then
................................................................................
    // DataLen=0 -> invalid content
    result := nil;
end;
{$endif}

function TFileBufferReader.ReadByte: PtrUInt;
begin
  if fMap<>0 then
    if fCurrentPos>=fBufSize then
      // invalid request
      result := 0 else begin
      // read one byte from current memory map
      result := ord(fBuf[fCurrentPos]);
      inc(fCurrentPos);
    end else begin
      // read from file if >= 2 GB (slow, but works)
      result := 0;
      if FileRead(fFile,result,1)<>1 then
        result := 0;
    end;
end;


















function TFileBufferReader.ReadVarUInt32: PtrUInt;
var c, n: PtrUInt;
begin
  result := ReadByte;
  if result>$7f then begin
    n := 0;
................................................................................
  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);
  DataLayout := TFileBufferWriterKind(ReadByte);
  if DataLayout=wkOffset then begin
    PI^ := ReadVarUInt32;
    dec(count);
    diff := ReadVarUInt32;
    if diff<>0 then begin
      for i := 0 to count-1 do
        PIA^[i+1] := PIA^[i]+diff;
      exit;
................................................................................
          inc(PI);
        end;
      wkSorted: begin
        n := CleverReadInteger(pointer(P),pointer(PEnd),PI);
        dec(count,n);
        inc(PtrUInt(PI),n*4);
      end;
      wkOffset: 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;
      else
................................................................................
  assert((count=0)and(PI=@Values[result]));
end;

function TFileBufferReader.ReadRawUTF8List(List: TRawUTF8List): boolean;
var i: integer;
    StoreObjectsAsVarUInt32: Boolean;
begin
  if (fMap<>0) 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
................................................................................
end;

{$ifndef CPU64}
function TFileBufferReader.Seek(Offset: Int64): boolean;
begin
  if (Offset<0) or (Offset>fFileSize) then
    result := False else
  if fMap=0 then
    result := FileSeek64(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=0 then Result := FileSeek(fFile,Offset,0)=Offset else
  if (fMap<>0) and (PtrUInt(Offset)<PPtrUInt(@fFileSize)^) then begin
    fCurrentPos := Offset;
    result := true;
  end else
    result := false;
end;


................................................................................
    inc(P,Len);
    inc(TotalLen,Len);
    Lens[F] := Len;
  end else
    inc(TotalLen,fDefaultFieldLength);
  // create new record content
  P := RecordBuffer;
  Setlength(Result,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);
................................................................................
    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;
    SetLength(result,ValueLen+Head);
    Move(tmp,PByteArray(Result)[0],Head);
    Move(Value^,PByteArray(Result)[Head],ValueLen);
  end;
end;

function TSynTableFieldProperties.SBFFloat(const Value: Double): TSBFString;
begin
................................................................................
function TSynTableData.ValidateSBFValue(RecordIndex: integer): string;
begin
  CheckVTableInitialized;
  Result := VTable.Validate(Pointer(VValue),RecordIndex);
end;





















































































































































































































































































































































































































































































{ TSynLogFamily }







type
  TExceptProc = procedure(Obj: TObject; Addr: Pointer);

var
  /// internal list of registered TSynLogFamily
  // - up to MAX_SYNLOGFAMILY+1 families may be defined
  SynLogFamily: TObjectList = nil;




threadvar
  CurrentHandleExceptionSynLog: TSynLog;

var
  SynLogExceptionEnabled: boolean = false;















































type
  PExceptionRecord = ^TExceptionRecord;
  TExceptionRecord = packed record
    ExceptionCode        : LongWord;
    ExceptionFlags       : LongWord;
    OuterException       : PExceptionRecord;
    ExceptionAddress     : Pointer;
................................................................................
  PExceptionInfo = ^TExceptionInfo;
  TExceptionInfo = packed record
    ExceptionRecord: PExceptionRecord;
    ContextRecord: pointer;
  end;
  GetExceptionClass = function(P: PExceptionRecord): ExceptClass;

function GetHandleExceptionSynLog: TSynLog;
var Index: ^TSynLogFileIndex;
    i: integer;
    ndx, n: cardinal;
begin
  result := CurrentHandleExceptionSynLog;
  if result<>nil then
    exit;
  Index := @SynLogFileIndex;
  if SynLogFile<>nil then begin
    n := SynLogFile.Count;
    for i := 0 to high(Index^) do begin
      ndx := Index^[i]-1;
      if ndx<=n then begin
        result := TSynLog(SynLogFile.List^[ndx]);
        if result.fFamily.fHandleExceptions then
          exit;
      end;
    end;
    for i := 0 to n-1 do begin
      result := TSynLog(SynLogFile.List^[i]);
      if result.fFamily.fHandleExceptions then
        exit;
    end;
  end;
  result := nil;
end;

function SynLogVectoredHandler(ExceptionInfo : PExceptionInfo): PtrInt; stdcall;
const
  EXCEPTION_CONTINUE_SEARCH = 0;
var SynLog: TSynLog;
    Level: TSynLogInfo;
    E: ExceptClass;




begin





  // guess if was a Delphi or OS exception
  E := nil;

  Level := sllException;
  if SynLogExceptionEnabled and

     (ExceptionInfo<>nil) and (ExceptionInfo^.ExceptionRecord<>nil) then
    with ExceptionInfo^.ExceptionRecord^ do
      if (ExceptObject<>nil) and ExceptObject.InheritsFrom(Exception) then
        // Delphi exception
        E := PPointer(ExceptObject)^ else begin


        // OS exception -> translate into a Delphi Exception class
        if Assigned(ExceptClsProc) then
          E := GetExceptionClass(ExceptClsProc)(ExceptionInfo^.ExceptionRecord);
        if E=nil then
          E := EExternalException;
        Level := sllExceptionOS;

      end;
  // log corresponding message if necessary





























































  if E<>nil then begin


    SynLog := GetHandleExceptionSynLog;
    if SynLog<>nil then

      case Level of




      sllException:
        if sllException in SynLog.fFamily.Level then
          with ExceptionInfo^.ExceptionRecord^ do
            SynLog.LogInternal(sllException,'% at % ("%")',
              [E,ExceptAddr,ExceptObject.Message],nil);





















      sllExceptionOS:








        if SynLog.fFamily.fHandleExceptions then
          with ExceptionInfo^.ExceptionRecord^ do
            SynLog.LogInternal(sllExceptionOS,'% (%) at %',
              [E,pointer(ExceptionCode),ExceptionAddress],nil);










      end;








  end;
  result := EXCEPTION_CONTINUE_SEARCH;

end;













































procedure TSynLogFamily.SetLevel(const aLevel: TSynLogInfos);
var AddVectoredExceptionHandler: function(FirstHandler: cardinal;
  VectoredHandler: pointer): PtrInt; stdcall;



begin
  fLevel := aLevel;
  fHandleExceptions := (sllExceptionOS in aLevel) or (sllException in aLevel);
  if not SynLogExceptionEnabled and fHandleExceptions then begin
    SynLogExceptionEnabled := true;


    AddVectoredExceptionHandler :=
      GetProcAddress(GetModuleHandle(kernel32),'AddVectoredExceptionHandler');

    if Assigned(AddVectoredExceptionHandler) then
      // available since Windows XP
      AddVectoredExceptionHandler(0,@SynLogVectoredHandler);




  end;
end;

constructor TSynLogFamily.Create(aSynLog: TSynLogClass);
begin
  fSynLogClass := aSynLog;
  if SynLogFamily=nil then begin
    SynLogFamily := TObjectList.Create;
    GarbageCollector.Add(SynLogFamily);
  end;
  fIdent := SynLogFamily.Add(self);
  fDestinationPath := ExtractFilePath(paramstr(0));
  fBufferSize := 4096;


end;

function TSynLogFamily.CreateSynLog: TSynLog;
begin
  result := fSynLogClass.Create(self);
  if fPerThreadLog then begin
    if SynLogFile=nil then begin
................................................................................
  AutoFlushThread: THandle = 0;
  AutoFlushSecondElapsed: cardinal;

procedure AutoFlushProc(P: pointer); stdcall;  // TThread not needed here
var i: integer;
begin
  repeat
    Sleep(1000);
    if SynLogFile=nil then
      continue;
    inc(AutoFlushSecondElapsed);
    for i := 0 to SynLogFile.Count-1 do
    with TSynLog(SynLogFile.List^[i]) do
      if (fFamily.fAutoFlush<>0) and (fWriter<>nil) and
         (AutoFlushSecondElapsed mod fFamily.fAutoFlush=0) then
        if fWriter.B-fWriter.fTempBuf>1 then begin
          if not IsMultiThread and
             not fWriterStream.InheritsFrom(TFileStream) then
            IsMultiThread := true; // only TFileStream is thread-safe
          Flush(false);
        end;
  until false;
end;

procedure TSynLogFamily.SetAutoFlush(TimeOut: cardinal);
var ID: cardinal;
begin
  SynLog.CreateLocker;
  fAutoFlush := TimeOut;
  if AutoFlushThread=0 then begin
    AutoFlushSecondElapsed := 0;
    AutoFlushThread := CreateThread(nil,0,@AutoFlushProc,nil,0,ID);
  end;
end;

destructor TSynLogFamily.Destroy;
begin
  FreeAndNil(fGlobalLog);
  if AutoFlushThread<>0 then begin
    CloseHandle(AutoFlushThread); // release background thread once for all
    AutoFlushThread := 0;
  end;

  inherited;
end;

function TSynLogFamily.SynLog: TSynLog;
var ndx: integer;
begin
  if fPerThreadLog then begin
................................................................................
    ndx := SynLogFileIndex[fIdent]-1;
    if ndx>=0 then
      result := SynLogFile.List^[ndx] else
      result := CreateSynLog;
  end else
    if fGlobalLog<>nil then
      result := fGlobalLog else
      result := CreateSynLog; 
  if fHandleExceptions then
    CurrentHandleExceptionSynLog := result;
end;


{ TSynLog }

................................................................................
  inc(fRecursionCount);
  result := fRecursionCount;
end;

function TSynLog._Release: Integer;
begin
  dec(fRecursionCount);
  if sllLeave in fFamily.Level then






    DoEnterLeave(sllLeave);

  result := fRecursionCount;
end;

constructor TSynLog.Create(aFamily: TSynLogFamily);
begin
  fFamily := aFamily;
end;
................................................................................
begin
  inc(fRecursionMax,256+fRecursionMax shr 3);
  ReallocMem(fRecursion,fRecursionMax*sizeof(fRecursion^[0]));
end;

class function TSynLog.Enter(aClassType: TClass; aMethodName: PUTF8Char): ISynLog;
var aSynLog: TSynLog;

begin





  aSynLog := Family.SynLog;
  with aSynLog do begin
    // recursively store parameters
    if fRecursionCount=fRecursionMax then
      RecursionGrow;
    with fRecursion^[fRecursionCount] do begin
      Instance := nil;
      ClassType := aClassType;
      Method := aMethodName;

    end;
  end;
  // copy to ISynLog interface -> will call TSynLog._AddRef
  result := aSynLog;
end;

class function TSynLog.Enter(aInstance: TObject; aMethodName: PUTF8Char): ISynLog;
var aSynLog: TSynLog;
    aFamily: TSynLogFamily;

begin





  // inlined aSynLog := Family.SynLog
  aFamily := PPointer(PtrInt(Self)+vmtAutoTable)^;
  if aFamily=nil then
    aSynLog := FamilyCreate.SynLog else
    aSynLog := aFamily.SynLog;
  // recursively store parameters
  with aSynLog do begin
................................................................................
      RecursionGrow;
    with fRecursion^[fRecursionCount] do begin
      Instance := aInstance;
      if aInstance=nil then
        ClassType := pointer(aInstance) else
        ClassType := PPointer(aInstance)^;
      Method := aMethodName;

    end;
  end;
  // copy to ISynLog interface -> will call TSynLog._AddRef
  result := aSynLog;
end;

class function TSynLog.FamilyCreate: TSynLogFamily;
................................................................................

procedure TSynLog.Log(Level: TSynLogInfo; aName: PWinAnsiChar;
  aTypeInfo: pointer; var aValue);
begin
  if Level in fFamily.fLevel then
    LogInternal(Level,aName,aTypeInfo,aValue);
end;

















procedure TSynLog.LogFileHeader;
var Freq: Int64;
begin
  QueryPerformanceFrequency(Freq);
  ExeVersionRetrieve;
  with ExeVersion, SystemInfo, OSVersionInfo do
................................................................................
procedure TSynLog.CreateLogWriter;
begin
  if fWriterStream=nil then begin
    ExeVersionRetrieve;
    fFileName := string(ExeVersion.ProgramName)+' '+GetCaptionFromClass(ClassType)+' '+
      TFileName(NowToString(false));
    if fFamily.PerThreadLog then
      fFileName := fFileName+' '+IntToStr(GetCurrentThreadId);
    fFileName := fFamily.fDestinationPath+fFileName+'.log';
    fWriterStream := TFileStream.Create(fFileName,fmCreate)
  end;
  if fWriter=nil then
    fWriter := TTextWriter.Create(fWriterStream,fFamily.BufferSize);
end;

................................................................................
      if Instance<>nil then begin
        fWriter.Add('(');
        fWriter.AddPointer(PtrUInt(Instance));
        fWriter.Add(')');
      end;
      fWriter.Add('.');
    end;

    fWriter.AddNoJSONEscape(Method);

  end;
  fWriter.AddCR;
end;

procedure TSynLog.DoEnterLeave(aLevel: TSynLogInfo);
begin
  LogHeaderLock(aLevel);

    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()
    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 
  - great performance improvement in TSynTableFieldProperties for update process
  - now TTextWriter can have a custom internal buffer size (default 1024 bytes)
  - 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

}
................................................................................
function UTF8ToWideString(const Text: RawUTF8): WideString;

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

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

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

/// fast Format() function replacement, optimized for RawUTF8
// - only supported token is %, which works only for integer and string type of
................................................................................

{$ifndef PURE_PASCAL}
{$ifndef ISDELPHI2007ANDUP}
/// faster implementation of Move() for Delphi versions with no FastCode inside
procedure Move(const Source; var Dest; Count: Integer);
{$endif}
{$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;

{$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()
................................................................................
    // - 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
................................................................................
  // - 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 1 between two values (therefore is very optimized
  // to store an array of IDs)
  // - wkOffsetU and wkOffsetI will write the difference between two successive
  // values, handling constant difference (Unsigned or Integer) in an optimized manner
  TFileBufferWriterKind = (wkUInt32, wkVarUInt32, wkVarInt32, wkSorted,
    wkOffsetU, wkOffsetI);

  PFileBufferWriter = ^TFileBufferWriter;

  /// this structure 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
  // - is defined either as an object either as a record, due to a bug
................................................................................
    // used by ReadChunk() method
    fBufTemp: RawByteString;
    /// get Isize + buffer from current memory map or fBufTemp into (P,PEnd)
    procedure ReadChunk(var P, PEnd: PByte);
  public
    /// initialize the buffer, and specify a file to use for reading
    procedure Open(aFile: THandle);
    /// initialize the buffer from an already existing memory block
    // - may be e.g. a resource
    procedure OpenFrom(aBuffer: pointer; aBufferSize: cardinal);
    /// 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;
................................................................................
    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 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;
................................................................................
// 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;

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

/// 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 encoded text
................................................................................
function GetDelphiCompilerVersion: RawUTF8;



{ ************ Logging classes and functions }

type
  /// a debugger symbol, as decoded by TSynMapFile from a .map file
  TSynMapSymbol = record
    /// symbol internal name
    Name: RawUTF8;
    /// starting offset of this symbol in the executable
    Start: cardinal;
    /// end offset of this symbol in the executable
    Stop: cardinal;
  end;
  PSynMapSymbol = ^TSynMapSymbol;
  /// a dynamic array of symbols, as decoded by TSynMapFile from a .map file
  TSynMapSymbolDynArray = array of TSynMapSymbol;

  /// a debugger unit, as decoded by TSynMapFile from a .map file
  TSynMapUnit = record
    /// Name, Start and Stop of this Unit
    Symbol: TSynMapSymbol;
    /// list of all mapped source code lines of this unit
    Line: TIntegerDynArray;
    /// start code address of each source code lin
    Addr: TIntegerDynArray;
  end;
  /// a dynamic array of units, as decoded by TSynMapFile from a .map file
  TSynMapUnitDynArray = array of TSynMapUnit;

  /// retrieve a .map file content, to be used e.g. with TSynLog to provide
  // additional debugging information
  // - original .map content can be saved as .mab file in a more optimized format
  TSynMapFile = class
  protected
    fMapFile: TFileName;
    fSymbol: TSynMapSymbolDynArray;
    fUnit: TSynMapUnitDynArray;
    fSymbols: TDynArray;
    fUnits: TDynArrayHashed;
    fGetModuleHandle: PtrUInt;
    fHasDebugInfo: boolean;
  public
    /// get the available debugging information
    // - will first search for a .map file in the .exe directory: if found,
    // will be read to retrieve all necessary debugging information - a .mab
    // file will be also created in the same directory (if MabCreate is TRUE)
    // - if .map is not not available, will search for the .mab file in the
    // .exe directory
    // - if no .mab is available, will search for a .mab appended to the exe 
    // - if nothing is available, will log as hexadecimal pointers, without
    // debugging information
    // - if aExeName is not specified, will use the current process executable
    constructor Create(const aExeName: TFileName=''; MabCreate: boolean=true);
    /// save all debugging information in the .mab custom binary format
    // - if no file name is specified, it will be saved as ExeName.mab
    // - this file content can be appended to the executable via SaveToExe method
    // - this function returns the created file name
    function SaveToFile(const aFileName: TFileName=''): TFileName;
    /// append all debugging information to an executable
    // - the executable name must be specified, because it's impossible to
    // write to the executable of a running process
    procedure SaveToExe(const aExeName: TFileName);
    /// add some debugging information according to the specified memory address
    // - will create a global TSynMapFile instance for the current process, if
    // necessary
    // - if no debugging information is available (.map or .mab), will write
    // the address as hexadecimal
    class procedure Log(W: TTextWriter; Addr: PtrUInt);
    /// retrieve a symbol according to an absolute code address
    function FindSymbol(aAddr: cardinal): integer;
    /// retrieve an unit and source line, according to an absolute code address
    function FindUnit(aAddr: cardinal; out LineNumber: integer): integer;
    /// all symbols associated to the executable
    property Symbols: TSynMapSymbolDynArray read fSymbol;
    /// all units, including line numbers, associated to the executable
    property Units: TSynMapUnitDynArray read fUnit;
    /// equals true if a .map or .mab debugging information has been loaded
    property HasDebugInfo: boolean read fHasDebugInfo;
  end;
  
  /// the available logging events, as handled by TSynLog
  // - sllError will log errors
  // - sllInfo will log general information events
  // - sllDebug will log detailed debugging information
  // - 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,
................................................................................
      Instance: TObject=nil); overload;
    /// call this method to add some information to the log at a specified level
    // - if Instance is set and Text is not '', it will log the corresponding
    // class name and address (to be used e.g. if you didn't call TSynLog.Enter()
    // method first)
    // - if Instance is set and Text is '', will behave the same as
    // Log(Level,Instance), i.e. write the Instance as JSON content
    procedure Log(Level: TSynLogInfo; const Text: RawUTF8;
      Instance: TObject=nil); overload;
    /// call this method to add the content of an object to the log at a
    // specified level
    // - TSynLog will write the class and hexa address - TSQLLog will write the
    // object JSON content
    procedure Log(Level: TSynLogInfo; Instance: TObject); overload;
    /// call this method to add the content of most low-level types to the log
    // at a specified level
    // - TSynLog will handle enumerations and dynamic array; TSQLLog will be
    // able to write TObject/TSQLRecord and sets content as JSON
    procedure Log(Level: TSynLogInfo; aName: PWinAnsiChar;
      aTypeInfo: pointer; var aValue); overload;
    /// call this method to add the caller address to the log at the specified level
    // - if the debugging info is available from TSynMapFile, will log the
    // unit name, associated symbol and source code line
    procedure Log(Level: TSynLogInfo); overload;
    /// retrieve the associated logging instance
    function Instance: TSynLog;
  end;

  {{ regroup several logs under an unique family name
   - you should usualy use one family per application or per architectural
     module: e.g. a server application may want to log in separate files the
................................................................................
    fIdent: integer;
    fDestinationPath: TFileName;
    fBufferSize: integer;
    fHRTimeStamp: boolean;
    fWithUnitName: boolean;
    fAutoFlush: cardinal;
    fHandleExceptions: boolean;
    fStackTraceLevel: cardinal;
    fExceptionIgnore: TList;
    function CreateSynLog: TSynLog;
    procedure SetAutoFlush(TimeOut: cardinal);
    procedure SetLevel(const aLevel: TSynLogInfos);
  public
    /// intialize for a TSynLog class family
    // - add it in the global SynLogFileFamily[] list
    constructor Create(aSynLog: TSynLogClass);
    /// release associated memory
    destructor Destroy; override;
    /// retrieve the corresponding log file of this thread and family
    // - creates the TSynLog if not already existing for this current thread
    function SynLog: TSynLog;
    /// you can add some exceptions to be ignored to this list
    // - for instance, EConvertError may be added to the list
    property ExceptionIgnore: TList read fExceptionIgnore;
  published
    /// the associated TSynLog class
    property SynLogClass: TSynLogClass read fSynLogClass;
    /// index in global SynLogFileFamily[] and threadvar SynLogFileIndex[] lists
    property Ident: integer read fIdent;
    /// the current level of logging information for this family
    property Level: TSynLogInfos read fLevel write SetLevel;
................................................................................
    // disk, whatever the current content size is
    // - by default, the log file will be written for every 4 KB of log - this
    // will ensure that the main application won't be slow down by logging
    // - in order not to loose any log, a background thread can be created
    // and will be responsible of flushing all pending log content every
    // period of time (e.g. every 10 seconds)
    property AutoFlushTimeOut: cardinal read fAutoFlush write SetAutoFlush;
    /// the recursive depth of stack trace symbol to write
    // - used only if exceptions are handled
    // - default value is 20 
    property StackTraceLevel: cardinal read fStackTraceLevel write fStackTraceLevel;
  end;

  /// used to store the identification of one recursivity level
  TSynLogCurrentIdent = packed record
    Instance: TObject;
    ClassType: TClass;
    Method: PUTF8Char;
    Caller: PtrUInt;
  end;
  PSynLogCurrentIdent = ^TSynLogCurrentIdent;
  /// used to store the identification of all recursivity levels
  TSynLogCurrentIdents = array[0..maxInt div sizeof(TSynLogCurrentIdent)-1] of TSynLogCurrentIdent;
  PSynLogCurrentIdents = ^TSynLogCurrentIdents;

  /// a per-family and/or per-thread log file content
  // - you should create a sub class per kind of log file
  // ! TSynLogDB = class(TSynLog);
  // - the TSynLog instance won't be allocated in heap, but will share a
  // per-thread (if Family.PerThreadLog=TRUE) or global private log file instance
  // - was very optimized for speed, if no logging is written, and even during
  // log write (using an internal TTextWriter)
  // - can use available debugging information via the TSynMapFile class, for
  // stack trace logging for exceptions, and Enter/Leave labelling
  TSynLog = class(TObject, ISynLog)
  protected
    fWriter: TTextWriter;
    fFamily: TSynLogFamily;
    fWriterStream: TStream;
    fHeaderWritten: boolean;
    fLockCS: PRTLCriticalSection;
    fStartTimeStamp: Int64;
    fFileName: TFileName;
    /// set by Enter() method
    fRecursionCount: integer;
    fRecursionMax: integer;
    fRecursion: PSynLogCurrentIdents;
    fRecursionCaller: PtrUInt;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    class function FamilyCreate: TSynLogFamily;
    procedure DoEnterLeave(aLevel: TSynLogInfo);
    procedure CreateLogWriter; virtual;
    procedure LogInternal(Level: TSynLogInfo; TextFmt: PWinAnsiChar;
................................................................................
     - if you just need to access the log inside the method block, you may
     not need any ISynLog interface:
     ! procedure TMyDB.SQLFlush;
     ! begin
     !   TSynLogDB.Enter(self,'SQLFlush');
     !   // do some stuff
     ! end;
     - if no Method name is supplied, it will use the caller address, and
     will write it as hexa and with full unit and symbol name, if the debugging
     information is available (i.e. if TSynMapFile retrieved the .map content):
     ! procedure TMyDB.SQLFlush;
     ! begin
     !   TSynLogDB.Enter(self);
     !   // do some stuff
     ! end;
     - note that supplying a method name is faster than using the .map content:
     if you want accurate profiling, it's better to use a method name or not to
     use a .map file
     - Enter() will write the class name (and the unit name for classes with
     published properties, if TSynLogFamily.WithUnitName is true) for both
     enter (+) and leave (-) events:
      $ 20110325 19325801  +    MyDBUnit.TMyDB(004E11F4).SQLExecute
      $ 20110325 19325801 info   SQL=SELECT * FROM Table;
      $ 20110325 19325801  -    MyDBUnit.TMyDB(004E11F4).SQLExecute }
    class function Enter(aInstance: TObject=nil; aMethodName: PUTF8Char=nil): ISynLog; overload;
    {{ to be called and assigned to a ISynLog interface at the beginning
     of a method
     - this is the main method to be called within a class method:
     ! class function TMyDB.SQLValidate(const SQL: RawUTF8): boolean;
     ! var ILog: ISynLog;
     ! begin
     !   ILog := TSynLogDB.Enter(self,'SQLValidate');
................................................................................
     - if you just need to access the log inside the method block, you may
     not need any ISynLog interface:
     ! class procedure TMyDB.SQLFlush;
     ! begin
     !   TSynLogDB.Enter(self,'SQLFlush');
     !   // do some stuff
     ! end;
     - if no Method name is supplied, it will use the caller address, and
     will write it as hexa and with full unit and symbol name, if the debugging
     information is available (i.e. if TSynMapFile retrieved the .map content):
     ! class procedure TMyDB.SQLFlush;
     ! begin
     !   TSynLogDB.Enter(self);
     !   // do some stuff
     ! end;
     - note that supplying a method name is faster than using the .map content:
     if you want accurate profiling, it's better to use a method name or not to
     use a .map file
     - Enter() will write the class name (and the unit name for classes with
     published properties, if TSynLogFamily.WithUnitName is true) for both
     enter (+) and leave (-) events:
      $ 20110325 19325801  +    MyDBUnit.TMyDB.SQLValidate
      $ 20110325 19325801 info   SQL=SELECT * FROM Table returned 1;
      $ 20110325 19325801  -    MyDBUnit.TMyDB.SQLValidate }
    class function Enter(aClassType: TClass; aMethodName: PUTF8Char=nil): ISynLog; overload;
    /// retrieve the current instance of this TSynLog class
    // - to be used for direct logging, without any Enter/Leave:
    // ! TSynLogDB.Add.Log(llError,'The % statement didn't work',[SQL]);
    // - is just a wrapper around Family.SynLog - the same code will work:
    // ! TSynLogDB.Family.SynLog.Log(llError,'The % statement didn't work',[SQL]);
    class function Add: TSynLog;
      {$ifdef HASINLINE}inline;{$endif}
................................................................................
    // class name and address (to be used e.g. if you didn't call TSynLog.Enter()
    // method first) - for instance
    // ! TSQLLog.Add.Log(sllDebug,'GarbageCollector',GarbageCollector);
    // will append this line to the log:
    // $ 0000000000002DB9 debug TObjectList(00425E68) GarbageCollector
    // - if Instance is set and Text is '', will behave the same as
    // Log(Level,Instance), i.e. write the Instance as JSON content
    procedure Log(Level: TSynLogInfo; const Text: RawUTF8;
      aInstance: TObject=nil); overload;
    /// call this method to add the content of an object to the log at a
    // specified level
    // - this default implementation will just write the class name and its hexa
    // pointer value, and handle TList, TCollections and TStrings - for instance:
    // ! TSynLog.Add.Log(sllDebug,GarbageCollector);
    // will append this line to the log:
................................................................................
    /// call this method to add the content of most low-level types to the log
    // at a specified level
    // - this overriden implementation will write the value content,
    // written as human readable JSON: handle dynamic arrays and enumerations
    // - TSQLLog from SQLite3Commons unit will be able to write
    // TObject/TSQLRecord and sets content as JSON
    procedure Log(Level: TSynLogInfo; aName: PWinAnsiChar;
      aTypeInfo: pointer; var aValue); overload;
    /// call this method to add the caller address to the log at the specified level
    // - if the debugging info is available from TSynMapFile, will log the
    // unit name, associated symbol and source code line
    procedure Log(Level: TSynLogInfo); overload;
  published
    /// the associated logging family
    property GenericFamily: TSynLogFamily read fFamily;
    /// the associated file name containing the log
    // - this is accurate only with the default implementation of the class:
    // any child may override it with a custom logging mechanism
    property FileName: TFileName read fFileName;
................................................................................
var L2: integer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if L=0 then
    L := StrLen(P);
  if L=0 then
    exit;
  SetString(result,nil,L); // maximum posible unicode size (if all <#128)
  L2 := UTF8ToWideChar(pointer(result),P,L) shr 1;
  if L2<>L then
    SetLength(result,L2);
end;

function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: integer): UnicodeString;
var i: integer;
begin
  SetString(result,nil,WinAnsiLen);
  for i := 0 to WinAnsiLen-1 do
    PWordArray(result)[i] := WinAnsiTableA[WinAnsi[i]]; // very fast conversion
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;
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}
function Ansi7ToString(Text: PWinAnsiChar; Len: integer): 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
................................................................................
  SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;
var i, L: integer;
begin
  L := length(S);
  SetString(result,nil,L*2+1); // +1 for last wide #0
  if GetACP<>1252 then begin
    // low-level MBCS RTL function including last widechar #0
    SetLength(result,MultiByteToWideChar(GetACP, 0, Pointer(s), L, pointer(result), L));
  end else
    // fast WinAnsi conversion
    for i := 0 to L do // includes S[L]=#0 -> last widechar #0
      PWordArray(result)[i] := WinAnsiTable[PByteArray(S)[i]];
................................................................................
// this Pos() is seldom used, it was decided to only define it under
// Delphi 2009/2010/XE (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);
  result := Ansi7ToString(P,@tmp[15]-P);
end;

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

{$endif UNICODE}

{$ifndef ISDELPHI2007ANDUP}
/// faster implementation of Move() for Delphi versions with no FastCode inside
procedure Move(const Source; var Dest; Count: Integer);
asm // eax=source edx=dest ecx=count
................................................................................
      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 Pointer(ConvertHexToBin)=nil then
    InitConvertHexToBin;
  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 HexToBin(Hex: PAnsiChar; Bin: PByte; BinBytes: Integer): boolean;
var I: Integer;
    B,C: byte;
begin
  result := false; // return false if any invalid char
  if Pointer(ConvertHexToBin)=nil then
................................................................................
var F: THandle;
    Size: integer;
begin
  result := '';
  if FileName='' then
    exit;
  F := FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if PtrInt(F)>=0 then begin
{$ifdef LINUX}
    Size := FileSeek(F,0,soFromEnd);
    FileSeek(F,0,soFromBeginning);
{$else}
    Size := GetFileSize(F,nil);
{$endif}
    SetLength(result,Size);
................................................................................
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
................................................................................
    SetString(result,tmp,15);
  end;
end;

function DateToIso8601(Date: TDateTime; Expanded: boolean): RawUTF8;
// we use YYYYMMDDTdate format
begin

  SetString(result,nil,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

  SetString(result,nil,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): RawUTF8;
// we use Thhmmss format
begin

  SetString(result,nil,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);
end;

function DateTimeToIso8601Text(DT: TDateTime): RawUTF8;
................................................................................
{$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 FileSeek(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,' ');
................................................................................
          BuildYear := SystemTime.wYear;
        end;
      end;
    finally
      Freemem(Pt);
    end;
  end;
  Main := IntToString(Major)+'.'+IntToString(Minor);
  Detailed := Main+ '.'+IntToString(Release)+'.'+IntToString(Build);
  if BuildDateTime=0 then // get build date from file age
    BuildDateTime := FileAgeToDateTime(FileName);
end;

function TFileVersion.Version32: integer;
begin
  result := Major shl 16+Minor shl 8+Release;
................................................................................
    exit; // avoid GPF if void
  SetCount(result+1);
  P := pointer(PtrUInt(Value^)+PtrUInt(result)*ElemSize);
  if ElemType=nil then
    move(Elem,P^,ElemSize) else
    CopyArray(P,@Elem,ElemType,1);
end;

function TDynArray.New: integer;
begin
  result := Count;
  if Value=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 Value=nil then
    exit; // avoid GPF if void
................................................................................
    result := Hasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-4)^*2);
end;

procedure TDynArrayHashed.Init(aTypeInfo: pointer; var aValue;
      aHashElement: TDynArrayHashOne=nil; aCompare: TDynArraySortCompare=nil;
      aHasher: THasher=nil; aCountPointer: PInteger=nil);
var FieldTable: PFieldTable;
label RecH, RecC;
begin
  inherited Init(aTypeInfo,aValue,aCountPointer);
  if @aHasher=nil then begin
    if @DefaultHasher=nil then
      DefaultHasher := @kr32;
     fHasher := DefaultHasher;
  end else
................................................................................
    case PByte(ElemType)^ of
      tkLString:
        aHashElement := HashAnsiString;
      tkWString{$ifdef UNICODE}, tkUString{$endif}:
        aHashElement := HashUnicodeString;
      tkRecord: begin
        FieldTable := ElemType;
RecH:   inc(PtrUInt(FieldTable),ord(FieldTable^.Name[0]));
        if FieldTable^.Count>0 then
        with FieldTable^.Fields[0] do
          if Offset=0 then
          case TypeInfo^^.Kind of
            tkLString:
              aHashElement := HashAnsiString;
            tkWString{$ifdef UNICODE}, tkUString{$endif}:
              aHashElement := HashUnicodeString;
            tkRecord: begin
              FieldTable := pointer(TypeInfo^);
              goto RecH;
            end;
          end;
      end;
    end;
  fHashElement := aHashElement;
  if @aCompare=nil then begin
    aCompare := SORTFIRSTFIELD[TypeInfoToKnown(aTypeInfo)];
    if @aCompare=nil then
      // will match default HashOne algo, i.e. hash first field of record
      if (ElemType<>nil) and (PByte(ElemType)^=tkRecord) then begin
        FieldTable := ElemType;
RecC:   inc(PtrUInt(FieldTable),ord(FieldTable^.Name[0]));
        if FieldTable^.Count=0 then
        case ElemSize of
          1: aCompare := @SortDynArrayByte;
          2: aCompare := @SortDynArrayWord;
          4: aCompare := @SortDynArrayCardinal;
          8: aCompare := @SortDynArrayInt64;
        end else
................................................................................
            8: aCompare := @SortDynArrayInt64;
          end else
          case TypeInfo^^.Kind of
          tkLString:
            aCompare := @SortDynArrayAnsiString;
          tkWString{$ifdef UNICODE}, tkUString{$endif}:
            aCompare := @SortDynArrayUnicodeString;
          tkRecord: begin
            FieldTable := pointer(TypeInfo^);
            goto RecC;
          end;
          end;
      end;
  end;
  fCompare := aCompare;
  ReHash;
end;

................................................................................
      end;
  until false;
  result := -1; // mark not found
end;

function TDynArrayHashed.HashOne(const Elem): cardinal;
var FieldTable: PFieldTable;
label Bin, LStr, WStr, Rec;
begin
  if @fHashElement<>nil then
    result := fHashElement(Elem,fHasher) else
  if ElemType=nil then
    goto Bin else
    case PByte(ElemType)^ of
    tkLString:
................................................................................
        result := fHasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-4)^);
    tkWString{$ifdef UNICODE}, tkUString{$endif}:
WStr: if PtrUInt(Elem)=0 then
        result := 0 else
        result := fHasher(0,Pointer(PtrUInt(Elem)),PInteger(PtrUInt(Elem)-4)^*2);
    tkRecord: begin
      FieldTable := ElemType;
Rec:  inc(PtrUInt(FieldTable),ord(FieldTable^.Name[0]));
      if FieldTable^.Count=0 then
        // only binary content -> hash full content
Bin:    case ElemSize of 
          1: result := byte(Elem);
          2: result := word(Elem);
          4: result := cardinal(Elem);
          8: result := Int64Rec(Elem).Lo xor Int64Rec(Elem).Hi;
................................................................................
      if Offset<>0 then
        // hash whole starting binary content of record
        result := fHasher(0,@Elem,Offset) else
        // hash first string field of record
        case TypeInfo^^.Kind of
        tkLString: goto LStr;
        tkWString{$ifdef UNICODE}, tkUString{$endif}: goto WStr;
        tkRecord: begin
          FieldTable := pointer(TypeInfo^);
          goto Rec;
        end;
        else result := 0; // unhandled type 
        end;
    end;
    else result := 0;
    end;
  if result=0 then
    result := 1; // never return 0 (indicates a free position in fHashs[])
................................................................................
  fOwner := Owner;
end;

function TSynTestCase.RandomString(CharCount: Integer): RawByteString;
var V: cardinal;
    P: PAnsiChar;
begin

  SetString(result,nil,CharCount);
  P := pointer(Result);
  while CharCount>0 do begin
    if CharCount>5 then begin
      V := Random(maxInt); // fast: one random compute per 5 chars
      P[0] := AnsiChar(32+V and 127); V := V shr 7;
      P[1] := AnsiChar(32+V and 127); V := V shr 7;
      P[2] := AnsiChar(32+V and 127); V := V shr 7;
................................................................................
    Check(Cities[i].Name=''); // ForAddind = not added
    Cities[i] := City;
  end;
  Check(ACities.Count=3);
  Check(City.Name='Iasi');
  Check(ACities.FindHashed(City)>=0);
  for i := 1 to 2000 do begin
    City.Name := IntToString(i);
    City.Latitude := i*3.14;
    City.Longitude := i*6.13;
    Check(ACities.FindHashedAndUpdate(City,true)=i+2,'multiple ReHash');
    Check(ACities.FindHashed(City)=i+2);
  end;
  ACities.Capacity := CITIES_MAX+3; // make it as fast as possible
  for i := 2001 to CITIES_MAX do begin
    City.Name := IntToString(i);
    City.Latitude := i*3.14;
    City.Longitude := i*6.13;
    Check(ACities.FindHashedAndUpdate(City,true)=i+2,'use Capacity: no ReHash');
    Check(ACities.FindHashed(City.Name)=i+2);
  end;
  for i := 1 to CITIES_MAX do begin
    N := IntToString(i);
    j := ACities.FindHashed(N);
    Check(j=i+2,'hashing with string not City.Name');
    Check(Cities[j].Name=N);
    CheckSame(Cities[j].Latitude,i*3.14);
    CheckSame(Cities[j].Longitude,i*6.13);
  end;
end;
................................................................................
    JSON_BASE64_MAGIC_UTF8: RawUTF8;
procedure Fill(var F: TFileVersion; i: integer);
begin
  F.Major := i;
  F.Minor := i+1;
  F.Release := i+2;
  F.Build := i+3;
  F.Main := IntToString(i+1000);
  F.Detailed := IntToString(2000-i);
  F.BuildDateTime := 36215.12;
  F.BuildYear := i+2011;
end;
begin
  W := TTextWriter.CreateOwnedStream;
  // validate TIntegerDynArray 
  AIP.Init(TypeInfo(TIntegerDynArray),AI);
................................................................................
  Check(RecordEquals(F,AF[100],TypeInfo(TFileVersion)));
  for i := 0 to 1000 do
    with AF[i] do begin
      Check(Major=i);
      Check(Minor=i+1);
      Check(Release=i+2);
      Check(Build=i+3);
      Check(Main=IntToString(i+1000));
      Check(Detailed=IntToString(2000-i));
      CheckSame(BuildDateTime,36215.12);
      Check(BuildYear=i+2011);
    end;
  for i := 0 to 1000 do begin
    Fill(F,i);
    Check(AFP.IndexOf(F)=i);
  end;
................................................................................
{$endif}
  for i := 1 to 10000 do begin
    j := Random(maxInt)-Random(maxInt);
    str(j,a);
    s := RawUTF8(a);
    Check(kr32(0,pointer(s),length(s))=kr32pas(pointer(s),length(s)));
    u := string(a);
    Check(SysUtils.IntToStr(j)=u);
    Check(Int32ToUtf8(j)=s);
    Check(format('%d',[j])=u);
    Check(GetInteger(pointer(s))=j);
    Check(FormatUTF8('%',[j])=s);
    k := Int64(j)*Random(MaxInt);
    str(k,a);
    s := RawUTF8(a);
    u := string(a);
    Check(SysUtils.IntToStr(k)=u);
    Check(Int64ToUtf8(k)=s);
    Check(format('%d',[k])=u);
    Check(FormatUTF8('%',[k])=s);
    err := 1;
    l := GetInt64(pointer(s),err);
    Check((err=0)and(l=k));
    str(j,a);
    Check(SysUtils.IntToStr(j)=string(a));
    Check(format('%d',[j])=string(a));
    Check(format('%.8x',[j])=IntToHex(j,8));
    d := Random*1E-17-Random*1E-9;
    str(d,a);
    s := RawUTF8(a);
    e := GetExtended(Pointer(s),err);
    Check(SameValue(e,d)); // test str()
................................................................................
    Check(T.AddField('double',tftDouble)<>nil);
    Check(T.AddField('varint',tftVarUInt32)<>nil);
    Check(T.AddField('text',tftUTF8,[tfoUnique])<>nil);
    Check(T.AddField('ansi',tftWinAnsi,[])<>nil);
    Check(T.AddField('currency',tftCurrency)<>nil);
    Test;
    FN := ChangeFileExt(paramstr(0),'.syntable');
    DeleteFile(FN);
    f := FileCreate(FN); // manual storage of TSynTable header
    W.AssignToFile(f);
    T.SaveTo(W);
    W.Flush;
    FileClose(f);
    T.Free;
    f := FileOpen(FN,fmOpenRead);
................................................................................
  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));
................................................................................
      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);
................................................................................
          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));
................................................................................
  end;
end;

procedure TFileBufferReader.ErrorInvalidContent;
begin
  raise Exception.Create('TFileBufferReader: invalid content');
end;

procedure TFileBufferReader.OpenFrom(aBuffer: pointer; aBufferSize: cardinal);
begin
  fCurrentPos := 0;
  fBuf := aBuffer;
  fBufSize := aBufferSize;
  fFileSize := aBufferSize;
  fMap := 0;
end;

procedure TFileBufferReader.Open(aFile: THandle);
begin
  fCurrentPos := 0;
  fBuf := nil;
  fMap := 0;
  fFile := aFile;
................................................................................
  end;
end;

function TFileBufferReader.Read(Data: pointer; DataLen: integer): integer;
var len: integer;
begin
  if DataLen>0 then
    if fBuf<>nil then begin
      // file up to 2 GB: use fast memory map
      len := fBufSize-fCurrentPos;
      if len>DataLen then
        len := DataLen;
      move(fBuf[fCurrentPos],Data^,len);
      inc(fCurrentPos,len);
      result := len;
................................................................................
    ErrorInvalidContent;
  PEnd := pointer(PtrUInt(P)+PtrUInt(len));
end;

function TFileBufferReader.ReadPointer(DataLen: PtrUInt;
  var aTempData: RawByteString): pointer;
begin
  if 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(fFile,pointer(aTempData)^,DataLen))<>DataLen then
      result := nil else // invalid content
................................................................................

{$ifndef LVCL}
function TFileBufferReader.ReadStream: TCustomMemoryStream;
var DataLen: PtrUInt;
begin
  DataLen := ReadVarUInt32;
  if DataLen<>0 then
    if fBuf=nil then begin
      // use temporary TMemoryStream only if not in memory map buffer
      result := TMemoryStream.Create;
      result.Size := DataLen;
      if PtrUInt(FileRead(fFile,result.Memory^,DataLen))<>DataLen then
        FreeAndNil(result); // invalid content
    end else
    if DataLen+fCurrentPos>fBufSize then
................................................................................
    // DataLen=0 -> invalid content
    result := nil;
end;
{$endif}

function TFileBufferReader.ReadByte: PtrUInt;
begin
  if fBuf<>nil then
    if fCurrentPos>=fBufSize then
      // invalid request
      result := 0 else begin
      // read one byte from current memory map
      result := ord(fBuf[fCurrentPos]);
      inc(fCurrentPos);
    end else begin
      // read from file if >= 2 GB (slow, but works)
      result := 0;
      if FileRead(fFile,result,1)<>1 then
        result := 0;
    end;
end;

function TFileBufferReader.ReadCardinal: cardinal;
begin
  if fBuf<>nil then
    if fCurrentPos+3>=fBufSize then
      // invalid request
      result := 0 else begin
      // read one byte from current memory map
      result := PCardinal(fBuf+fCurrentPos)^;
      inc(fCurrentPos,4);
    end else begin
      // read from file if >= 2 GB (slow, but works)
      result := 0;
      if FileRead(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;
................................................................................
  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);
  DataLayout := TFileBufferWriterKind(ReadByte);
  if DataLayout in [wkOffsetU, wkOffsetI] then begin
    PI^ := ReadVarUInt32;
    dec(count);
    diff := ReadVarUInt32;
    if diff<>0 then begin
      for i := 0 to count-1 do
        PIA^[i+1] := PIA^[i]+diff;
      exit;
................................................................................
          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
................................................................................
  assert((count=0)and(PI=@Values[result]));
end;

function TFileBufferReader.ReadRawUTF8List(List: TRawUTF8List): boolean;
var i: integer;
    StoreObjectsAsVarUInt32: Boolean;
begin
  if (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
................................................................................
end;

{$ifndef CPU64}
function TFileBufferReader.Seek(Offset: Int64): boolean;
begin
  if (Offset<0) or (Offset>fFileSize) then
    result := False else
  if fBuf=nil then
    result := FileSeek64(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 fBuf=nil then
    Result := FileSeek(fFile,Offset,0)=Offset else
  if (fBuf<>nil) and (PtrUInt(Offset)<PPtrUInt(@fFileSize)^) then begin
    fCurrentPos := Offset;
    result := true;
  end else
    result := false;
end;


................................................................................
    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);
................................................................................
    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
................................................................................
function TSynTableData.ValidateSBFValue(RecordIndex: integer): string;
begin
  CheckVTableInitialized;
  Result := VTable.Validate(Pointer(VValue),RecordIndex);
end;


{ TSynMapFile }

var
  ExeMapFile: TSynMapFile = nil;

const
  MAB_MAGIC: cardinal = $A5A5A5A5;

function MatchPattern(P,PEnd,Up: PUTF8Char): boolean;
begin
  result := false;
  repeat
    while P^=' ' do inc(P);
    while NormToUpperAnsi7[P^]=Up^ do begin
      inc(P);
      if P>PEnd then exit;
      inc(Up);
      if (Up^=' ') and (P^=' ') then begin // ignore multiple spaces in P^
        while (P<PEnd) and (P^=' ') do inc(P);
        inc(Up);
      end;
    end;
    if Up^=#0 then // all chars of Up^ found in P^
      break else
    if Up^<>' ' then // P^ and Up^ didn't match
      exit;
    inc(Up);
  until false;
  result := true;
end;

procedure ReadSymbol(var R: TFileBufferReader; const A: TDynArray);
var i, n, L: integer;
    S: PSynMapSymbol;
    Addr: cardinal;
    P: PByte;
begin
  n := R.ReadVarUInt32;
  A.Count := n;
  if n=0 then
    exit;
  P := @R.fBuf[R.fCurrentPos];
  S := A.Value^;
  for i := 0 to n-1 do begin
    L := FromVarUInt32(P); // inlined R.Read(S^.Name)
    SetString(S^.Name,PAnsiChar(P),L);
    inc(P,L);
    inc(PtrUInt(S),A.ElemSize);
  end;
  S := A.Value^;
  Addr := FromVarUInt32(P);
  S^.Start := Addr;
  for i := 1 to n-1 do begin
    inc(Addr,FromVarUInt32(P));
    S^.Stop := Addr-1;
    inc(PtrUInt(S),A.ElemSize);
    S^.Start := Addr;
  end;
  S^.Stop := Addr+FromVarUInt32(P);
  R.fCurrentPos := PtrUInt(P)-PtrUInt(R.fBuf);
end;

constructor TSynMapFile.Create(const aExeName: TFileName=''; MabCreate: boolean=true);

  procedure LoadMap;
    var P, PEnd: PUTF8Char;
    procedure NextLine;
    begin
      while (P<PEnd) and (P^>=' ') do inc(P);
      if (P<PEnd) and (P^=#13) then inc(P);
      if (P<PEnd) and (P^=#10) then inc(P);
    end;
    function GetCode(var Ptr: cardinal): boolean;
    begin
      while (P<PEnd) and (P^=' ') do inc(P);
      result := false;
      if (P+10<PEnd) and
         (PInteger(P)^=ord('0')+ord('0')shl 8+ord('0')shl 16+ord('1')shl 24) and
         (P[4]=':') then begin
        if not HexDisplayToBin(PAnsiChar(P)+5,@Ptr,sizeof(Ptr)) then exit;
        while (P<PEnd) and (P^>' ') do inc(P);
        while (P<PEnd) and (P^=' ') do inc(P);
        if P<PEnd then
          result := true;
      end;
    end;
    procedure ReadSegments;
    var Beg: PAnsiChar;
        U: TSynMapUnit;
    begin
      NextLine;
      NextLine;
      while (P<PEnd) and (P^<' ') do inc(P);
      while (P+10<PEnd) and (P^>=' ') do begin
        if GetCode(U.Symbol.Start) and
           HexDisplayToBin(PAnsiChar(P),@U.Symbol.Stop,4) then begin
          while PWord(P)^<>ord('M')+ord('=')shl 8 do
            if P+10>PEnd then exit else inc(P);
          Beg := pointer(P+2);
          while (P<PEnd) and (P^>' ') do inc(P);
          SetString(U.Symbol.Name,Beg,P-Beg);
          inc(U.Symbol.Stop,U.Symbol.Start);
          if U.Symbol.Start<>0 then
            dec(U.Symbol.Stop); // fix incoherency in .map for 1st segment
          if U.Symbol.Name<>'' then
            fUnits.FindHashedAndUpdate(U,true); // true for adding
        end;
        NextLine;
      end;
    end;
    procedure ReadSymbols;
    var Beg: PAnsiChar;
        Sym: TSynMapSymbol;
    begin
      NextLine;
      NextLine;
      while (P+10<PEnd) and (P^>=' ') do begin
        if GetCode(Sym.Start) then begin
          while (P<PEnd) and (P^=' ') do inc(P);
          Beg := pointer(P);
          while (P<PEnd) and (P^>' ') do inc(P);
          SetString(Sym.Name,Beg,P-Beg);
          if Sym.Name<>'' then
            fSymbols.Add(Sym);
        end;
        NextLine;
      end;
    end;
    procedure ReadLines;
    var Beg: PAnsiChar;
        i, Count: integer;
        aName: RawUTF8;
        added: boolean;
    begin
      inc(P,17);
      Beg := pointer(P);
      while P^<>'(' do if P=PEnd then exit else inc(P);
      SetString(aName,Beg,P-Beg);
    {  inc(P); Beg := pointer(P); // we don't need the filename by now
      while P^<>')' do if P=PEnd then exit else inc(P);
      SetString(aFileName,Beg,P-Beg); }
      if aName='' then
        exit;
      i := fUnits.FindHashedForAdding(aName,added);
      if added then
        fUnit[i].Symbol.Name := aName; // should not occur, but who knows...
      NextLine;
      NextLine;
      Count := 0;
      with fUnit[i] do begin
        // FileName := aFileName;
        while (P+10<PEnd) and (P^>=' ') do begin
          while (P<PEnd) and (P^=' ') do inc(P);
          repeat
            if Count=length(Line) then begin
              SetLength(Line,Count+256);
              SetLength(Addr,Count+256);
            end;
            Line[Count] := GetNextItemCardinal(P,' ');
            if not GetCode(cardinal(Addr[Count])) then
              break;
            inc(Count);
          until (P>=PEnd) or (P^<' ');
          NextLine;
        end;
        SetLength(Line,Count);
        SetLength(Addr,Count);
      end;
    end;
  var i, s,u: integer;
  begin // LoadMap
    fSymbols.Capacity := 5000;
    with TMemoryStream.Create do
    try
      LoadFromFile(fMapFile);
      P := Memory;
      PEnd := P+Size;
      while P<PEnd do
        if MatchPattern(P,PEnd,'DETAILED MAP OF SEGMENTS') then
          ReadSegments else
        if MatchPattern(P,PEnd,'ADDRESS PUBLICS BY VALUE') then
          ReadSymbols else
        if MatchPattern(P,PEnd,'LINE NUMBERS FOR') then
          ReadLines else
         NextLine;
      // now we should have read all .map content
      u := fUnits.Count;
      s := fSymbols.Count;
      for i := 1 to u-1 do
         assert(fUnit[i].Symbol.Start>fUnit[i-1].Symbol.Stop);
      for i := 0 to s-2 do
        fSymbol[i].Stop := fSymbol[i+1].Start-1;
      if (u>0) and (s>0) then
        fSymbol[s-1].Stop := fUnit[u-1].Symbol.Stop;
    finally
      Free;
    end;
  end;

  procedure LoadMab(const aMabFile: TFileName);
  var tmp: cardinal;
      F: THandle;
      R: TFileBufferReader;
      i: integer;
  begin
    fMapFile := aMabFile;
    F := FileOpen(fMapFile,fmOpenRead or fmShareDenyNone);
    if PtrInt(F)>=0 then
    try
      R.Open(F);
      R.Seek(R.FileSize-8);
      if R.ReadCardinal<>MAB_MAGIC then exit;
      R.Read(@tmp,4);
      if tmp>R.FileSize then
        exit;
      R.Seek(R.FileSize-tmp);
      if R.ReadCardinal<>MAB_MAGIC then exit;
      ReadSymbol(R,fSymbols);
      ReadSymbol(R,fUnits);
      for i := 0 to fUnits.Count-1 do
      with fUnit[i] do begin
        R.ReadVarUInt32Array(Line);
        R.ReadVarUInt32Array(Addr);
      end;
      if R.ReadCardinal=MAB_MAGIC then
        MabCreate := false else
        fUnits.Count := 0; // invalid content
    finally
      FileClose(F);
    end;
  end;

var SymCount, UnitCount, i: integer;
    MabFile: TFileName;
begin
  fSymbols.Init(TypeInfo(TSynMapSymbolDynArray),fSymbol,@SymCount);
  fUnits.Init(TypeInfo(TSynMapUnitDynArray),fUnit,nil,nil,nil,@UnitCount);
  // 1. search for a .map file in the .exe directory
  if aExeName='' then
    fMapFile := paramstr(0) else
    fMapFile := aExeName;
  fMapFile := ChangeFileExt(fMapFile,'.map');
  MabFile := ChangeFileExt(fMapFile,'.mab');
  if FileExists(fMapFile) and
     // no slow read of .map if faster-to-load .mab is available and accurate 
     (FileAge(MabFile)<FileAge(fMapFile)) then
    LoadMap;
  // 2. search for a .mab file in the .exe directory
  if SymCount=0 then
    LoadMab(MabFile);
  // 3. search for an embedded compressed .mab file appended to the .exe
  if SymCount=0 then
    LoadMab(ChangeFileExt(fMapFile,'.exe'));
  // finalize symbols
  if SymCount>0 then begin
    for i := 1 to SymCount-1 do
      assert(fSymbol[i].Start>fSymbol[i-1].Stop);
    SetLength(fSymbol,SymCount);
    SetLength(fUnit,UnitCount);
    fSymbols.fCountP := nil;
    fUnits.fCountP := nil;
    if MabCreate then
      SaveToFile(''); // if just created from .map -> create .mab file 
    fHasDebugInfo := true;
  end;
end;

procedure WriteSymbol(var W: TFileBufferWriter; const A: TDynArray);
var i, n: integer;
    Diff: cardinal;
    S: PSynMapSymbol;
    P: PByte;
    Beg: PtrUInt;
begin
  n := A.Count;
  W.WriteVarUInt32(n);
  if n=0 then exit;
  S := A.Value^;
  for i := 0 to n-1 do begin
    W.Write(S^.Name);
    inc(PtrUInt(S),A.ElemSize);
  end;
  S := A.Value^;
  Diff := S^.Start;
  W.WriteVarUInt32(Diff);
  if W.fPos+n*5>W.fBufLen then
    W.Flush;
  with W do
    if fPos+n*5>fBufLen then
      raise Exception.CreateFmt('too big %s',[PDynArrayTypeInfo(A.TypeInfo).Name]) else
      P := @PByteArray(fBuf)^[fPos];
  Beg := PtrUInt(P);
  for i := 1 to n-1 do begin
    inc(PtrUInt(S),A.ElemSize);
    P := ToVarUInt32(S^.Start-Diff,P);
    Diff := S^.Start;
  end;
  P := ToVarUInt32(S^.Stop-Diff,P);
  Beg := PtrUInt(P)-Beg;
  inc(W.fPos,Beg);
  inc(W.fTotalWritten,Beg);
end;

function TSynMapFile.SaveToFile(const aFileName: TFileName=''): TFileName;
var W: TFileBufferWriter;
    F: THandle;
    i, Len: integer;
begin
  if aFileName='' then
    result := ChangeFileExt(paramstr(0),'.mab') else
    result := aFileName;
  DeleteFile(result);
  F := FileCreate(result);
  if PtrInt(F)>=0 then
  try
    W.AssignToFile(F,1 shl 17);
    W.Write(@MAB_MAGIC,sizeof(MAB_MAGIC));
    WriteSymbol(W,fSymbols);
    WriteSymbol(W,fUnits);
    for i := 0 to high(fUnit) do
    with fUnit[i] do begin
      W.WriteVarUInt32Array(Line,length(Line),wkOffsetI); // not always increasing
      W.WriteVarUInt32Array(Addr,length(Addr),wkOffsetU); // always increasing
    end;
    W.Write(@MAB_MAGIC,4);
    Len := W.TotalWritten+4;
    W.Write(@Len,4);
    W.Flush;
  finally
    FileClose(F);
  end;
end;

procedure TSynMapFile.SaveToExe(const aExeName: TFileName);
var FN: TFileName;
    MS, MAB: TMemoryStream;
    Len, LenMAB: PtrUInt;
    P: PAnsiChar;
begin
  if not FileExists(aExeName) then
    exit;
  FN := SaveToFile(ChangeFileExt(aExeName,'.mab'));
  try
    MS := TMemoryStream.Create;
    MAB := TMemoryStream.Create;
    try
      // load both files
      MAB.LoadFromFile(FN);
      LenMAB := MAB.Size;
      MS.LoadFromFile(aExeName);
      Len := MS.Size;
      if Len<16 then
        exit;
      P := MS.Memory;
      inc(P,Len);
      if PCardinal(P-8)^=MAB_MAGIC then
        // trim existing mab content
        dec(Len,PCardinal(P-4)^);
      // append mab content to exe
      MS.Size := Len+LenMAB;
      move(MAB.Memory^,PAnsiChar(MS.Memory)[Len],LenMAB);
      MS.SaveToFile(aExeName);
    finally
      MAB.Free;
      MS.Free;
    end;
  finally
    DeleteFile(FN);
  end;
end;

function TSynMapFile.FindSymbol(aAddr: cardinal): integer;
var L,R: integer;
begin
  R := high(fSymbol);
  L := 0;
  if (R>=0) and (aAddr>=fSymbol[0].Start) and (aAddr<=fSymbol[R].Stop) then
  repeat
    result := (L+R)shr 1;
    with fSymbol[result] do
      if aAddr<Start then
        R := result-1 else
      if aAddr>Stop then
        L := result+1 else
        exit;
  until L>R;
  result := -1;
end;

function TSynMapFile.FindUnit(aAddr: cardinal; out LineNumber: integer): integer;
var L,R,n,max: integer;
begin
  LineNumber := 0;
  R := high(fUnit);
  L := 0;
  if (R>=0) and
     (aAddr>=fUnit[0].Symbol.Start) and (aAddr<=fUnit[R].Symbol.Stop) then
  repeat
    result := (L+R) shr 1;
    with fUnit[result] do
      if aAddr<Symbol.Start then
        R := result-1 else
      if aAddr>Symbol.Stop then
        L := result+1 else begin
        // unit found -> search line number
        L := 0;
        max := high(Addr);
        R := max;
        if R>=0 then
        repeat
          n := (L+R) shr 1;
          if aAddr<cardinal(Addr[n]) then
            R := n-1 else
          if (n<max) and (aAddr>=cardinal(Addr[n+1])) then
            L := n+1 else begin
            LineNumber := Line[n];
            exit;
          end;
        until L>R;
        exit;
      end;
  until L>R;
  result := -1;
end;

const
  /// Delphi linker starts the code section at this fixed offset
  CodeSection = $1000;

class procedure TSynMapFile.Log(W: TTextWriter; Addr: PtrUInt);
var u, s, Line: integer;
begin
  if (W=nil) or (Addr=0) then
    exit;
  if ExeMapFile=nil then begin
    ExeMapFile := TSynMapFile.Create;
    GarbageCollector.Add(ExeMapFile);
    ExeMapFile.fGetModuleHandle := GetModuleHandle(nil)+CodeSection;
  end;
  W.AddPointer(Addr);
  W.Add(' ');
  with ExeMapFile do
  if HasDebugInfo then begin
    dec(Addr,fGetModuleHandle);
    s := FindSymbol(Addr);
    u := FindUnit(Addr,Line);
    if (s<0) and (u<0) then
      exit;
    if u>=0 then begin
      W.AddString(Units[u].Symbol.Name);
      if s>=0 then
        if Symbols[s].Name=Units[u].Symbol.Name then
          s := -1 else
          W.Add('.');
    end;
    if s>=0 then
      W.AddString(Symbols[s].Name);
    W.Add(' ');
    if Line>0 then begin
      W.Add('(');
      W.Add(Line);
      W.Add(')',' ');
    end;
  end;
end;


{ TSynLogFamily }

/// if defined, will use AddVectoredExceptionHandler() API call
// - this one does not produce accurate stack trace by now, and is supported
// only since Windows XP
// - so default method using RTLUnwindProc should be prefered
{.$define WITH_VECTOREXCEPT}

type
  TExceptProc = procedure(Obj: TObject; Addr: Pointer);

var
  /// internal list of registered TSynLogFamily
  // - up to MAX_SYNLOGFAMILY+1 families may be defined
  SynLogFamily: TObjectList = nil;

var
  SynLogExceptionEnabled: boolean = false;

threadvar
  CurrentHandleExceptionSynLog: TSynLog;



function GetHandleExceptionSynLog: TSynLog;
var Index: ^TSynLogFileIndex;
    i: integer;
    ndx, n: cardinal;
begin
  result := CurrentHandleExceptionSynLog;
  if (result<>nil) and result.fFamily.fHandleExceptions then
    exit;
  Index := @SynLogFileIndex;
  if SynLogFile=nil then begin
    // we are here is no previous log content was trigerred
    for i := 0 to SynLogFamily.Count-1 do
      with TSynLogFamily(SynLogFamily.List^[i]) do
      if fHandleExceptions then begin
        result := SynLog;
        exit;
      end;
  end else begin
    n := SynLogFile.Count;
    for i := 0 to high(Index^) do begin
      ndx := Index^[i]-1;
      if ndx<=n then begin
        result := TSynLog(SynLogFile.List^[ndx]);
        if result.fFamily.fHandleExceptions then
          exit;
      end;
    end;
    for i := 0 to n-1 do begin
      result := TSynLog(SynLogFile.List^[i]);
      if result.fFamily.fHandleExceptions then
        exit;
    end;
  end;
  result := nil;
end;

function check2(xret: PtrUInt): Boolean;
var i: PtrUInt;
begin
  result := true;
  for i := 2 to 7 do
    if PWord(xret-i)^ and $38FF=$10FF then
      exit;
  result := false;
end;

{$ifdef WITH_VECTOREXCEPT}
type
  PExceptionRecord = ^TExceptionRecord;
  TExceptionRecord = packed record
    ExceptionCode        : LongWord;
    ExceptionFlags       : LongWord;
    OuterException       : PExceptionRecord;
    ExceptionAddress     : Pointer;
................................................................................
  PExceptionInfo = ^TExceptionInfo;
  TExceptionInfo = packed record
    ExceptionRecord: PExceptionRecord;
    ContextRecord: pointer;
  end;
  GetExceptionClass = function(P: PExceptionRecord): ExceptClass;

var
  AddVectoredExceptionHandler: function(FirstHandler: cardinal;
    VectoredHandler: pointer): PtrInt; stdcall;

























function SynLogVectoredHandler(ExceptionInfo : PExceptionInfo): PtrInt; stdcall;
const
  EXCEPTION_CONTINUE_SEARCH = 0;
var SynLog: TSynLog;
    Level: TSynLogInfo;
    E: ExceptClass;
    EAddr: pointer;
    LastError: DWORD;
    curr_stack: PPtrUInt;
    stack, max_stack, min_stack, depth: PtrUInt;
begin
  if not SynLogExceptionEnabled then begin
    result := EXCEPTION_CONTINUE_SEARCH; // if called within function
    exit;
  end;
  LastError := GetLastError;
  // guess if was a Delphi or OS exception
  E := nil;
  EAddr := nil;
  Level := sllException;

  SynLog := GetHandleExceptionSynLog;
  if (SynLog<>nil) and (ExceptionInfo<>nil) and (ExceptionInfo^.ExceptionRecord<>nil) then
    with ExceptionInfo^.ExceptionRecord^ do
      if (ExceptObject<>nil) and ExceptObject.InheritsFrom(Exception) then begin
        // Delphi exception
        E := PPointer(ExceptObject)^;
        EAddr := ExceptAddr;
      end else begin
        // OS exception -> translate into a Delphi Exception class
        if Assigned(ExceptClsProc) then
          E := GetExceptionClass(ExceptClsProc)(ExceptionInfo^.ExceptionRecord);
        if E=nil then
          E := EExternalException;
        Level := sllExceptionOS;
        EAddr := ExceptionAddress;
      end;
  // log corresponding message if necessary
  if (E<>nil) and
     ((Level<>sllException) or (sllException in SynLog.fFamily.Level)) then begin
    SynLog.LogHeaderLock(Level);
    with SynLog.fWriter, ExceptionInfo^.ExceptionRecord^ do
      if Level=sllException then
        Add('% ("%") at ',[E,ExceptObject.Message]) else
        Add('% (%) at ',[E,pointer(ExceptionCode)]);
    TSynMapFile.Log(SynLog.fWriter,PtrUInt(EAddr));
    depth := SynLog.fFamily.fStackTraceLevel;
    if depth>0 then begin
      SynLog.fWriter.AddShort('stack trace ');
      SynLogExceptionEnabled := false; // for IsBadCodePtr
      try
        asm
          mov eax,[ebp] // push ebp; mov ebp,esp done at begin level above
          mov curr_stack,eax
          mov eax,fs:[18h]
          mov ecx,dword ptr [eax+4]
          mov max_stack,ecx
          mov ecx,dword ptr [eax+8]
          mov min_stack,ecx
        end;
        while (PtrUInt(curr_stack)<max_stack) and
          (curr_stack^<>PtrUInt(EAddr)) do inc(curr_stack);
        while PtrUInt(curr_stack)<max_stack do begin
          stack := curr_stack^;
          if ((stack>max_stack) or (stack<min_stack)) and
             not IsBadReadPtr(pointer(stack-8),12) and
             ((pByte(stack-5)^=$E8) or check2(stack)) then begin
            TSynMapFile.Log(SynLog.fWriter,stack);
            dec(depth);
            if depth=0 then break;
          end;
          inc(curr_stack);
        end;
      finally
        SynLogExceptionEnabled := true;
      end;
    end;
    SynLog.fWriter.AddCR;
    SynLog.UnLock;
  end;
  SetLastError(LastError); // code above could have changed this
  result := EXCEPTION_CONTINUE_SEARCH;
end;

{$else WITH_VECTOREXCEPT}

var
  oldUnWindProc: pointer;

const
  cDelphiExcept = $0EEDFAE0;
  cDelphiException = $0EEDFADE;

procedure LogExcept(stack: PPtrUInt; EAddr, ECode: PtrUInt; EObject: TObject); stdcall;
var SynLog: TSynLog;
    Level: TSynLogInfo;
    E: ExceptClass;
    LastError: DWORD;
    st, max_stack, min_stack, depth: PtrUInt;
begin
  if not SynLogExceptionEnabled then
    exit;
  SynLog := GetHandleExceptionSynLog;
  if SynLog=nil then
    exit;
  Level := sllError;
  LastError := GetLastError;
  if (ECode=cDelphiException) and (EObject<>nil) then begin
    if EObject.InheritsFrom(Exception) then
      E := PPointer(EObject)^ else
      E := EExternalException;
    if sllException in SynLog.fFamily.Level then



      Level := sllException;
  end else begin
    case ECode of
      STATUS_INTEGER_DIVIDE_BY_ZERO,
      STATUS_FLOAT_DIVIDE_BY_ZERO:   E := EDivByZero;
      STATUS_ARRAY_BOUNDS_EXCEEDED:  E := ERangeError;
      STATUS_INTEGER_OVERFLOW:       E := EIntOverflow;
      STATUS_FLOAT_INEXACT_RESULT,
      STATUS_FLOAT_INVALID_OPERATION,
      STATUS_FLOAT_STACK_CHECK:      E := EInvalidOp;
      STATUS_FLOAT_OVERFLOW:         E := EOverflow;
      STATUS_FLOAT_UNDERFLOW,
      STATUS_FLOAT_DENORMAL_OPERAND: E := EUnderflow;
      STATUS_ACCESS_VIOLATION:       E := EAccessViolation;
      STATUS_PRIVILEGED_INSTRUCTION: E := EPrivilege;
      STATUS_CONTROL_C_EXIT:         E := EControlC;
{$WARN SYMBOL_DEPRECATED OFF}
      STATUS_STACK_OVERFLOW:         E := EStackOverflow;
{$WARN SYMBOL_DEPRECATED ON}
      else E := EExternal;
    end;
    Level := sllExceptionOS;
  end;
  if (Level<>SllError) and
     (SynLog.fFamily.ExceptionIgnore.IndexOf(E)<0) then begin
    SynLog.LogHeaderLock(Level);
    if (Level=sllException) and (E<>EExternalException) then
      SynLog.fWriter.Add('% ("%") at ',[E,Exception(EObject).Message]) else
      SynLog.fWriter.Add('% (%) at ',[E,pointer(ECode)]);
    TSynMapFile.Log(SynLog.fWriter,EAddr);
    depth := SynLog.fFamily.fStackTraceLevel;



    if depth>0 then begin
      SynLog.fWriter.AddShort('stack trace ');
      SynLogExceptionEnabled := false; // for IsBadCodePtr
      try
        asm
          mov eax,fs:[18h]
          mov ecx,dword ptr [eax+4]
          mov max_stack,ecx
          mov ecx,dword ptr [eax+8]
          mov min_stack,ecx
        end;
        while PtrUInt(stack)<max_stack do begin
          st := stack^;
          if ((st>max_stack) or (st<min_stack)) and
             not IsBadReadPtr(pointer(st-8),12) and
             ((pByte(st-5)^=$E8) or check2(st)) then begin
            TSynMapFile.Log(SynLog.fWriter,st);
            dec(depth);
            if depth=0 then break;
          end;

          inc(stack);
        end;
      finally
        SynLogExceptionEnabled := true;
      end;
    end;
    SynLog.fWriter.AddCR;
    SynLog.UnLock;
  end;
  SetLastError(LastError); // code above could have changed this
end;

procedure SynRtlUnwind(TargetFrame, TargetIp, ExceptionRecord, ReturnValue: Pointer); stdcall;
asm
  pushad
  cmp  byte ptr SynLogExceptionEnabled,0
  jz   @oldproc
  mov  eax,[ebp+8]
  or   eax,eax
  jz   @oldproc
  mov  ebx,[eax+8]
  mov  eax,[ebp+16]
  push dword ptr [eax+24]
  push dword ptr [eax]
  mov  ecx,[eax]
  cmp  ecx,cDelphiException
  je   @delphi_exception
  cmp  ecx,cDelphiExcept
  je   @delphi_exception
  mov  eax,[eax+12]
  push eax
  push ebx
  call LogExcept
  jmp  @oldproc
@delphi_exception:
  mov  eax,[eax+20]
  push eax
  push ebx
  call LogExcept
@oldproc:
  popad
  pop  ebp
  jmp  oldUnWindProc
end;

{$endif WITH_VECTOREXCEPT}

procedure TSynLogFamily.SetLevel(const aLevel: TSynLogInfos);


{$ifdef WITH_VECTOREXCEPT}
var K32: HMODULE;
{$endif}
begin
  fLevel := aLevel;
  fHandleExceptions := (sllExceptionOS in aLevel) or (sllException in aLevel);
  if not SynLogExceptionEnabled and fHandleExceptions then begin
    SynLogExceptionEnabled := true;
{$ifdef WITH_VECTOREXCEPT}
    K32 := GetModuleHandle(kernel32);
    AddVectoredExceptionHandler := GetProcAddress(K32,'AddVectoredExceptionHandler');

    // RemoveVectoredContinueHandler() is available under 64 bit editions only
    if Assigned(AddVectoredExceptionHandler) then
      // available since Windows XP
      AddVectoredExceptionHandler(0,@SynLogVectoredHandler);
{$else WITH_VECTOREXCEPT}
    oldUnWindProc := RTLUnwindProc;
    RTLUnwindProc := @SynRtlUnwind;
{$endif WITH_VECTOREXCEPT}
  end;
end;

constructor TSynLogFamily.Create(aSynLog: TSynLogClass);
begin
  fSynLogClass := aSynLog;
  if SynLogFamily=nil then begin
    SynLogFamily := TObjectList.Create;
    GarbageCollector.Add(SynLogFamily);
  end;
  fIdent := SynLogFamily.Add(self);
  fDestinationPath := ExtractFilePath(paramstr(0));
  fBufferSize := 4096;
  fStackTraceLevel := 20;
  fExceptionIgnore := TList.Create;
end;

function TSynLogFamily.CreateSynLog: TSynLog;
begin
  result := fSynLogClass.Create(self);
  if fPerThreadLog then begin
    if SynLogFile=nil then begin
................................................................................
  AutoFlushThread: THandle = 0;
  AutoFlushSecondElapsed: cardinal;

procedure AutoFlushProc(P: pointer); stdcall;  // TThread not needed here
var i: integer;
begin
  repeat
    Sleep(1000); // thread will awake every second to check of pending data 
    if SynLogFile=nil then
      continue;
    inc(AutoFlushSecondElapsed);
    for i := 0 to SynLogFile.Count-1 do
    with TSynLog(SynLogFile.List^[i]) do
      if (fFamily.fAutoFlush<>0) and (fWriter<>nil) and
         (AutoFlushSecondElapsed mod fFamily.fAutoFlush=0) then
        if fWriter.B-fWriter.fTempBuf>1 then begin
          if not IsMultiThread and
             not fWriterStream.InheritsFrom(TFileStream) then
            IsMultiThread := true; // only TFileStream is thread-safe
          Flush(false); // write pending data
        end;
  until false;
end;

procedure TSynLogFamily.SetAutoFlush(TimeOut: cardinal);
var ID: cardinal;
begin
  SynLog.CreateLocker;
  fAutoFlush := TimeOut;
  if (AutoFlushThread=0) and (TimeOut<>0) then begin
    AutoFlushSecondElapsed := 0;
    AutoFlushThread := CreateThread(nil,0,@AutoFlushProc,nil,0,ID);
  end;
end;

destructor TSynLogFamily.Destroy;
begin
  FreeAndNil(fGlobalLog);
  if AutoFlushThread<>0 then begin
    CloseHandle(AutoFlushThread); // release background thread once for all
    AutoFlushThread := 0;
  end;
  FreeAndNil(fExceptionIgnore);
  inherited;
end;

function TSynLogFamily.SynLog: TSynLog;
var ndx: integer;
begin
  if fPerThreadLog then begin
................................................................................
    ndx := SynLogFileIndex[fIdent]-1;
    if ndx>=0 then
      result := SynLogFile.List^[ndx] else
      result := CreateSynLog;
  end else
    if fGlobalLog<>nil then
      result := fGlobalLog else
      result := CreateSynLog;
  if fHandleExceptions then
    CurrentHandleExceptionSynLog := result;
end;


{ TSynLog }

................................................................................
  inc(fRecursionCount);
  result := fRecursionCount;
end;

function TSynLog._Release: Integer;
begin
  dec(fRecursionCount);
  if sllLeave in fFamily.Level then begin
    asm
      mov eax,self
      mov ecx,[ebp+16]
      mov TSynLog.fRecursionCaller[eax],ecx
    end;
    fRecursion^[fRecursionCount].Caller := fRecursionCaller;
    DoEnterLeave(sllLeave);
  end;
  result := fRecursionCount;
end;

constructor TSynLog.Create(aFamily: TSynLogFamily);
begin
  fFamily := aFamily;
end;
................................................................................
begin
  inc(fRecursionMax,256+fRecursionMax shr 3);
  ReallocMem(fRecursion,fRecursionMax*sizeof(fRecursion^[0]));
end;

class function TSynLog.Enter(aClassType: TClass; aMethodName: PUTF8Char): ISynLog;
var aSynLog: TSynLog;
    aStackFrame: PtrUInt;
begin
  asm
    mov eax,[ebp+4]  // retrieve caller EIP from push ebp; mov ebp,esp
    sub eax,5        // ignore call TSynLog.Enter op codes
    mov aStackFrame,eax
  end;
  aSynLog := Family.SynLog;
  with aSynLog do begin
    // recursively store parameters
    if fRecursionCount=fRecursionMax then
      RecursionGrow;
    with fRecursion^[fRecursionCount] do begin
      Instance := nil;
      ClassType := aClassType;
      Method := aMethodName;
      Caller := aStackFrame;
    end;
  end;
  // copy to ISynLog interface -> will call TSynLog._AddRef
  result := aSynLog;
end;

class function TSynLog.Enter(aInstance: TObject; aMethodName: PUTF8Char): ISynLog;
var aSynLog: TSynLog;
    aFamily: TSynLogFamily;
    aStackFrame: PtrUInt;
begin
  asm
    mov eax,[ebp+4]  // retrieve caller EIP from push ebp; mov ebp,esp
    sub eax,5        // ignore call TSynLog.Enter op codes
    mov aStackFrame,eax
  end;
  // inlined aSynLog := Family.SynLog
  aFamily := PPointer(PtrInt(Self)+vmtAutoTable)^;
  if aFamily=nil then
    aSynLog := FamilyCreate.SynLog else
    aSynLog := aFamily.SynLog;
  // recursively store parameters
  with aSynLog do begin
................................................................................
      RecursionGrow;
    with fRecursion^[fRecursionCount] do begin
      Instance := aInstance;
      if aInstance=nil then
        ClassType := pointer(aInstance) else
        ClassType := PPointer(aInstance)^;
      Method := aMethodName;
      Caller := aStackFrame;
    end;
  end;
  // copy to ISynLog interface -> will call TSynLog._AddRef
  result := aSynLog;
end;

class function TSynLog.FamilyCreate: TSynLogFamily;
................................................................................

procedure TSynLog.Log(Level: TSynLogInfo; aName: PWinAnsiChar;
  aTypeInfo: pointer; var aValue);
begin
  if Level in fFamily.fLevel then
    LogInternal(Level,aName,aTypeInfo,aValue);
end;

procedure TSynLog.Log(Level: TSynLogInfo);
var aCaller: PtrUInt;
begin
  if Level in fFamily.fLevel then begin
    LogHeaderLock(Level);
    asm
      mov eax,[ebp+4]  // retrieve caller EIP from push ebp; mov ebp,esp
      sub eax,5        // ignore call TSynLog.Enter op codes
      mov aCaller,eax
    end;
    TSynMapFile.Log(fWriter,aCaller);
    fWriter.AddCR;
    UnLock;
  end;
end;

procedure TSynLog.LogFileHeader;
var Freq: Int64;
begin
  QueryPerformanceFrequency(Freq);
  ExeVersionRetrieve;
  with ExeVersion, SystemInfo, OSVersionInfo do
................................................................................
procedure TSynLog.CreateLogWriter;
begin
  if fWriterStream=nil then begin
    ExeVersionRetrieve;
    fFileName := string(ExeVersion.ProgramName)+' '+GetCaptionFromClass(ClassType)+' '+
      TFileName(NowToString(false));
    if fFamily.PerThreadLog then
      fFileName := fFileName+' '+IntToString(GetCurrentThreadId);
    fFileName := fFamily.fDestinationPath+fFileName+'.log';
    fWriterStream := TFileStream.Create(fFileName,fmCreate)
  end;
  if fWriter=nil then
    fWriter := TTextWriter.Create(fWriterStream,fFamily.BufferSize);
end;

................................................................................
      if Instance<>nil then begin
        fWriter.Add('(');
        fWriter.AddPointer(PtrUInt(Instance));
        fWriter.Add(')');
      end;
      fWriter.Add('.');
    end;
    if Method<>nil then
      fWriter.AddNoJSONEscape(Method) else
      TSynMapFile.Log(fWriter,Caller);
  end;
  fWriter.AddCR;
end;

procedure TSynLog.DoEnterLeave(aLevel: TSynLogInfo);
begin
  LogHeaderLock(aLevel);

var
  TestLevel: TOrdType = high(TOrdType);

procedure TTestCompression.TestLog;
var ILog: ISynLog;
    S: TSQLFieldTypes;
begin
  ILog := TSQLLog.Enter(self,'TestLog');
  // do some stuff

  ILog.Log(sllInfo,'TestLevel',TypeInfo(TOrdType),TestLevel);
  ILog.Log(sllInfo,'set',TypeInfo(TSQLFieldTypes),S);
  ILog.Log(sllDebug,ILog.Instance);
  if TestLevel=low(TOrdType) then
    TTestCompression(nil).ClassName; // will raise an access violation
  dec(TestLevel);
  TestLog;
end;










{ TTestCryptographicRoutines }

procedure TTestCryptographicRoutines.Adler32;
begin
  Check(Adler32SelfTest);
................................................................................
      StandardFontsReplace := embed;
      AddPage;
      Canvas.SetFont('arial',10,[]);
      Check(Canvas.Page.Font.Name=Name[embed]);
      y := 800;
      for i := 1 to 30 do begin
        Canvas.SetFont('Arial',9+i,[]);
        Canvas.TextOut(100,y,WinAnsiString('Texte accentu'#233' n�'+IntToStr(i)));
        dec(y,9+i);
      end;
      SaveToStream(MS,Date);
      // MS.SaveToFile(ChangeFileExt(paramstr(0),'.pdf'));
      Check(Hash32(MS.Memory,MS.Position)=Hash[embed]);
      if not embed then begin
        NewDoc;
................................................................................
  finally
    Free;
    MS.Free;
  end;
end;
{$endif}





begin










  if false then begin










    AllocConsole;
    with TSQLLog.Family do begin
      Level := LOG_VERBOSE;
      //Level := [sllException];
      PerThreadLog := true;
      HighResolutionTimeStamp := true;
      AutoFlushTimeOut := 5;
    end;
    with TTestCompression.Create(nil) do
    try
      try
        TestLog;

      except
        on Exception do; // just ignore now

      end;
    finally
      Free;
    end;
    TSQLLog.Add.Log(sllDebug,'GarbageCollector',GarbageCollector);
    TSQLLog.Add.Log(sllDebug,GarbageCollector);
    TSynLog.Family.Level := [sllDebug];
    TSynLog.Add.Log(sllDebug,GarbageCollector);



    try
      raise ECrtSocket.Create('Test exception',-1024);


    except
      on Exception do; // just ignore now
    end;



















    halt;
  end;




end.

var
  TestLevel: TOrdType = high(TOrdType);

procedure TTestCompression.TestLog;
var ILog: ISynLog;
    S: TSQLFieldTypes;
begin
  ILog := TSQLLog.Enter(self);
  // do some stuff
  ILog.Log(sllCustom1);
  ILog.Log(sllInfo,'TestLevel',TypeInfo(TOrdType),TestLevel);
  ILog.Log(sllInfo,'set',TypeInfo(TSQLFieldTypes),S);
  ILog.Log(sllDebug,ILog.Instance);
  if TestLevel=low(TOrdType) then
    TTestCompression(nil).ClassName; // will raise an access violation
  dec(TestLevel);
  TestLog;
end;

procedure TestLogProc;
var ILog: ISynLog;
begin
  ILog := TSQLLog.Enter;
  ILog.Log(sllDebug,'GarbageCollector',GarbageCollector);
  ILog.Log(sllDebug,GarbageCollector);
end;


{ TTestCryptographicRoutines }

procedure TTestCryptographicRoutines.Adler32;
begin
  Check(Adler32SelfTest);
................................................................................
      StandardFontsReplace := embed;
      AddPage;
      Canvas.SetFont('arial',10,[]);
      Check(Canvas.Page.Font.Name=Name[embed]);
      y := 800;
      for i := 1 to 30 do begin
        Canvas.SetFont('Arial',9+i,[]);
        Canvas.TextOut(100,y,WinAnsiString('Texte accentu'#233' n�'+IntToString(i)));
        dec(y,9+i);
      end;
      SaveToStream(MS,Date);
      // MS.SaveToFile(ChangeFileExt(paramstr(0),'.pdf'));
      Check(Hash32(MS.Memory,MS.Position)=Hash[embed]);
      if not embed then begin
        NewDoc;
................................................................................
  finally
    Free;
    MS.Free;
  end;
end;
{$endif}


procedure TestsLog;
  procedure Proc2(n1, n2: Integer); forward;
  procedure Proc1(n1, n2: Integer);
  begin
    if n1 = 0 then
    try
      asm xor eax,eax; mov [eax],eax; end; // AV
    except
      on e: exception do
        TSQLLog.Add.Log(sllInfo,'^^^^^^^^ recursicve, Proc1 function',e);
    end else
    Proc2(n1 - 1, n2);
  end;
  procedure Proc2(n1, n2: Integer);
  begin
    if n2 = 0 then
      try
        asm xor eax,eax; mov [eax],eax; end; // AV
      except
        on e: exception do
          TSQLLog.Add.Log(sllInfo,'^^^^^^^^ recursicve, Proc2 function',e);
      end else
      Proc1(n1, n2 - 1);
  end;
begin
  AllocConsole;
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    //Level := [sllException];
    PerThreadLog := true;
    HighResolutionTimeStamp := true;
    //AutoFlushTimeOut := 5;
  end;

  try


    writeln(IOResult div IOResult); // will raise EDivByZero
  except
    on e: exception do
      TSQLLog.Add.Log(sllInfo,'^^^^^^^^ the first sample, divide by 0',e);
  end;







  Proc1(5, 7);
  Proc2(7, 5);
  with TTestCompression.Create(nil) do
  try

    try
      TestLog;
    except
      on Exception do; // just ignore now
    end;
  finally
    Free;
  end;
  TestLogProc;
  TSynLog.Family.Level := [sllDebug];
  TSynLog.Add.Log(sllDebug,GarbageCollector);
  try
    raise ECrtSocket.Create('Test exception',-1024); // logged to TSQLLog
  except
    on e: Exception do
      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  custom exception type',e);
  end;
  TSQLLog.Family.ExceptionIgnore.Add(ECrtSocket);
  try
    raise ECrtSocket.Create('Test exception',-1024);
  except
    on e: Exception do
      TSQLLog.Add.Log(sllInfo,'^^^^^^^^  nothing should be logged just above',e);
  end;
  halt;
end;

begin
  if false then
    TestsLog;
end.