- associated TSQLRestServer.CacheFlush service for flushing the Server cache,
      and remote TSQLRestClientURI.ServerCacheFlush() method for the client
    - fixed issue in TSQLRecord.FillPrepare when the table has less columns
      that the filling TSQLTable (can occur e.g. when using aCustomFieldsCSV
      parameter in FillPrepare method)
    - EngineList methods (including TSQLRestServerStaticInMemory class) now
      handles an optional integer pointer, to return the count of row data




    - fix issue about missing last item in JSONToObject() function
    - fix issue when handling null JSON objects in GetJSONObjectAsSQL() function
    - fix issue about record locking in TSQLRestClientURI.Retrieve method
    - fix issue about abusive session timeout: TSQLRestServer.SessionGet is now
      renamed SessionAccess and refreshes the session access timestamp each time
      a session is retrieved
    - fix issue in SetInt64Prop() procedure which failed the update of a property
................................................................................

  /// set of available SQL field property types
  TSQLFieldTypes = set of TSQLFieldType;

  //// a fixed array of SQL field property types
  TSQLFieldTypeArray = array[0..MAX_SQLFIELDS] of TSQLFieldType;

  /// used to define how to convert some UTF-8 encoded text into the current
  // generic string type
  // - return either code page + AnsiString for Delphi 2 to 2007,
  // either UnicodeString for Delphi 2009/2010/XE
  // - this event will mostly point to the Language.UTF8ToString method
  // of the SQlite3i18n unit
  TUTF8ToStringEvent = function(const Text: RawUTF8): string of object;

  /// contains the parameters used for sorting
  // - FieldCount is 0 if was never sorted
  // - used to sort data again after a successfull data update with TSQLTableJSON.FillFrom()
  TSQLTableSortParams = record
    FieldCount, FieldIndex: integer;
    FieldType: TSQLFieldType;
    Asc: boolean;
................................................................................
    {{ read-only access to a particular field value, as a Variant
     - will try to use the most approriate Variant type for conversion (will
       use e.g. TDateTime for sftDateTime or sftTimeLog, Extended for sftFloat...)
     - will handle any necessary conversion to VCL string text, ready to be displayed
     - the global UTF8ToString() function will be used for the conversion:
     for proper i18n handling before Delphi 2009, you should use the
     overloaded method with aUTF8ToString=Language.UTF8ToString }
    function GetVariant(Row,Field: integer; Client: TObject;
      aUTF8ToString: TUTF8ToStringEvent=nil): variant;
    {$endif}
    {{ read-only access to a particular field value, as VCL string text
     - the global UTF8ToString() function will be used for the conversion:
     for proper i18n handling before Delphi 2009, you should use the
     overloaded method with aUTF8ToString=Language.UTF8ToString }
    function GetString(Row,Field: integer): string; overload;
    {{ read-only access to a particular field value, as VCL string text
     - aUTF8ToString parameter should be set to Language.UTF8ToString for proper
       i18n handling with Delphi versions prior to Delphi 2009; the default
       global UTF8ToString() function will be used if no event is defined }
    function GetString(Row,Field: integer; aUTF8ToString: TUTF8ToStringEvent): string; overload;
    {{ fill a unicode buffer with a particular field value
      - return number of wide characters written in Dest^ }
    function GetWP(Row,Field: integer; Dest: PWideChar; MaxDestChars: cardinal): integer;
    {{ read-only access to a particular field value, as UTF-16 Unicode text
      - Raw Unicode is WideChar(zero) terminated
      - its content is allocated to contain all WideChars (not trimed to 255,
       like GetWP() above }
................................................................................
        ready to be displayed to the VCL, for sftEnumerate, sftTimeLog
        and sftRecord/sftID
     - returns '' as string Text, if text can by displayed directly
       with Get*() methods above
     - returns '' for other properties kind, if UTF8ToString is nil,
       or the ready to be displayed value if UTF8ToString event is set
       (to be used mostly with Language.UTF8ToString) }
    function ExpandAsString(Row,Field: integer; Client: TObject;
      out Text: string; aUTF8ToString: TUTF8ToStringEvent=nil): TSQLFieldType;
    {{ read-only access to a particular DateTime field value
     - expect SQLite3 TEXT field in ISO 8601 'YYYYMMDD hhmmss' or
      'YYYY-MM-DD hh:mm:ss' format }
    function GetDateTime(Row,Field: integer): TDateTime;
      {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}
    {{ read-only access to a particular TTimeLog field value
      - return the result as Iso8601.Text() Iso-8601 encoded text }
................................................................................
end;

function TSQLTable.GetS(Row, Field: integer): shortstring;
begin
  UTF8ToShortString(result,Get(Row,Field));
end;

function TSQLTable.GetString(Row, Field: integer; aUTF8ToString: TUTF8ToStringEvent): string;
{$ifndef UNICODE}
var P: PUTF8Char;
{$endif}
begin
  if Assigned(aUTF8ToString) then
    result := aUTF8ToString(GetU(Row,Field)) else
    {$ifdef UNICODE}
    result := UTF8DecodeToUnicodeString(Get(Row,Field),0);
    {$else} begin
      P := Get(Row,Field);
      result := UTF8DecodeToString(P,StrLen(P));
    end;
    {$endif}
end;

function TSQLTable.GetString(Row, Field: integer): string;
begin
  {$ifdef UNICODE}
  result := UTF8DecodeToUnicodeString(Get(Row,Field),0); // L=0 -> use StrLen
  {$else}
  result := UTF8ToString(GetU(Row,Field));

  {$endif}
end;

function TSQLTable.GetCaption(Row, Field: integer): string;
begin
  GetCaptionFromPCharLen(Get(Row,Field),result);
end;
................................................................................
  for result := 1 to RowCount do
    if UTF8IComp(Get(result,FieldIndex),pointer(aValue))=0 then
      exit;
  result := 0;
end;

{$ifdef USEVARIANTS}
function TSQLTable.GetVariant(Row, Field: integer; Client: TObject;
  aUTF8ToString: TUTF8ToStringEvent=nil): Variant;
var FT: TSQLFieldType;
    EnumType: PEnumType;
    err: integer;
    Value64: Int64;
    ValueRef: RecordRef absolute Value64;
    Value8601: Iso8601 absolute Value64;
    ValueCurrency: Currency absolute Value64;
................................................................................
    end;
    // err<>0 -> not an integer -> will be displayed with GetString()
  end;
  end;
  // sftBlob and sftMany are not handled
  // sftBlobRecord, sftBlobDynArray as binary string
  // sftObject as JSON serialization
  result := GetString(Row,Field,aUTF8ToString);
end;
{$endif}

function TSQLTable.ExpandAsString(Row, Field: integer; Client: TObject;
  out Text: string; aUTF8ToString: TUTF8ToStringEvent=nil): TSQLFieldType;
var EnumType: PEnumType;
    err: integer;
    Value: Int64;
    Ref: RecordRef absolute Value;
begin // Text was already forced to '' because was defined as "out" parameter
  if Row=0 then begin // Field Name
    result := sftUnknown;
................................................................................
          Text := {$ifdef UNICODE}Ansi7ToString{$endif}(Ref.Text(TSQLRest(Client).Model)) else
          result := sftUTF8Text; // display ID number if no table model
    end;
  end;
  end;
  if Text='' then
    // returns the value as text by default
    Text := GetString(Row,Field,aUTF8ToString);
end;

function TSQLTable.GetTimeLog(Row, Field: integer; Expanded: boolean;
  FirstTimeChar: AnsiChar): RawUTF8;
var Value: Iso8601;
begin
  Value.Value := GetInt64(Get(Row,Field));

    - associated TSQLRestServer.CacheFlush service for flushing the Server cache,
      and remote TSQLRestClientURI.ServerCacheFlush() method for the client
    - fixed issue in TSQLRecord.FillPrepare when the table has less columns
      that the filling TSQLTable (can occur e.g. when using aCustomFieldsCSV
      parameter in FillPrepare method)
    - EngineList methods (including TSQLRestServerStaticInMemory class) now
      handles an optional integer pointer, to return the count of row data
    - uses new generic TSynAnsiConvert classes for code page process: that is,
      SQLite3i18n S2U() and U2S() match the SynCommons StringToUTF8() and
      UTF8ToString() functions - therefore, the TUTF8ToStringEvent parameter is
      not useful any more
    - fix issue about missing last item in JSONToObject() function
    - fix issue when handling null JSON objects in GetJSONObjectAsSQL() function
    - fix issue about record locking in TSQLRestClientURI.Retrieve method
    - fix issue about abusive session timeout: TSQLRestServer.SessionGet is now
      renamed SessionAccess and refreshes the session access timestamp each time
      a session is retrieved
    - fix issue in SetInt64Prop() procedure which failed the update of a property
................................................................................

  /// set of available SQL field property types
  TSQLFieldTypes = set of TSQLFieldType;

  //// a fixed array of SQL field property types
  TSQLFieldTypeArray = array[0..MAX_SQLFIELDS] of TSQLFieldType;









  /// contains the parameters used for sorting
  // - FieldCount is 0 if was never sorted
  // - used to sort data again after a successfull data update with TSQLTableJSON.FillFrom()
  TSQLTableSortParams = record
    FieldCount, FieldIndex: integer;
    FieldType: TSQLFieldType;
    Asc: boolean;
................................................................................
    {{ read-only access to a particular field value, as a Variant
     - will try to use the most approriate Variant type for conversion (will
       use e.g. TDateTime for sftDateTime or sftTimeLog, Extended for sftFloat...)
     - will handle any necessary conversion to VCL string text, ready to be displayed
     - the global UTF8ToString() function will be used for the conversion:
     for proper i18n handling before Delphi 2009, you should use the
     overloaded method with aUTF8ToString=Language.UTF8ToString }
    function GetVariant(Row,Field: integer; Client: TObject): variant;

    {$endif}
    {{ read-only access to a particular field value, as VCL string text
     - the global UTF8ToString() function will be used for the conversion:
     for proper i18n handling before Delphi 2009, you should use the
     overloaded method with aUTF8ToString=Language.UTF8ToString }
    function GetString(Row,Field: integer): string; 





    {{ fill a unicode buffer with a particular field value
      - return number of wide characters written in Dest^ }
    function GetWP(Row,Field: integer; Dest: PWideChar; MaxDestChars: cardinal): integer;
    {{ read-only access to a particular field value, as UTF-16 Unicode text
      - Raw Unicode is WideChar(zero) terminated
      - its content is allocated to contain all WideChars (not trimed to 255,
       like GetWP() above }
................................................................................
        ready to be displayed to the VCL, for sftEnumerate, sftTimeLog
        and sftRecord/sftID
     - returns '' as string Text, if text can by displayed directly
       with Get*() methods above
     - returns '' for other properties kind, if UTF8ToString is nil,
       or the ready to be displayed value if UTF8ToString event is set
       (to be used mostly with Language.UTF8ToString) }
    function ExpandAsString(Row,Field: integer; Client: TObject; out Text: string): TSQLFieldType;

    {{ read-only access to a particular DateTime field value
     - expect SQLite3 TEXT field in ISO 8601 'YYYYMMDD hhmmss' or
      'YYYY-MM-DD hh:mm:ss' format }
    function GetDateTime(Row,Field: integer): TDateTime;
      {$ifdef PUREPASCAL} {$ifdef HASINLINE}inline;{$endif} {$endif}
    {{ read-only access to a particular TTimeLog field value
      - return the result as Iso8601.Text() Iso-8601 encoded text }
................................................................................
end;

function TSQLTable.GetS(Row, Field: integer): shortstring;
begin
  UTF8ToShortString(result,Get(Row,Field));
end;

function TSQLTable.GetString(Row, Field: integer): string;

var U: PUTF8Char;

begin





  U := Get(Row,Field);







  {$ifdef UNICODE}
  result := UTF8DecodeToUnicodeString(U,0); // L=0 -> use StrLen
  {$else}

  result := CurrentAnsiConvert.UTF8BufferToAnsi(U,StrLen(U));
  {$endif}
end;

function TSQLTable.GetCaption(Row, Field: integer): string;
begin
  GetCaptionFromPCharLen(Get(Row,Field),result);
end;
................................................................................
  for result := 1 to RowCount do
    if UTF8IComp(Get(result,FieldIndex),pointer(aValue))=0 then
      exit;
  result := 0;
end;

{$ifdef USEVARIANTS}
function TSQLTable.GetVariant(Row, Field: integer; Client: TObject): Variant;

var FT: TSQLFieldType;
    EnumType: PEnumType;
    err: integer;
    Value64: Int64;
    ValueRef: RecordRef absolute Value64;
    Value8601: Iso8601 absolute Value64;
    ValueCurrency: Currency absolute Value64;
................................................................................
    end;
    // err<>0 -> not an integer -> will be displayed with GetString()
  end;
  end;
  // sftBlob and sftMany are not handled
  // sftBlobRecord, sftBlobDynArray as binary string
  // sftObject as JSON serialization
  result := GetString(Row,Field);
end;
{$endif}

function TSQLTable.ExpandAsString(Row, Field: integer; Client: TObject;
  out Text: string): TSQLFieldType;
var EnumType: PEnumType;
    err: integer;
    Value: Int64;
    Ref: RecordRef absolute Value;
begin // Text was already forced to '' because was defined as "out" parameter
  if Row=0 then begin // Field Name
    result := sftUnknown;
................................................................................
          Text := {$ifdef UNICODE}Ansi7ToString{$endif}(Ref.Text(TSQLRest(Client).Model)) else
          result := sftUTF8Text; // display ID number if no table model
    end;
  end;
  end;
  if Text='' then
    // returns the value as text by default
    Text := GetString(Row,Field);
end;

function TSQLTable.GetTimeLog(Row, Field: integer; Expanded: boolean;
  FirstTimeChar: AnsiChar): RawUTF8;
var Value: Iso8601;
begin
  Value.Value := GetInt64(Get(Row,Field));

  Version 1.15
  - fixed an endless loop in TGDIPages.DrawTextAcrossCols when wrapping text
  - fixed an issue in TGDIPages.DrawTextAcrossCols when test is exported to pdf
    (wrong clipping region set)
  - if TGDIPages.WordWrapLeftCols=TRUE, won't wrap column headers

  Version 1.16

  - some minor fixes (e.g. preview landscape or keys for popup menu)
  - enhanced the print preview screen with a left-sided button bar


*)

interface
................................................................................

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

uses
{$ifndef USEPDFPRINTER}
  SynCommons,
  SynPdf,
{$endif}
  Windows, Messages, SysUtils, Classes, Contnrs,
{$ifdef GDIPLUSDRAW}
  SynGdiPlus,
{$endif}
  Graphics, Controls, Dialogs, Forms, StdCtrls,
................................................................................
  end;
  if PreviewForm<>nil then
    SetFocus; 
end;

procedure TGDIPages.InternalUnicodeString(const s: string;
  var PW: PWideChar; var PWLen: integer; size: PSize);
{$ifndef UNICODE}
{$ifndef USEPDFPRINTER}
var i: integer;
{$endif}
{$endif}
begin
  if Assigned(OnStringToUnicode) then begin
    fInternalUnicodeString := OnStringToUnicode(s);
    PW := pointer(fInternalUnicodeString);
    PWLen := length(fInternalUnicodeString) shr 1;
  end else begin

    {$ifdef UNICODE}
    PW := pointer(s); // under Delphi 2009/2010/XE, no conversion necessary :)
    PWLen := length(s);
    {$else}
    fInternalUnicodeString := ''; // so Setlength() below won't do any move()
    PWLen := length(S);
    SetLength(fInternalUnicodeString,PWLen*2+1); // +1 for last wide #0
    PW := Pointer(fInternalUnicodeString);
    {$ifndef USEPDFPRINTER}
    if GetACP<>1252 then begin
    {$endif}
      // low-level MBCS RTL function including last widechar #0
      PWLen := MultiByteToWideChar(GetACP, 0, Pointer(s), Length(s), PW, PWLen);
      PW[PWLen] := #0;
    {$ifndef USEPDFPRINTER}
    end else
      // fast WinAnsi conversion using a fixed table from SynCommons
      for i := 0 to PWLen do // includes S[length(s)+1]=#0 -> last widechar #0
        PWordArray(PW)[i] := WinAnsiTable[PByteArray(s)[i]];

    {$endif}

    {$endif}
  end;
  if size<>nil then
    GetTextExtentPoint32W(fCanvas.Handle,PW,PWLen,size^);
end;

procedure TGDIPages.PopupMenuPopup(Sender: TObject);

  Version 1.15
  - fixed an endless loop in TGDIPages.DrawTextAcrossCols when wrapping text
  - fixed an issue in TGDIPages.DrawTextAcrossCols when test is exported to pdf
    (wrong clipping region set)
  - if TGDIPages.WordWrapLeftCols=TRUE, won't wrap column headers

  Version 1.16
  - includes new TSynAnsiConvert classes for handling Ansi charsets
  - some minor fixes (e.g. preview landscape or keys for popup menu)
  - enhanced the print preview screen with a left-sided button bar


*)

interface
................................................................................

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

uses
{$ifndef USEPDFPRINTER}
  SynCommons, 
  SynPdf,
{$endif}
  Windows, Messages, SysUtils, Classes, Contnrs,
{$ifdef GDIPLUSDRAW}
  SynGdiPlus,
{$endif}
  Graphics, Controls, Dialogs, Forms, StdCtrls,
................................................................................
  end;
  if PreviewForm<>nil then
    SetFocus; 
end;

procedure TGDIPages.InternalUnicodeString(const s: string;
  var PW: PWideChar; var PWLen: integer; size: PSize);





begin
  if Assigned(OnStringToUnicode) then begin
    fInternalUnicodeString := OnStringToUnicode(s);
    PW := pointer(fInternalUnicodeString);
    PWLen := length(fInternalUnicodeString) shr 1;
  end else begin
    PWLen := length(s);
    {$ifdef UNICODE}
    PW := pointer(s); // under Delphi 2009/2010/XE, no conversion necessary :)

    {$else}


    SetString(fInternalUnicodeString,nil,PWLen*2+1); // +1 for last wide #0
    PW := Pointer(fInternalUnicodeString);
    {$ifdef USEPDFPRINTER}



    PWLen := MultiByteToWideChar(GetACP,0,Pointer(s),Length(s),PW,PWLen);


    {$else}



    PWLen := CurrentAnsiConvert.AnsiBufferToUnicode(PW,Pointer(s),length(s))-PW;
    {$endif}
    PW[PWLen] := #0;
    {$endif}
  end;
  if size<>nil then
    GetTextExtentPoint32W(fCanvas.Handle,PW,PWLen,size^);
end;

procedure TGDIPages.PopupMenuPopup(Sender: TObject);

/// Database-driven Office 2007 Toolbar
// - this unit is a part of the freeware Synopse SQLite3 database framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.15
unit SQLite3ToolBar;

interface

{

    This file is part of Synopse SQLite3 database framework.
................................................................................
    - now uses TSQLRecord.RecordProps instead of lowest level RTTI calls
    - by default, will use only VCL components to create the Ribbon; can use
      proprietary TMS component pack if USETMSPACK global conditional is defined

    Version 1.15
    - TSQLRibbon.AddToReport method can work with self=nil




}

uses
  Windows, Consts, Dialogs, ShellAPI,
  SysUtils, Forms, Classes, Messages, Graphics,
  ImgList, Controls, Grids, ExtCtrls, Menus,
{$ifdef USETMSPACK}
  AdvOfficePager, AdvToolBar, AdvGlowButton, AdvMenus, AdvShapeButton, AdvPreviewMenu,
  AdvToolBarStylers, AdvPreviewMenuStylers, AdvOfficePagerStylers,
  AdvOfficeStatusBarStylers, AdvPanel,
  TaskDialog, TaskDialogEx, GDIPicture,
{$else}
  StdCtrls, ComCtrls, SynTaskDialog, Buttons, CommCtrl,
................................................................................
    exit;
  PHint := nil;
  RibbonParams := GetParameter(aRecord.RecordClass);
  if RibbonParams<>nil then
    with RibbonParams^ do
      if EditFieldHintsToReport and (EditFieldHints<>nil) then
        PHint := pointer(LoadResString(EditFieldHints));
  result := Language.UTF8ToString(Client.MainFieldValue(
    aRecord.RecordClass,aRecord.ID,true));
  if WithTitle then begin
    aReport.DrawTitle(aRecord.CaptionName+' : '+result,true);
    aReport.NewHalfLine;
  end;
  OldWordWrapLeftCols := aReport.WordWrapLeftCols;
  aReport.WordWrapLeftCols := true; // automatic word wrap and #13 for next line
  aReport.AddColumns([ColWidthName,ColWidthValue]);
................................................................................
      Rep.Caption := aName;
      if not Rep.ExportPDF(aName,false) then
        exit;
    end else
    if SameText(ext,'.TXT') then begin
      for i := 0 to Rep.Pages.Count-1 do
        Content := Content+Rep.Pages[i]; // append content of every page
      with Language do  // export as ANSI text file, in the current code page
        if not FileFromString(UnicodeToAnsi(StringToUnicode(Content)),aName) then





          exit;
    end else
      exit; // invalid extension
    if OpenAfterCreation then
      ShellExecute(Application.DialogHandle,nil,pointer(aName),nil,nil,SW_SHOWNORMAL);
    result := aName; // mark success
  finally
................................................................................
      SetLength(ColWidth,Table.FieldCount);
      move(ColWidths[0],ColWidth[0],Table.FieldCount*4);
    end else
      Table.CalculateFieldLengthMean(ColWidth,true); // FromDisplay=true
    result.AddColumns(ColWidth);
    SetLength(ColText,Table.FieldCount);
    for F := 0 to Table.FieldCount-1 do
      Table.ExpandAsString(0,F,Client,ColText[F],Language.UTF8ToString);
    result.AddColumnHeaders(ColText,true,true); // true = with gray bottom line
    for R := 1 to Table.RowCount do
    if Marked[R] then begin
      for F := 0 to Table.FieldCount-1 do
        Table.ExpandAsString(R,F,Client,ColText[F],Language.UTF8ToString);
      result.DrawTextAcrossCols(ColText);
    end;
  end;
end;

procedure TSQLRibbon.CreateReport(aPageIndex: Integer);
var P: TSQLRibbonTab;
................................................................................
    SetLength(ColWidth,Table.FieldCount);
    move(ColWidths[0],ColWidth[0],Table.FieldCount*4);
  end else
    Table.CalculateFieldLengthMean(ColWidth,true); // FromDisplay=true
  aReport.AddColumns(ColWidth);
  SetLength(ColText,Table.FieldCount);
  for F := 0 to Table.FieldCount-1 do
    Table.ExpandAsString(0,F,aClient,ColText[F],Language.UTF8ToString);
  aReport.AddColumnHeaders(ColText,true,true); // true = with gray bottom line
  for R := 1 to Table.RowCount do begin
    for F := 0 to Table.FieldCount-1 do
      Table.ExpandAsString(R,F,aClient,ColText[F],Language.UTF8ToString);
    aReport.DrawTextAcrossCols(ColText);
  end;
end;


end.

/// Database-driven Office 2007 Toolbar
// - this unit is a part of the freeware Synopse SQLite3 database framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.16
unit SQLite3ToolBar;

interface

{

    This file is part of Synopse SQLite3 database framework.
................................................................................
    - now uses TSQLRecord.RecordProps instead of lowest level RTTI calls
    - by default, will use only VCL components to create the Ribbon; can use
      proprietary TMS component pack if USETMSPACK global conditional is defined

    Version 1.15
    - TSQLRibbon.AddToReport method can work with self=nil

    Version 1.16
    - includes new TSynAnsiConvert classes for handling Ansi charsets

}

uses
  Windows, Consts, Dialogs, ShellAPI,
  SysUtils, Forms, Classes, Messages, Graphics,
  ImgList, Controls, Grids, ExtCtrls, Menus, 
{$ifdef USETMSPACK}
  AdvOfficePager, AdvToolBar, AdvGlowButton, AdvMenus, AdvShapeButton, AdvPreviewMenu,
  AdvToolBarStylers, AdvPreviewMenuStylers, AdvOfficePagerStylers,
  AdvOfficeStatusBarStylers, AdvPanel,
  TaskDialog, TaskDialogEx, GDIPicture,
{$else}
  StdCtrls, ComCtrls, SynTaskDialog, Buttons, CommCtrl,
................................................................................
    exit;
  PHint := nil;
  RibbonParams := GetParameter(aRecord.RecordClass);
  if RibbonParams<>nil then
    with RibbonParams^ do
      if EditFieldHintsToReport and (EditFieldHints<>nil) then
        PHint := pointer(LoadResString(EditFieldHints));

  result := U2S(Client.MainFieldValue(aRecord.RecordClass,aRecord.ID,true));
  if WithTitle then begin
    aReport.DrawTitle(aRecord.CaptionName+' : '+result,true);
    aReport.NewHalfLine;
  end;
  OldWordWrapLeftCols := aReport.WordWrapLeftCols;
  aReport.WordWrapLeftCols := true; // automatic word wrap and #13 for next line
  aReport.AddColumns([ColWidthName,ColWidthValue]);
................................................................................
      Rep.Caption := aName;
      if not Rep.ExportPDF(aName,false) then
        exit;
    end else
    if SameText(ext,'.TXT') then begin
      for i := 0 to Rep.Pages.Count-1 do
        Content := Content+Rep.Pages[i]; // append content of every page
      // export as ANSI text file, in the current code page
        if not FileFromString(
          {$ifdef UNICODE}
          CurrentAnsiConvert.UnicodeBufferToAnsi(pointer(Content),length(Content))
          {$else}
          Content
          {$endif} ,aName) then
          exit;
    end else
      exit; // invalid extension
    if OpenAfterCreation then
      ShellExecute(Application.DialogHandle,nil,pointer(aName),nil,nil,SW_SHOWNORMAL);
    result := aName; // mark success
  finally
................................................................................
      SetLength(ColWidth,Table.FieldCount);
      move(ColWidths[0],ColWidth[0],Table.FieldCount*4);
    end else
      Table.CalculateFieldLengthMean(ColWidth,true); // FromDisplay=true
    result.AddColumns(ColWidth);
    SetLength(ColText,Table.FieldCount);
    for F := 0 to Table.FieldCount-1 do
      Table.ExpandAsString(0,F,Client,ColText[F]);
    result.AddColumnHeaders(ColText,true,true); // true = with gray bottom line
    for R := 1 to Table.RowCount do
    if Marked[R] then begin
      for F := 0 to Table.FieldCount-1 do
        Table.ExpandAsString(R,F,Client,ColText[F]);
      result.DrawTextAcrossCols(ColText);
    end;
  end;
end;

procedure TSQLRibbon.CreateReport(aPageIndex: Integer);
var P: TSQLRibbonTab;
................................................................................
    SetLength(ColWidth,Table.FieldCount);
    move(ColWidths[0],ColWidth[0],Table.FieldCount*4);
  end else
    Table.CalculateFieldLengthMean(ColWidth,true); // FromDisplay=true
  aReport.AddColumns(ColWidth);
  SetLength(ColText,Table.FieldCount);
  for F := 0 to Table.FieldCount-1 do
    Table.ExpandAsString(0,F,aClient,ColText[F]);
  aReport.AddColumnHeaders(ColText,true,true); // true = with gray bottom line
  for R := 1 to Table.RowCount do begin
    for F := 0 to Table.FieldCount-1 do
      Table.ExpandAsString(R,F,aClient,ColText[F]);
    aReport.DrawTextAcrossCols(ColText);
  end;
end;


end.

    - compatibility with Delphi XE2
    - new TSQLTableToGrid.SetFieldFixedWidth method
    - new TSQLTableToGrid.FieldTitleTruncatedNotShownAsHint property
    - fixed issue on TDrawGrid events when TSQLTableToGrid is destroyed

    Version 1.16
    - new FillStringGrid() function, ready to fill a regular TStringGrid


*)


interface

{$I Synopse.inc}
................................................................................
  end else
    // not first row: data 
    if (Button=mbRight) and (ssRight in Shift) and Assigned(OnRightClickCell) then
      OnRightClickCell(Table,ACol,ARow,X,Y) else
    if (ssCtrl in Shift) or (Button<>mbLeft) then begin
      if not Assigned(OnHintText) or
        not OnHintText(Table,ACol,ARow,Hint) then
        Table.ExpandAsString(ARow,ACol,Client,Hint,Language.UTF8ToString);
//    Hint := IntToStr(SelectedID);
      ShowHintString(Hint,ACol,ARow,4000);
    end else
    if (Button=mbLeft) and (ACol=0) and fMarkAllowed and (X<CheckBoxWidth+4) then begin
      if Marked[ARow] then // on click: invert current Marked[] checkbox state
        fMouseDownMarkedValue := markOff else
        fMouseDownMarkedValue := markOn;
................................................................................
begin
  result := '';
  if (self=nil) or (cardinal(Row)>cardinal(Table.RowCount)) or (Table.FieldCount<=0) then
    exit;
  for F := 0 to Table.FieldCount-1 do begin
    if (not Assigned(OnValueText)) or
       (not OnValueText(Table,F,Row,text)) then
      Table.ExpandAsString(Row,F,Client,Text,Language.UTF8ToString);
    i := pos(#13,Text); // trim multi-line text to first line
    if i>0 then
      SetLength(Text,i-1);
    if (F>0) and (text<>'') then
      text := ' '+text;
    result := result+text;
  end;

    - compatibility with Delphi XE2
    - new TSQLTableToGrid.SetFieldFixedWidth method
    - new TSQLTableToGrid.FieldTitleTruncatedNotShownAsHint property
    - fixed issue on TDrawGrid events when TSQLTableToGrid is destroyed

    Version 1.16
    - new FillStringGrid() function, ready to fill a regular TStringGrid
    - includes new TSynAnsiConvert classes for handling Ansi charsets

*)


interface

{$I Synopse.inc}
................................................................................
  end else
    // not first row: data 
    if (Button=mbRight) and (ssRight in Shift) and Assigned(OnRightClickCell) then
      OnRightClickCell(Table,ACol,ARow,X,Y) else
    if (ssCtrl in Shift) or (Button<>mbLeft) then begin
      if not Assigned(OnHintText) or
        not OnHintText(Table,ACol,ARow,Hint) then
        Table.ExpandAsString(ARow,ACol,Client,Hint);
//    Hint := IntToStr(SelectedID);
      ShowHintString(Hint,ACol,ARow,4000);
    end else
    if (Button=mbLeft) and (ACol=0) and fMarkAllowed and (X<CheckBoxWidth+4) then begin
      if Marked[ARow] then // on click: invert current Marked[] checkbox state
        fMouseDownMarkedValue := markOff else
        fMouseDownMarkedValue := markOn;
................................................................................
begin
  result := '';
  if (self=nil) or (cardinal(Row)>cardinal(Table.RowCount)) or (Table.FieldCount<=0) then
    exit;
  for F := 0 to Table.FieldCount-1 do begin
    if (not Assigned(OnValueText)) or
       (not OnValueText(Table,F,Row,text)) then
      Table.ExpandAsString(Row,F,Client,Text);
    i := pos(#13,Text); // trim multi-line text to first line
    if i>0 then
      SetLength(Text,i-1);
    if (F>0) and (text<>'') then
      text := ' '+text;
    result := result+text;
  end;

/// internationalization (i18n) routines and classes
// - this unit is a part of the freeware Synopse SQLite3 database framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.15
unit SQLite3i18n;

(*
    This file is part of Synopse SQLite3 database framework.

    Synopse SQLite3 database framework. Copyright (C) 2012 Arnaud Bouchez
      Synopse Informatique - http://synopse.info
................................................................................


    i18n routines for the Synopse SQLite3 database framework
   **********************************************************

   - works internaly with the string type, that is AnsiString with code pages
     and charsets for compiler versions earlier than Delphi 2009, and
     UnicodeString since Delphi 2009/2010 -> so it's 100% VCL compatible
   - can load language definition files encoded in Unicode or UTF8
   - auto-call SetThreadLocale() for full application i18n
   - update default locale settings values (date,currency..)
   - force english locale settings on non english system (consistent with UI)
   - handle multiple charsets (standard or custom VCL components compatible)
   - resourcestring on-the-fly translation
   - resourcestring access using fast cache, even without translation; use this
................................................................................
     i18nCompareStr/Text() is to be used instead
  0.2.1 bug found in i18nInnerCompareText()
  1.0 First public release of the Synopse SQLite3 Framework

  Version 1.1 - 14 January 2009:
    - allow to get rid of our Enhanced Runtime Library dependency if not available
      (e.g. for FPC or on cross-platform, or on Delphi version newer than Delphi 7)
    - attempt to reach Delphi 2009/2010 compilation (string=UnicodeString):
      the UNICODE conditional will adapt the framework to these compilers
      (you shouldn't have to change any conditinal define below
    - generic string type is now used for all i18n of text: in Delphi 2009/2010,
      it will be an UnicodeString, but with earlier version of Delphi,
      string is an AnsiString with the codepage of the current selected language
    - attempt to reach Free Pascal Compiler 2.4.0 compatibility
    - LoadResStringTranslate() and resourcestring caching are defined in the
      SQLite3Commons unit, if our Enhanced Run Time Library (or LVCL) is not used

  Version 1.2 - 18 January 2010
................................................................................
  Version 1.15
    - compatibility with Delphi XE2
    - fix endless recursion loop in ExtractAllResources for nested classes
    - several changes in ExtractAllResources implementation
    - handle TModTime published property / sftModTime SQL field
    - handle TCreateTime published property / sftCreateTime SQL field







*)

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

interface

{.$D-,L-}
................................................................................

{.$define EXTRACTALLRESOURCES}
// must be set globally for the whole application

{.$define ENHANCEDRTL}
{ define this if you DID install our Enhanced Runtime library: it has already
  hacked the "legacy" LoadResString() procedure and added a LoadResStringTranslate()
  - it will be unset automaticaly (see below) for Delphi 2009/2010, since
    no version of our Enhanced RTL exists for these compilers 
  - this conditional must be defined in both SQLite3Commons and SQLite3i18n units,
    or (even better) globally in the Project options }

{.$define USESHARP}
// if defined, $$,$$$,$$$ are replaced with some globals in _()

{$ifndef NOI18N}
// with this global define, you can use the unit procs, without the UI i18n
{$define USEFORMCREATEHOOK}
// if defined, all forms will be auto-translated, even 3rd party ones
// just before an OnCreate handler would be called
{$endif}

{$ifdef LVCL}
// the LVCL don't have TForm.DoCreate and such
// -> it's easier to explicitely change
{$undef USEFORMCREATEHOOK}
{$endif}

uses
  Windows, SysUtils, Classes,
  {$ifdef USEFORMCREATEHOOK}
  {$ifndef LVCL}
  Menus,
................................................................................
  {$endif USEFORMCREATEHOOK}
  StdCtrls, Forms,
  SynCommons,     // some basic types
  SQLite3Commons; // need extended RTTI information


{$ifdef UNICODE}
{$undef ENHANCEDRTL} // no version of our Enhanced RTL exists for Delphi 2009/2010
{$endif}

{$ifdef LVCL}
// LVCL system.pas doesn't implement LoadResStringTranslate() and won't need it
{$define ENHANCEDRTL}
{$endif}

................................................................................
    LCID: cardinal;
    /// initializes all TLanguage object fields for a specific language
    procedure Fill(Language: TLanguages);
    /// returns two-chars long language abreviation ('HE' e.g.)
    function Abr: RawByteString;
    /// returns fully qualified language name ('Hebrew' e.g.),
    // using current UI language
    // - return "string" type, i.e. UnicodeString for Delphi 2009/2010
    function Name: string;
  end;

var
  /// the global Language used by the User Interface,
  // as updated by the last SetCurrentLanguage() call
  CurrentLanguage: TLanguage = (
................................................................................
// change the current language in the registry
procedure i18nAddLanguageCombo(const MsgPath: TFileName; Combo: TComboBox);
{$endif}

/// save the default language to the registry
// - language will be changed at next startup
// - return a message ready to be displayed on the screen
// - return "string" type, i.e. UnicodeString for Delphi 2009/2010
function i18nLanguageToRegistry(const Language: TLanguages): string;

/// get the default language from the registry
function i18nRegistryToLanguage: TLanguages;

resourcestring
  /// this message will be displayed on the screen when the user change the
................................................................................
procedure SetCurrentLanguage(const value: RawUTF8); overload;
{$endif}
{$endif}

/// Return the language text, ready to be displayed (after translation if
// necessary)
// - e.g. LanguageName(lngEnglish)='English'
// - return "string" type, i.e. UnicodeString for Delphi 2009/2010
function LanguageName(aLanguage: TLanguages): string;

/// LanguageAbrToIndex('GR')=1, e.g.
// - return LANGUAGE_NONE if not found
function LanguageAbrToIndex(const value: RawUTF8): TLanguages; overload;

/// LanguageAbrToIndex('GR')=1, e.g.
................................................................................
  sharp2: string = '';
  sharp3: string = '';
{$endif}

/// translate the 'Text' term into current language, with no || nor $$[$[$]]
// - LoadResStringTranslate of our customized system.pas points to this procedure
// - therefore, direct use of LoadResStringTranslate() is better in apps
// - expect "string" type, i.e. UnicodeString for Delphi 2009/2010
procedure GetText(var Text: string);

/// translate the 'English' term into current language
// - you should use resourcestring instead of this function
// - call interenaly GetText() procedure, i.e. LoadResStringTranslate()
function _(const English: WinAnsiString): string;

(*
/// translate the 'English' term into current language, with || and $$[$[$]]
function _(const English: AnsiString; const Name: AnsiString = ''): AnsiString; overload;

/// find 'at' nth word in a list: _('A,B,C','idABC7',3) = 'C'
function _(const English, Name: AnsiString; at: integer): AnsiString; overload;
*)

/// get text File contents (even Unicode or UTF8) and convert it into a
// Charset-compatible AnsiString (for Delphi 7) or an UnicodeString (for Delphi
// 2009/2010)

// - by use of this function, the TLanguageFile.LoadFromFile() method is
// able to display any Unicode message into the 8 bit standard Delphi VCL,
// (for Delphi 2 to 2007) or with the new Unicode VCL (for Delphi 2009/2010)

function AnyTextFileToString(const FileName: TFileName; Lang: TLanguages): string;

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

/// Faster Equivalent of Delphi 7 StrUtils.PosEx
function PosEx(const SubStr, S: AnsiString; Offset: Cardinal = 1): Integer;}

var
  /// a table used for fast conversion to lowercase, according to the current language
  // - can NOT be used for MBCS strings (with such code pages, you should use windows
  // slow but accurate API)
  i18nToLower,
  /// a table used for fast conversion to uppercase, according to the current language
................................................................................
    reload the updated translations. }
  TLanguageFile = class
  protected
    /// the content of the .msg file, translated into generic VCL string
    // - [Messages] section is expanded into Messages TStringList (see below)
    // - for Forms translations: [FormName] sections, with Properties=UI Text pairs
    // - is either an AnsiString in the current code page, or an UnicodeString
    // (in case of Delphi 2009/2010, that is a UNICODE compiler)
    Text: string;
    /// copy of translated strings from [Messages] section
    // - Objects[] contain pointer(Hash32(WinAnsiEncodedMessage))
    // - Strings[] contain Message text, in UnicodeString for Delphi 2009/2010
    Messages: TStringList;
{$ifndef LVCL} { LVCL will use always the ISO 8601 generic text format }
    /// format string used to convert a date value to a text
    // - the expected format is the one used by the FormatDateTime() function
    // - the current system format, depending on the current language, is used,
    // then overriden by a DateFmt= entry in the .msg file content
    DateFmt: string;
................................................................................
    procedure LanguageClick(Sender: TObject);
{$endif USEFORMCREATEHOOK}
    /// get corresponding *.msg translation text file name from current exe directory
    // - e.g. return 'C:\Program Files\MyApplication\FR.msg' 
    class function FileName(aLanguageLocale: TLanguages): TFileName;
    /// return a translated text from a Hash32(WinAnsiString) value
    // - search is very fast (use binary search algorithm)
    // - return a generic VCL string (i.e. UnicodeString for Delphi 2009/2010)
    function FindMessage(Hash: cardinal): string;
  public
    /// identify the current language
    Language: TLanguage;
    /// specify a text file containing the translation messages for a language
    constructor Create(const aFileName: TFileName; aLanguageLocale: TLanguages); overload;
    /// load corresponding *.msg translation text file from the current exe directory
    constructor Create(aLanguageLocale: TLanguages); overload;
    /// free translation tables memory
    destructor Destroy; override;
    /// fill translation tables from text file containing the translation messages
    // - handle on the fly UTF-8 and UNICODE decode into the corresponding ANSI
    // CHARSET, or into UnicodeString for Delphi 2009/2010
    procedure LoadFromFile(const aFileName: TFileName);
    /// translate an English string into a localized string
    // - English is case-sensitive (same as standard gettext)
    // - translations are stored in Messages[] and Text properties
    // - expect parameter as generic VCL string (i.e. UnicodeString for Delphi 2009/2010)
    procedure Translate(var English: string);
    /// translate the english captions of a TForm into the current UI language
    // - must be called once with english captions
    // - call automaticaly if conditional USEFORMCREATEHOOK is defined
    procedure FormTranslateOne(aForm: TComponent);
{$ifndef USEFORMCREATEHOOK}
    procedure FormTranslate(Forms: array of TCustomForm);
{$endif USEFORMCREATEHOOK}
    /// read a parameter, stored in the .msg file before any [Section]
    function ReadParam(const ParamName: RawUTF8): string;
    /// convert any Ansi Text into an Unicode String
    // - use the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    // - internaly call MultiByteToWideChar() for accurate conversion
    function AnsiToUnicode(const AnsiText: AnsiString): RawUnicode;
    /// convert any Ansi Text into an UTF-8 encoded String
    // - use the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    // - internaly call MultiByteToWideChar() for accurate conversion
    function AnsiToUTF8(const AnsiText: AnsiString): RawUTF8;
    /// convert any UTF-8 encoded text into Ansi Text
    // - use the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    // - internaly call WideCharToMultiByte() for accurate conversion
    function UTF8ToAnsi(const Text: RawUTF8): AnsiString;
    /// convert any Unicode encoded text into Ansi Text
    // - use the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    // - internaly call WideCharToMultiByte() for accurate conversion
    function UnicodeToAnsi(const Text: RawUnicode): AnsiString;
    /// convert any generic VCL Text into an Unicode encoded String
    function StringToUnicode(const Text: string): RawUnicode;
      {$ifdef PUREPASCAL}{$ifdef FPC}inline{$endif}{$endif} {$ifdef UNICODE}inline;{$endif}
    /// convert any generic VCL Text into an UTF-8 encoded String
    function StringToUTF8(const Text: string): RawUTF8;
      {$ifdef FPC}inline{$endif} {$ifdef UNICODE}inline;{$endif}
{$ifdef UNICODE}
    /// convert any Ansi Text into the native Delphi unicode string
    // - convert into UnicodeString (for Delphi 2009/2010)
    // - not needed of course for Delphi 3 to 2007, since the AnsiText is to
    // be used as is in the VCL, with the appropriate code page and char set
    // - use the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    // - internaly call MultiByteToWideChar() for accurate conversion if necessary
    function AnsiToString(const AnsiText: AnsiString): UnicodeString;
{$endif}
    /// convert an UTF-8 encoded text into a VCL-ready string
    // - return a generic string, i.e. AnsiString with the proper code page
    // for Delphi 2 to 2007, or an UnicodeString for Delphi 2009/2010: this
    // result can be directly used by the VCL, regardless of the compiler version
    // - for AnsiString conversion (that is for Delphi 2 to 2007), this method
    // uses the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    // - this method can be affected to a TUTF8ToStringEvent event, for
    // on the fly UTF-8 to VCL text conversion (see example in SQLite3UI unit) 
    function UTF8ToString(const Text: RawUTF8): string;
      {$ifdef FPC}inline{$endif} {$ifdef UNICODE}inline;{$endif}
    /// convert an Unicode encoded text into a VCL-ready string
    // - return a generic string, i.e. AnsiString with the proper code page
    // for Delphi 2 to 2007, or an UnicodeString for Delphi 2009/2010: this
    // result can be directly used by the VCL, regardless of the compiler version
    // - for AnsiString conversion (that is for Delphi 2 to 2007), this method
    // uses the current Language.CodePage setting, or Win-Ansi (i.e. CODEPAGE_US=1252)
    // if this TLanguageFile instance is nil (i.e. no custom language set)
    function RawUnicodeToString(const Text: RawUnicode): string;
      {$ifdef FPC}inline{$endif} {$ifdef UNICODE}inline;{$endif}
    /// convert the supplied boolean constant into ready to be displayed text
    // - by default, returns 'No' for false, and 'Yes' for true
    // - returns the text as generic string type, ready to be used in the VCL
    function BooleanToString(Value: boolean): string;
    /// convert a TSQLRecord published property value into ready to be displayed text
    // - will convert any sftUTF8Text/sftAnsiText into ready to be displayed text
    // - will convert any sftInteger/sftFloat/sftCurrency into its textual value
................................................................................
    function TimeToText(const DateTime: TDateTime): string; overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert a time into a ready to be displayed text on the screen
    function TimeToText(const ISO: Iso8601): string; overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert a time into a ready to be displayed text on the screen
    function TimeToText(const Time: TTimeLog): string; overload; {$ifdef HASINLINE}inline;{$endif}
  end;


/// export the translation file into a .PO format
// - the .PO format is used by the GNU gettext tool, and allow to use some
// very usefull translation tools
// (see @http://www.gnu.org/software/hello/manual/gettext/PO-Files.html
// for documentation about the .PO format itself)
//  - the .PO is created from two .msg files, both contained in the SourceMsgPath
// directory: the original EN.msg file and the specified SourceLanguage.msg
// translated file; the resulting POFileName will be created for this language
// - if not SourceMsgPath is supplied, the current directory is used (not
// necessary the executable directory)
procedure POExport(const SourceMsgPath, POFileName: TFileName; SourceLanguage: TLanguages);


/// generic US/English date/time to VCL text conversion
// - not to be used in your programs: it's just here to allow inlining of
// TLanguageFile.DateTimeToText/DateToText/TimeToText
function DateTimeToIso(const DateTime: TDateTime; DateOnly: boolean): string;

var
................................................................................
{$endif}

{$ifndef ENHANCEDRTL}
/// our hooked procedure for reading a string resource
// - the default one in System.pas unit is replaced by this one
// - this function add caching and on the fly translation (if LoadResStringTranslate
// is defined in SQLite3Commons unit)
// - use "string" type, i.e. UnicodeString for Delphi 2009/2010
function LoadResString(ResStringRec: PResStringRec): string;
{$endif}


/// convert any generic VCL Text into an UTF-8 encoded String
// - wrapper to Language.StringToUTF8 method
function S2U(const Text: string): RawUTF8; {$ifdef UNICODE}inline;{$endif}


/// convert an UTF-8 encoded text into a VCL-ready string
// - wrapper to Language.UTF8ToString method

function U2S(const Text: RawUTF8): string; {$ifdef UNICODE}inline;{$endif}


/// convert a custom date/time into a VCL-ready string
// - this function must be assigned to i18nDateText global var of SQLite3Commons unit
// - wrapper to Language.DateTimeToText method
function Iso2S(Iso: TTimeLog): string;


implementation

uses
{$ifndef LVCL}
  ComCtrls,
  {$ifdef WITHUXTHEME}
................................................................................
function LanguageAbrToIndex(p: pAnsiChar): TLanguages; overload;
begin
  result := TLanguages(IntegerScanIndex(
    @LanguageAbrInteger[low(TLanguages)], ord(high(TLanguages))+1,
    NormToLowerByte[ord(p[0])]+NormToLowerByte[ord(p[1])] shl 8));
end;

(*
procedure ValAtPChar(pc: pAnsiChar; index: integer; charLimit: AnsiChar; var result: AnsiString);
var pdeb: pAnsiChar; // optimized asm
label s;
begin
  if pc=nil then
    exit;
  if index=0 then
    goto s; // goto is deprecated, but fast & easy in this code
  dec(index);
  while pc^<>#0 do begin
    if pc^=charLimit then begin
      if index=0 then begin
        inc(pc);
        if pc^=#10 then
          inc(pc); // ignore #10
s:      pdeb := pc;
        while (pc^<>#0) and (pc^<>charLimit) do
          inc(pc);
        SetString(result,pdeb,pc-pdeb);
        exit;
      end;
      dec(index);
    end;
    inc(pc);
  end;
end;

function ValAt(const value: AnsiString; index: integer; charLimit: AnsiChar = ','): AnsiString;
// ValAt('un,deux',1)='deux'
begin
  result := '';
  if index>=0 then
    ValAtPChar(pointer(value),index,charLimit,result);
end;


function PosEx(const SubStr, S: AnsiString; Offset: Cardinal = 1): Integer;
// Faster Equivalent of Delphi 7 StrUtils.PosEx
asm
  push    ebx
  push    esi
  push    edx              {@Str}
  test    eax, eax
  jz      @@NotFound       {Exit if SubStr = ''}
  test    edx, edx
  jz      @@NotFound       {Exit if Str = ''}
  mov     esi, ecx
  mov     ecx,[edx-4]     {Length(Str)}
  mov     ebx,[eax-4]     {Length(SubStr)}
  add     ecx, edx
  sub     ecx, ebx        {Max Start Pos for Full Match}
  lea     edx,[edx+esi-1] {Set Start Position}
  cmp     edx, ecx
  jg      @@NotFound       {StartPos > Max Start Pos}
  cmp     ebx, 1           {Length(SubStr)}
  jle     @@SingleChar     {Length(SubStr) <= 1}
  push    edi
  push    ebp
  lea     edi,[ebx-2]     {Length(SubStr) - 2}
  mov     esi, eax
  movzx   ebx,[eax]       {Search Character}
@@Loop:                    {Compare 2 Characters per Loop}
  cmp     bl,[edx]
  jne     @@NotChar1
  mov     ebp, edi         {Remainder}
@@Char1Loop:
  movzx   eax, word ptr [esi+ebp]
  cmp     ax,[edx+ebp]
  jne     @@NotChar1
  sub     ebp, 2
  jnc     @@Char1Loop
  pop     ebp
  pop     edi
  jmp     @@SetResult
@@NotChar1:
  cmp     bl,[edx+1]
  jne     @@NotChar2
  mov     ebp, edi         {Remainder}
@@Char2Loop:
  movzx   eax, word ptr [esi+ebp]
  cmp     ax,[edx+ebp+1]
  jne     @@NotChar2
  sub     ebp, 2
  jnc     @@Char2Loop
  pop     ebp
  pop     edi
  jmp     @@CheckResult
@@NotChar2:
  lea     edx,[edx+2]
  cmp     edx, ecx         {Next Start Position <= Max Start Position}
  jle     @@Loop
  pop     ebp
  pop     edi
  jmp     @@NotFound
@@SingleChar:
  jl      @@NotFound       {Needed for Zero-Length Non-NIL Strings}
  movzx   eax,[eax]       {Search Character}
@@CharLoop:
  cmp     al,[edx]
  je      @@SetResult
  cmp     al,[edx+1]
  je      @@CheckResult
  lea     edx,[edx+2]
  cmp     edx, ecx
  jle     @@CharLoop
@@NotFound:
  xor     eax, eax
  pop     edx
  pop     esi
  pop     ebx
  ret
@@CheckResult:             {Check within AnsiString}
  cmp     edx, ecx
  jge     @@NotFound
  add     edx, 1
@@SetResult:
  pop     ecx              {@Str}
  pop     esi
  pop     ebx
  neg     ecx
  lea     eax,[edx+ecx+1]
end;

function StringReplaceAll(const S, OldPattern, NewPattern: AnsiString): AnsiString;
// fast replacement of StringReplace(S, OldPattern, NewPattern,[rfReplaceAll]);
procedure Process(j: integer);
var i: integer;
begin
  Result := '';
  i := 1;
  repeat
    Result := Result+Copy(S,i,j-i)+NewPattern;
    i := j+length(OldPattern);
    j := PosEx(OldPattern, S, i);
    if j=0 then begin
      Result := Result+Copy(S, i, maxInt);
      break;
    end;
  until false;
end;
var j: integer;
begin
  j := Pos(OldPattern, S);
  if j=0 then
    result := S else
    Process(j);
end;

function _(const English, Name: AnsiString; at: integer): AnsiString; overload;
// find 'at' nth word in a list: _('A,B,C','sABC',3) = 'C'
begin
  result := ValAt(_(English,Name), at, ',');
end;

function _(const English: AnsiString; const Name: AnsiString = ''): AnsiString; overload;
// translate the 'English' term into current language (search Name in Translate)
//  $$->sharp $$$->sharp2 $$$$-sharp3 ||->#13#10
{$ifdef USESHARP}
var i, L: integer;
{$endif}
function Correct(p: pAnsiChar): integer;
var d: pAnsiChar;
begin
  result := 0; // not used ifndef USESHARP
  if p=nil then exit;
  d := p-1; // so result := p-d -> index as AnsiString
  repeat
    case p^ of // we search for pairs -> read only twice a char
    #0: exit;
{$ifdef USESHARP}
    '$': begin
      if result=0 then
        if p[-1]='$' then
          result := p-d-1 else
        if p[+1]='$' then
          result := p-d;
      inc(p,2);
    end;
{$endif}
    '|': begin
      if p[-1]='|' then
        pWord(p-1)^ := $0a0d else
      if p[+1]='|' then
        pWord(p)^ := $0a0d;
      inc(p,2);
    end;
    else
      if p[1]<>#0 then
        inc(p,2) else
        exit;
    end;
  until false;
end;
begin
  if Language=nil then
    result := English else begin
    if Name='' then
      result := Language.Translate(English) else
      result := Language.Translate(Name);
  end;
  if result='' then exit;
{$ifdef USESHARP}
  i := Correct(pointer(result));
  if (i=0) or (sharp='') then
    exit; // no $$* to replace
  repeat // replace all $$..
    delete(result,i,2);
    L := length(result);
    if (i<=L) and (result[i]='$') then             // $$$ ou $$$$
      if (i<L) and (result[i+1]='$') then begin   // $$$$ = sharp3
        delete(result,i,2); insert(sharp3,result,i);
        inc(i,length(sharp3));
      end
      else begin
        delete(result,i,1); insert(sharp2,result,i);
        inc(i,length(sharp2));
      end       // $$$ = sharp2
    else begin
      insert(sharp,result,i);
      inc(i,length(sharp));
    end;
    i := posEx('$$',result,i);
  until i=0;
{$else}
  Correct(pointer(result)); // only '||' -> #13#10
{$endif}
end;
*)

const
  // default character set for a specific language (for GUI i18n)
  // list taken from http://www.webheadstart.org/xhtml/encoding
  // see also http://msdn2.microsoft.com/en-us/library/ms776260.aspx
  // DEFAULT_CHARSET is set if not known -> Win32 will take care as default locale
  // ANSI_CHARSET is iso-8859-1, windows-1252
................................................................................
    Jump: byte;
    Offset: PtrInt;
  end;


{$ifndef ENHANCEDRTL}
// code below is extracted from our Extended System.pas unit, and
// use the generic string type (i.e. UnicodeString for Delphi 2009/2010)

const LoadResStringCacheSize = 512;
      // cache makes it faster, even more when using on the fly translations
      // 512 is a reasonnable value, never reached in practice

var CacheRes: array[0..LoadResStringCacheSize-1] of PResStringRec;
    CacheResValue: array of string;
................................................................................
  PatchPositionForm: PPatchEvent = nil;
  PatchFrame, OriginalFrame: TPatchEvent;
  PatchPositionFrame: PPatchEvent = nil;

procedure PatchCreate;
var ov: cardinal;
begin
  // hook TForm:
  PatchPositionForm := PPatchEvent(@THookedForm.DoCreate);
  OriginalForm := PatchPositionForm^;
  PatchForm.Jump := $E9; // Jmp opcode
  PatchForm.Offset := PtrInt(@THookedForm.HookedDoCreate)-PtrInt(PatchPositionForm)-5;
  if not VirtualProtect(PatchPositionForm, 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;
  PatchPositionForm^ := PatchForm; // enable Hook
  // hook TFrame:
  PatchPositionFrame := PPatchEvent(@TCustomFrame.Create);
  OriginalFrame := PatchPositionFrame^;
  PatchFrame.Jump := $E9; // Jmp opcode
  PatchFrame.Offset := PtrInt(@THookedFrame.Create)-PtrInt(PatchPositionFrame)-5;
  if not VirtualProtect(PatchPositionFrame, 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;
  PatchPositionFrame^ := PatchFrame; // enable Hook
................................................................................
    if GetThreadLocale<>LCID then // force locale settings if different
      if SetThreadLocale(LCID) then
        GetFormatSettings; // resets all locale-specific variables
{$ifdef UNICODE}
    SetMultiByteConversionCodePage(CodePage); // for default AnsiString handling
{$endif}
{$endif}

    for c := #0 to #255 do begin
      i18nToUpper[c] := c;
      i18nToLower[c] := c;
    end;
    CharUpperBuffA(i18nToUpper,256); // get values from current user locale
    CharLowerBuffA(i18nToLower,256);
    if not(CharSet in [GB2312_CHARSET,SHIFTJIS_CHARSET,HANGEUL_CHARSET,ARABIC_CHARSET]) and
................................................................................
  SetCurrentLanguage(LanguageAbrToIndex(value));
end;

function ProgramName: AnsiString;
var i: integer;
begin
  result := AnsiString(ExtractFileName(paramstr(0)));
  i := pos(RawUTF8('.'),RawUTF8(result));
  if i>0 then
    Setlength(result,i-1);
end;

{$ifdef USEFORMCREATEHOOK}

function i18nAddLanguageItems(MsgPath: TFileName; List: TStrings): integer;
................................................................................
{$ifdef USEFORMCREATEHOOK}
  if Language<>nil then
    PatchCreate; // only patch TForm and TFrame if not english
{$endif USEFORMCREATEHOOK}
end;
{$endif}


{ TLanguageFile }

function AnyTextFileToString(const FileName: TFileName; Lang: TLanguages): string;
// get text File contents (even Unicode or UTF8)
// - into Charset-compatible AnsiString for Delphi 2 to 2007
// - into a UnicodeString for Delphi 2009/2010
var CodePage: cardinal;
    unicode: RawUnicode;
    Len, L, LU: integer;
{$ifdef UNICODE}
    Tmp: RawByteString;
{$endif}

begin
  result := '';
  if FileExists(FileName) then
  with THeapMemoryStream.Create do
  try
    LoadFromFile(FileName);
    Len := Size;
    if Len<4 then
      exit;
    if Lang=LANGUAGE_NONE then
      CodePage := CODEPAGE_US else
      CodePage := CharSetToCodePage(LanguageCharSet[Lang]);
    if PWord(Memory)^=$FEFF then begin
      // Unicode text file:



      L := (integer(Len)-2) shr 1;  // calculate WideChar count
{$ifdef UNICODE}

      SetString(result,PWideChar(PtrInt(Memory)+2),L);
{$else}
      SetLength(result,L*4); // enough place
      SetLength(result, WideCharToMultiByte(CodePage, 0,
        pointer(PtrInt(Memory)+2), L, pointer(result), L*4, nil, nil));

{$endif}
     end else
    if (PWord(Memory)^=$BBEF) and (PAnsiChar(Memory)[2]=#$BF) then begin
      // UTF8 text file:
      LU := integer(Len)-3;
      SetLength(unicode,LU*2); // enough place for UTF-8 into Unicode conversion
      L := UTF8ToWideChar(pointer(unicode), pointer(PtrInt(Memory)+3), LU);
      if L>0 then begin
{$ifdef UNICODE}
        SetString(result,PWideChar(pointer(unicode)),L);
{$else} SetLength(result,L*4); // enough place
        SetLength(result, WideCharToMultiByte(CodePage, 0,
          pointer(unicode), L, pointer(result), L*4, nil, nil));
{$endif}
      end else
        result := '';
    end else begin
      // WinAnsi text file: assume file encoding is CodePage
{$ifdef UNICODE}
      SetString(tmp,PAnsiChar(Memory),Len);
      PWord(PtrInt(tmp)-12)^ := CodePage; // faster than SetCodePage()
      result := string(tmp); // lets the RTL do the conversion for us
{$else}





      SetString(result,PAnsiChar(Memory),Len);
(*      if CodePage<>CODEPAGE_US then begin
        // non ansi codepage: correct ambiguous chars
        // -> non CP-1252 languages should use UTF-8 or Unicode text encoding
        SetLength(unicode,Len*2);
        WinAnsiToUnicodeBuffer(result,pointer(unicode));
        // convert '�'->'c' e.g.
        SetLength(result, WideCharToMultiByte(CodePage, 0,
          pointer(unicode), Len, pointer(result), length(result), nil, nil));
      end; *)
{$endif}
    end;
  finally
    Free; // THeapMemoryStream
  end;
end;




constructor TLanguageFile.Create(aLanguageLocale: TLanguages);
// FR.msg, DE.msg, JP.msg files must be in the .exe directory
begin
  Create(FileName(aLanguageLocale),aLanguageLocale);
end;

constructor TLanguageFile.Create(const aFileName: TFileName; aLanguageLocale: TLanguages);
begin
  Language.Fill(aLanguageLocale);

  LoadFromFile(aFileName);
end;

destructor TLanguageFile.Destroy;
begin
  FreeAndNil(Messages);
  inherited;
end;

class function TLanguageFile.FileName(aLanguageLocale: TLanguages): TFileName;
begin
  if aLanguageLocale<>LANGUAGE_NONE then

    result := ExtractFilePath(paramstr(0))+TFileName(LanguageAbr[aLanguageLocale])+'.msg' else
    result := '';
end;

{$ifndef USEFORMCREATEHOOK}
procedure TLanguageFile.FormTranslate(Forms: array of TCustomForm);
var f: integer;
begin
................................................................................
    H := Messages.Count - 1;
    while L <= H do begin // use fast binary search algorithm
      I := (L + H) shr 1;
      V := cardinal(Messages.Objects[I]); // our custom Classes.pas unit is fast enough
      if V<Hash then
        L := I+1 else
        if V=Hash then begin
          result := Messages.Strings[I]; // UnicodeString on Delphi 2009/2010
          exit;
        end else
          H := I-1;
    end;
  end;
  result := '';
end;
................................................................................
  FreeAndNil(Messages);
  fBooleanToString[false] := B2SS[false];
  fBooleanToString[true] := B2SS[true];
  Text := '';
  if not FileExists(aFileName) then
    exit;
  // 1. read .msg file with appropriate UTF8 or Unicode conversion
  Text := AnyTextFileToString(aFileName,Language.Index); // appropriate conversion
  // 2. fill Translation[] and Messages[]
  Messages := TStringList.Create;
  P := pointer(Text);
{$ifdef UNICODE}
  if FindSectionFirstLineW(P,'MESSAGES]') then
  while (P<>nil) and (P^<>'[') do begin
    H := GetNextItemCardinalW(P,'=');
................................................................................
procedure TLanguageFile.Translate(var English: string);
// case-sensitive (same as standard gettext)
var result: string;
begin
  result := FindMessage(Hash32(
    // resourcestring are expected to be in English, that is WinAnsi encoded
    // before being hashed
    {$ifdef UNICODE}RawUnicodeToWinAnsi(pointer(English),length(English))
    {$else}English{$endif}));
  if result<>'' then
    English := result;
end;

procedure GetText(var Text: string);
// used for System.LoadResStringTranslate case-sensitive (same as standard gettext)
var Translated: string;
begin
  if Language<>nil then begin
    Translated := Language.FindMessage(Hash32(
      // resourcestring are expected to be in English, that is WinAnsi encoded
      // before being hashed
      {$ifdef UNICODE}RawUnicodeToWinAnsi(pointer(Text),length(Text))
      {$else}Text{$endif}));
    if Translated<>'' then
      Text := Translated;
  end;
end;

function _(const English: WinAnsiString): string;
begin
  if Language<>nil then begin
    result := Language.FindMessage(Hash32(English));
    if result='' then
      result := string(English);
  end else
    result := string(English);

end;

{$ifdef UNICODE}
function TLanguageFile.AnsiToString(const AnsiText: AnsiString): UnicodeString;
var tmp: RawUnicode;
begin
  tmp := AnsiToUnicode(AnsiText);
  SetString(result,PWideChar(pointer(tmp)),length(tmp)shr 1);
end;


{$endif}

{$ifdef UNICODE}
function TLanguageFile.StringToUnicode(const Text: string): RawUnicode;
begin
  SetString(result,PAnsiChar(pointer(Text)),length(Text)*2+1);
{$else}
{$ifdef PUREPASCAL}
function TLanguageFile.StringToUnicode(const Text: string): RawUnicode;
begin
  result := AnsiToUnicode(Text);
{$else}
function TLanguageFile.StringToUnicode(const Text: string): RawUnicode;
asm
  jmp AnsiToUnicode
{$endif}
{$endif}
end;

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

function S2U(const Text: string): RawUTF8;
begin
{$ifdef UNICODE}
  result := RawUnicodeToUtf8(PWideChar(pointer(Text)),length(Text));
{$else}
  result := RawUnicodeToUtf8(Language.AnsiToUnicode(Text));
{$endif}
end;

function U2S(const Text: RawUTF8): string;
begin
{$ifdef UNICODE}
  result := UTF8DecodeToUnicodeString(pointer(Text),length(Text));
{$else}
  // fast conversion using a temp RawUnicode
  result := Language.RawUnicodeToString(Utf8DecodeToRawUnicode(pointer(Text),length(Text)));
{$endif}
end;

function Iso2S(Iso: TTimeLog): string;
begin
  if Iso=0 then
    result := '' else
    result := Language.DateTimeToText(Iso);
end;

function TLanguageFile.AnsiToUnicode(const AnsiText: AnsiString): RawUnicode;
var CodePage: Cardinal;
    InputLength,
    OutputLength: Integer;
begin
  if self=nil then
    CodePage := CODEPAGE_US else
    CodePage := Language.CodePage;
  if CodePage=CP_UTF8 then        // CP_UTF8 not supported on Windows 95
    Result := Utf8DecodeToRawUnicode(RawUTF8(AnsiText)) else
  if CodePage=CODEPAGE_US then    // fast integrated CODEPAGE_US conversion
    Result := WinAnsiToRawUnicode(WinAnsiString(AnsiText)) else begin
    // compute result length
    InputLength := Length(AnsiText);
    OutputLength := MultiByteToWideChar(CodePage, 0, pointer(AnsiText), InputLength, nil, 0);
    // make conversion
    Result := ''; // somewhat faster if memory is released before SetLength()
    SetLength(Result, OutputLength*2+1); // +1 = space for last WideChar(#0)
    MultiByteToWideChar(CodePage, 0, pointer(AnsiText), InputLength, pointer(Result), OutputLength);
    PWordArray(pointer(Result))^[OutputLength] := 0; // set last WideChar to #0
{$ifdef UNICODE}
    PWord(PtrInt(result)-12)^ := 1200; // use only SetLength() -> force set code page
{$endif}
  end;
end;

function TLanguageFile.AnsiToUTF8(const AnsiText: AnsiString): RawUTF8;
begin  // fast conversion using a temp RawUnicode 
  result := RawUnicodeToUtf8(AnsiToUnicode(AnsiText));
end;

function TLanguageFile.UTF8ToString(const Text: RawUTF8): string;
{$ifdef UNICODE}
begin
  result := UTF8DecodeToUnicodeString(pointer(Text),length(Text));
end;
{$else}
begin  // fast conversion using a temp RawUnicode 
  result := RawUnicodeToString(Utf8DecodeToRawUnicode(pointer(Text),length(Text)));
end;
{$endif}

{$ifdef UNICODE}
function TLanguageFile.RawUnicodeToString(const Text: RawUnicode): string;
begin
  SetString(result,PWideChar(pointer(Text)),length(Text)shr 1);
end;
{$else}
function TLanguageFile.RawUnicodeToString(const Text: RawUnicode): string;
begin
  result := UnicodeToAnsi(Text);
end;
{$endif}

function TLanguageFile.UTF8ToAnsi(const Text: RawUTF8): AnsiString;
begin
  result := UnicodeToAnsi(Utf8DecodeToRawUnicode(pointer(Text),length(Text)));
end;

function TLanguageFile.BooleanToString(Value: boolean): string;
begin
  if self=nil then
    result := B2SS[Value] else begin
    result := fBooleanToString[Value];
    if result='' then
      result := B2SS[Value];
................................................................................
begin
{$ifndef LVCL}if Self=nil then{$endif}
    result := DateTimeToIso(Iso8601(Time).ToTime,false)
{$ifndef LVCL} else
    DateTimeToString(Result, TimeFmt, Iso8601(Time).ToTime);
{$endif}
end;

function TLanguageFile.UnicodeToAnsi(const Text: RawUnicode): AnsiString;
var WideCharCount: integer;
    CodePage: cardinal;
begin
  result := '';
  if Text='' then
    exit;
  if self=nil then
    CodePage := CODEPAGE_US else
    CodePage := Language.CodePage;
  WideCharCount := length(Text) shr 1;
  if CodePage=CODEPAGE_US then begin // fast internal conversion
    SetLength(result,WideCharCount);
    RawUnicodeToWinPChar(pointer(result),pointer(Text),WideCharCount);
  end else begin
    SetLength(result,WideCharCount*4); // enough place for MBCS result
    SetLength(result,WideCharToMultiByte(CodePage, 0, pointer(Text), WideCharCount,
      pointer(result), length(result), nil, nil)); // perform conversion
  end;
{$ifdef UNICODE}
  PWord(PtrInt(result)-12)^ := CodePage; // use only SetLength() -> force set code page
{$endif}
end;


procedure POExport(const SourceMsgPath, POFileName: TFileName; SourceLanguage: TLanguages);
var English, Source: TLanguageFile;
    SourceDir: TFileName;
    Dest: TFileStream;
    W: TTextWriter;
    i: integer;
    E: string;
................................................................................
  try
    W.AddLine('"Content-Type: text/plain; charset=UTF-8\n"'#13#10+
      '"Content-Transfer-Encoding: 8bit\n"'#13#10);
    for i := 0 to English.Messages.Count - 1 do begin
      E := English.Messages[i];
      Source.Translate(E);
      W.Add('msgid "%"'#13'msgstr"'#13#13, // #13 will be written as #13#10
        [English.StringToUTF8(StringReplace(English.Messages[i],#13#10,'"'#13#10'"',[rfReplaceAll])),
         Source.StringToUTF8(StringReplace(E,#13#10,'"'#13#10'"',[rfReplaceAll]))]);
    end;
  finally
    W.Free;
    Source.Free;
    English.Free;
    Dest.Free;
  end;
end;



{ TLanguage }

function TLanguage.Abr: RawByteString;
begin
  if Index=LANGUAGE_NONE then
    result := '' else
................................................................................
begin
  result := LanguageName(Index);
end;

{$ifdef EXTRACTALLRESOURCES}
var
  // expect english text, converted into WinAnsi before Hash32()
  // - Delphi 2009/2010 will do the implicit codepage conversion
  // (usefull for chars with unicode value >255, e.g. '�')
  CB_EnumStrings: TWinAnsiDynArray;
  /// number of items in CB_EnumStrings[]
  CB_EnumStringsCount: integer;
  // store the curently identified Hash32() of each english text
  CB_Enum: TDynArrayHashed;

................................................................................
// code below use the string generic type, which is prefered for the RTTI 
var F: ^Text absolute lparam;
    Reader: TReader;

  procedure ConvertObject(const ParentName, ObjectName: string);
    procedure ConvertValue(const PropName, LastPropName: string);
      procedure WriteProperty(const Value: WinAnsiString);
      // for Delphi 2009/2010, Value: string was converted into a WinAnsiString
      begin
        // ignore components which names begin with '_'
        if (PropName<>LastPropName) and (PropName<>'') then // PropName=Label1.Caption
          if PropName[1]='_' then // ignore _Copyright.Caption
            exit;
        // write value
        if (LastPropName='Caption') or (LastPropName='EditLabel.Caption') or
................................................................................
    ClassList: TList;

  procedure AddEnum(T: PEnumType);
  var index: integer;
  begin
    for index := T^.MinValue to T^.MaxValue do
      AddOnceDynArray(StringToWinAnsi(T^.GetCaption(index)));
      // for Delphi 2009/2010/XE: CaptionName converted into a WinAnsiString
  end;
  procedure AddClass(C: TClass);
  var i: integer;
      P: PPropInfo;
      CP: PClassProp;
  begin 
    if (C=nil) or (ClassList.IndexOf(C)>=0) then
................................................................................
    AddClass(C.ClassParent); // add parent properties first
    CP := InternalClassProp(C);
    if CP=nil then
      exit;
    P := @CP^.PropList;
    for i := 1 to CP^.PropCount do begin // add all field names
      AddOnceDynArray(StringToWinAnsi(TSQLRecord.CaptionName(@P^.ShortName)));
      // for Delphi 2009/2010/XE: CaptionName converted into a WinAnsiString
      with P^.PropType^^ do
      case Kind of
      tkClass:       // add contained objects
        AddClass(ClassType^.ClassType);
      tkEnumeration: // add enumeration values
        AddEnum(EnumBaseType);
      tkSet:
................................................................................
      if Objects[i].InheritsFrom(TSQLModel) then begin
        AddOnceDynArray('ID'); // ID property is never published, but always here
        // add custom captions for all tables of a database model
        with TSQLModel(Objects[i]) do
        for index := 0 to high(Tables) do
        with Tables[index] do begin // TSQLRecord.CaptionName() may be overriden 
          AddOnceDynArray(StringToWinAnsi(CaptionName(nil))); // add table name
          // for Delphi 2009/2010, CaptionName(): string will be converted into a WinAnsiString
          with InternalClassProp(Tables[index])^ do begin
            P := @PropList;
            for j := 1 to PropCount do begin // add all field names
              AddOnceDynArray(StringToWinAnsi(CaptionName(@P^.ShortName)));
              P := P^.Next;
            end;
          end;

/// internationalization (i18n) routines and classes
// - this unit is a part of the freeware Synopse SQLite3 database framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.16
unit SQLite3i18n;

(*
    This file is part of Synopse SQLite3 database framework.

    Synopse SQLite3 database framework. Copyright (C) 2012 Arnaud Bouchez
      Synopse Informatique - http://synopse.info
................................................................................


    i18n routines for the Synopse SQLite3 database framework
   **********************************************************

   - works internaly with the string type, that is AnsiString with code pages
     and charsets for compiler versions earlier than Delphi 2009, and
     UnicodeString since Delphi 2009 and up -> so it's 100% VCL compatible
   - can load language definition files encoded in Unicode or UTF8
   - auto-call SetThreadLocale() for full application i18n
   - update default locale settings values (date,currency..)
   - force english locale settings on non english system (consistent with UI)
   - handle multiple charsets (standard or custom VCL components compatible)
   - resourcestring on-the-fly translation
   - resourcestring access using fast cache, even without translation; use this
................................................................................
     i18nCompareStr/Text() is to be used instead
  0.2.1 bug found in i18nInnerCompareText()
  1.0 First public release of the Synopse SQLite3 Framework

  Version 1.1 - 14 January 2009:
    - allow to get rid of our Enhanced Runtime Library dependency if not available
      (e.g. for FPC or on cross-platform, or on Delphi version newer than Delphi 7)
    - attempt to reach Delphi 2009 and up compilation (string=UnicodeString):
      the UNICODE conditional will adapt the framework to these compilers
      (you shouldn't have to change any conditinal define below
    - generic string type is now used for all i18n of text: in Delphi 2009 and up,
      it will be an UnicodeString, but with earlier version of Delphi,
      string is an AnsiString with the codepage of the current selected language
    - attempt to reach Free Pascal Compiler 2.4.0 compatibility
    - LoadResStringTranslate() and resourcestring caching are defined in the
      SQLite3Commons unit, if our Enhanced Run Time Library (or LVCL) is not used

  Version 1.2 - 18 January 2010
................................................................................
  Version 1.15
    - compatibility with Delphi XE2
    - fix endless recursion loop in ExtractAllResources for nested classes
    - several changes in ExtractAllResources implementation
    - handle TModTime published property / sftModTime SQL field
    - handle TCreateTime published property / sftCreateTime SQL field

  Version 1.16
    - uses new generic TSynAnsiConvert classes for code page process: since
      TLanguageFile.Create() will set CurrentAnsiConvert global instance,
      applications should use CurrentAnsiConvert instead of previous
      TLanguageFile methods

*)

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

interface

{.$D-,L-}
................................................................................

{.$define EXTRACTALLRESOURCES}
// must be set globally for the whole application

{.$define ENHANCEDRTL}
{ define this if you DID install our Enhanced Runtime library: it has already
  hacked the "legacy" LoadResString() procedure and added a LoadResStringTranslate()
  - it will be unset automaticaly (see below) for Delphi 2009 and up, since
    no version of our Enhanced RTL exists for these compilers 
  - this conditional must be defined in both SQLite3Commons and SQLite3i18n units,
    or (even better) globally in the Project options }

{.$define USESHARP}
// if defined, $$,$$$,$$$ are replaced with some globals in _()

{$ifndef NOI18N}
  // with this global define, you can use the unit procs, without the UI i18n
  {$define USEFORMCREATEHOOK}
  // if defined, all forms will be auto-translated, even 3rd party ones
  // just before an OnCreate handler would be called
{$endif}

{$ifdef LVCL}
  // the LVCL don't have TForm.DoCreate and such
  // -> it's easier to explicitely change the captions from code in LVCL
  {$undef USEFORMCREATEHOOK}
{$endif}

uses
  Windows, SysUtils, Classes,
  {$ifdef USEFORMCREATEHOOK}
  {$ifndef LVCL}
  Menus,
................................................................................
  {$endif USEFORMCREATEHOOK}
  StdCtrls, Forms,
  SynCommons,     // some basic types
  SQLite3Commons; // need extended RTTI information


{$ifdef UNICODE}
{$undef ENHANCEDRTL} // no version of our Enhanced RTL exists for Delphi 2009 and up
{$endif}

{$ifdef LVCL}
// LVCL system.pas doesn't implement LoadResStringTranslate() and won't need it
{$define ENHANCEDRTL}
{$endif}

................................................................................
    LCID: cardinal;
    /// initializes all TLanguage object fields for a specific language
    procedure Fill(Language: TLanguages);
    /// returns two-chars long language abreviation ('HE' e.g.)
    function Abr: RawByteString;
    /// returns fully qualified language name ('Hebrew' e.g.),
    // using current UI language
    // - return "string" type, i.e. UnicodeString for Delphi 2009 and up
    function Name: string;
  end;

var
  /// the global Language used by the User Interface,
  // as updated by the last SetCurrentLanguage() call
  CurrentLanguage: TLanguage = (
................................................................................
// change the current language in the registry
procedure i18nAddLanguageCombo(const MsgPath: TFileName; Combo: TComboBox);
{$endif}

/// save the default language to the registry
// - language will be changed at next startup
// - return a message ready to be displayed on the screen
// - return "string" type, i.e. UnicodeString for Delphi 2009 and up
function i18nLanguageToRegistry(const Language: TLanguages): string;

/// get the default language from the registry
function i18nRegistryToLanguage: TLanguages;

resourcestring
  /// this message will be displayed on the screen when the user change the
................................................................................
procedure SetCurrentLanguage(const value: RawUTF8); overload;
{$endif}
{$endif}

/// Return the language text, ready to be displayed (after translation if
// necessary)
// - e.g. LanguageName(lngEnglish)='English'
// - return "string" type, i.e. UnicodeString for Delphi 2009 and up
function LanguageName(aLanguage: TLanguages): string;

/// LanguageAbrToIndex('GR')=1, e.g.
// - return LANGUAGE_NONE if not found
function LanguageAbrToIndex(const value: RawUTF8): TLanguages; overload;

/// LanguageAbrToIndex('GR')=1, e.g.
................................................................................
  sharp2: string = '';
  sharp3: string = '';
{$endif}

/// translate the 'Text' term into current language, with no || nor $$[$[$]]
// - LoadResStringTranslate of our customized system.pas points to this procedure
// - therefore, direct use of LoadResStringTranslate() is better in apps
// - expect "string" type, i.e. UnicodeString for Delphi 2009 and up
procedure GetText(var Text: string);

/// translate the 'English' term into current language
// - you should use resourcestring instead of this function
// - call interenaly GetText() procedure, i.e. LoadResStringTranslate()
function _(const English: WinAnsiString): string;









/// get text File contents (even Unicode or UTF8) and convert it into a
// Charset-compatible AnsiString (for Delphi 7) or an UnicodeString (for Delphi

// 2009 and up) according to any BOM marker at the beginning of the file
// - by use of this function, the TLanguageFile.LoadFromFile() method is
// able to display any Unicode message into the 8 bit standard Delphi VCL,
// (for Delphi 2 to 2007) or with the new Unicode VCL (for Delphi 2009 and up)
// - before Delphi 2009, the current string code page is used (i.e. CurrentAnsiConvert)
function AnyTextFileToString(const FileName: TFileName): string;







var
  /// a table used for fast conversion to lowercase, according to the current language
  // - can NOT be used for MBCS strings (with such code pages, you should use windows
  // slow but accurate API)
  i18nToLower,
  /// a table used for fast conversion to uppercase, according to the current language
................................................................................
    reload the updated translations. }
  TLanguageFile = class
  protected
    /// the content of the .msg file, translated into generic VCL string
    // - [Messages] section is expanded into Messages TStringList (see below)
    // - for Forms translations: [FormName] sections, with Properties=UI Text pairs
    // - is either an AnsiString in the current code page, or an UnicodeString
    // (in case of Delphi 2009 and up, that is a UNICODE compiler)
    Text: string;
    /// copy of translated strings from [Messages] section
    // - Objects[] contain pointer(Hash32(WinAnsiEncodedMessage))
    // - Strings[] contain Message text, in UnicodeString for Delphi 2009 and up
    Messages: TStringList;
{$ifndef LVCL} { LVCL will use always the ISO 8601 generic text format }
    /// format string used to convert a date value to a text
    // - the expected format is the one used by the FormatDateTime() function
    // - the current system format, depending on the current language, is used,
    // then overriden by a DateFmt= entry in the .msg file content
    DateFmt: string;
................................................................................
    procedure LanguageClick(Sender: TObject);
{$endif USEFORMCREATEHOOK}
    /// get corresponding *.msg translation text file name from current exe directory
    // - e.g. return 'C:\Program Files\MyApplication\FR.msg' 
    class function FileName(aLanguageLocale: TLanguages): TFileName;
    /// return a translated text from a Hash32(WinAnsiString) value
    // - search is very fast (use binary search algorithm)
    // - return a generic VCL string (i.e. UnicodeString for Delphi 2009 and up)
    function FindMessage(Hash: cardinal): string;
  public
    /// identify the current language
    Language: TLanguage;
    /// specify a text file containing the translation messages for a language
    constructor Create(const aFileName: TFileName; aLanguageLocale: TLanguages); overload;
    /// load corresponding *.msg translation text file from the current exe directory
    constructor Create(aLanguageLocale: TLanguages); overload;
    /// free translation tables memory
    destructor Destroy; override;
    /// fill translation tables from text file containing the translation messages
    // - handle on the fly UTF-8 and UNICODE decode into the corresponding ANSI
    // CHARSET, or into UnicodeString for Delphi 2009 and up
    procedure LoadFromFile(const aFileName: TFileName);
    /// translate an English string into a localized string
    // - English is case-sensitive (same as standard gettext)
    // - translations are stored in Messages[] and Text properties
    // - expect parameter as generic VCL string (i.e. UnicodeString for Delphi 2009 and up)
    procedure Translate(var English: string);
    /// translate the english captions of a TForm into the current UI language
    // - must be called once with english captions
    // - call automaticaly if conditional USEFORMCREATEHOOK is defined
    procedure FormTranslateOne(aForm: TComponent);
{$ifndef USEFORMCREATEHOOK}
    procedure FormTranslate(Forms: array of TCustomForm);
{$endif USEFORMCREATEHOOK}
    /// read a parameter, stored in the .msg file before any [Section]
    function ReadParam(const ParamName: RawUTF8): string;
























































    /// convert the supplied boolean constant into ready to be displayed text
    // - by default, returns 'No' for false, and 'Yes' for true
    // - returns the text as generic string type, ready to be used in the VCL
    function BooleanToString(Value: boolean): string;
    /// convert a TSQLRecord published property value into ready to be displayed text
    // - will convert any sftUTF8Text/sftAnsiText into ready to be displayed text
    // - will convert any sftInteger/sftFloat/sftCurrency into its textual value
................................................................................
    function TimeToText(const DateTime: TDateTime): string; overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert a time into a ready to be displayed text on the screen
    function TimeToText(const ISO: Iso8601): string; overload; {$ifdef HASINLINE}inline;{$endif}
    /// convert a time into a ready to be displayed text on the screen
    function TimeToText(const Time: TTimeLog): string; overload; {$ifdef HASINLINE}inline;{$endif}
  end;

(*
/// export the translation file into a .PO format
// - the .PO format is used by the GNU gettext tool, and allow to use some
// very usefull translation tools
// (see @http://www.gnu.org/software/hello/manual/gettext/PO-Files.html
// for documentation about the .PO format itself)
//  - the .PO is created from two .msg files, both contained in the SourceMsgPath
// directory: the original EN.msg file and the specified SourceLanguage.msg
// translated file; the resulting POFileName will be created for this language
// - if not SourceMsgPath is supplied, the current directory is used (not
// necessary the executable directory)
procedure POExport(const SourceMsgPath, POFileName: TFileName; SourceLanguage: TLanguages);
*)

/// generic US/English date/time to VCL text conversion
// - not to be used in your programs: it's just here to allow inlining of
// TLanguageFile.DateTimeToText/DateToText/TimeToText
function DateTimeToIso(const DateTime: TDateTime; DateOnly: boolean): string;

var
................................................................................
{$endif}

{$ifndef ENHANCEDRTL}
/// our hooked procedure for reading a string resource
// - the default one in System.pas unit is replaced by this one
// - this function add caching and on the fly translation (if LoadResStringTranslate
// is defined in SQLite3Commons unit)
// - use "string" type, i.e. UnicodeString for Delphi 2009 and up
function LoadResString(ResStringRec: PResStringRec): string;
{$endif}


/// convert any generic VCL Text into an UTF-8 encoded String
// - same as SynCommons.StringToUTF8()
function S2U(const Text: string): RawUTF8;
  {$ifdef HASINLINE}inline;{$endif}

/// convert an UTF-8 encoded text into a VCL-ready string

// - same as SynCommons.UTF8ToString()
function U2S(const Text: RawUTF8): string;
  {$ifdef HASINLINE}inline;{$endif}

/// convert a custom date/time into a VCL-ready string
// - this function must be assigned to i18nDateText global var of SQLite3Commons unit
// - wrapper to Language.DateTimeToText method
function Iso2S(Iso: TTimeLog): string;


implementation

uses
{$ifndef LVCL}
  ComCtrls,
  {$ifdef WITHUXTHEME}
................................................................................
function LanguageAbrToIndex(p: pAnsiChar): TLanguages; overload;
begin
  result := TLanguages(IntegerScanIndex(
    @LanguageAbrInteger[low(TLanguages)], ord(high(TLanguages))+1,
    NormToLowerByte[ord(p[0])]+NormToLowerByte[ord(p[1])] shl 8));
end;







































































































































































































































const
  // default character set for a specific language (for GUI i18n)
  // list taken from http://www.webheadstart.org/xhtml/encoding
  // see also http://msdn2.microsoft.com/en-us/library/ms776260.aspx
  // DEFAULT_CHARSET is set if not known -> Win32 will take care as default locale
  // ANSI_CHARSET is iso-8859-1, windows-1252
................................................................................
    Jump: byte;
    Offset: PtrInt;
  end;


{$ifndef ENHANCEDRTL}
// code below is extracted from our Extended System.pas unit, and
// use the generic string type (i.e. UnicodeString for Delphi 2009 and up)

const LoadResStringCacheSize = 512;
      // cache makes it faster, even more when using on the fly translations
      // 512 is a reasonnable value, never reached in practice

var CacheRes: array[0..LoadResStringCacheSize-1] of PResStringRec;
    CacheResValue: array of string;
................................................................................
  PatchPositionForm: PPatchEvent = nil;
  PatchFrame, OriginalFrame: TPatchEvent;
  PatchPositionFrame: PPatchEvent = nil;

procedure PatchCreate;
var ov: cardinal;
begin
  // hook TForm
  PatchPositionForm := PPatchEvent(@THookedForm.DoCreate);
  OriginalForm := PatchPositionForm^;
  PatchForm.Jump := $E9; // Jmp opcode
  PatchForm.Offset := PtrInt(@THookedForm.HookedDoCreate)-PtrInt(PatchPositionForm)-5;
  if not VirtualProtect(PatchPositionForm, 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;
  PatchPositionForm^ := PatchForm; // enable Hook
  // hook TFrame
  PatchPositionFrame := PPatchEvent(@TCustomFrame.Create);
  OriginalFrame := PatchPositionFrame^;
  PatchFrame.Jump := $E9; // Jmp opcode
  PatchFrame.Offset := PtrInt(@THookedFrame.Create)-PtrInt(PatchPositionFrame)-5;
  if not VirtualProtect(PatchPositionFrame, 5, PAGE_EXECUTE_READWRITE, @ov) then
    RaiseLastOSError;
  PatchPositionFrame^ := PatchFrame; // enable Hook
................................................................................
    if GetThreadLocale<>LCID then // force locale settings if different
      if SetThreadLocale(LCID) then
        GetFormatSettings; // resets all locale-specific variables
{$ifdef UNICODE}
    SetMultiByteConversionCodePage(CodePage); // for default AnsiString handling
{$endif}
{$endif}
    CurrentAnsiConvert := TSynAnsiConvert.Engine(CodePage); // redefine from GetACP
    for c := #0 to #255 do begin
      i18nToUpper[c] := c;
      i18nToLower[c] := c;
    end;
    CharUpperBuffA(i18nToUpper,256); // get values from current user locale
    CharLowerBuffA(i18nToLower,256);
    if not(CharSet in [GB2312_CHARSET,SHIFTJIS_CHARSET,HANGEUL_CHARSET,ARABIC_CHARSET]) and
................................................................................
  SetCurrentLanguage(LanguageAbrToIndex(value));
end;

function ProgramName: AnsiString;
var i: integer;
begin
  result := AnsiString(ExtractFileName(paramstr(0)));
  i := Pos(RawUTF8('.'),RawUTF8(result));
  if i>0 then
    Setlength(result,i-1);
end;

{$ifdef USEFORMCREATEHOOK}

function i18nAddLanguageItems(MsgPath: TFileName; List: TStrings): integer;
................................................................................
{$ifdef USEFORMCREATEHOOK}
  if Language<>nil then
    PatchCreate; // only patch TForm and TFrame if not english
{$endif USEFORMCREATEHOOK}
end;
{$endif}




function AnyTextFileToString(const FileName: TFileName): string;
// get text File contents (even Unicode or UTF8)




var Len: integer;



    Kind: (isUnicode, isUTF8, isAnsi);
begin
  result := '';
  if FileExists(FileName) then
  with TSynMemoryStreamMapped.Create(FileName) do
  try

    Len := Size;
    if Len<4 then
      exit;



    if PWord(Memory)^=$FEFF then
      Kind := isUnicode else
    if (PWord(Memory)^=$BBEF) and (PByteArray(Memory)[2]=$BF) then
      Kind := isUTF8 else
      Kind := isAnsi;
    case Kind of
{$ifdef UNICODE}
    isUnicode:
      SetString(result,PWideChar(PtrInt(Memory)+2),(Len-2) shr 1);

    isUTF8:

      result := UTF8DecodeToString(pointer(PtrInt(Memory)+3),Len-3);
    isAnsi:
      result := CurrentAnsiConvert.AnsiToUnicodeString(Memory,Len);





















{$else}
    isUnicode:
      result := CurrentAnsiConvert.UnicodeBufferToAnsi(PWideChar(PtrInt(Memory)+2),(Len-2) shr 1);
    isUTF8:
      result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(PtrInt(Memory)+3),Len-3);
    isAnsi:
      SetString(result,PAnsiChar(Memory),Len);









{$endif}
    end;
  finally
    Free; // THeapMemoryStream
  end;
end;


{ TLanguageFile }

constructor TLanguageFile.Create(aLanguageLocale: TLanguages);
// FR.msg, DE.msg, JP.msg files must be in the .exe directory
begin
  Create(FileName(aLanguageLocale),aLanguageLocale);
end;

constructor TLanguageFile.Create(const aFileName: TFileName; aLanguageLocale: TLanguages);
begin
  Language.Fill(aLanguageLocale);
  CurrentAnsiConvert := TSynAnsiConvert.Engine(Language.CodePage);
  LoadFromFile(aFileName);
end;

destructor TLanguageFile.Destroy;
begin
  FreeAndNil(Messages);
  inherited;
end;

class function TLanguageFile.FileName(aLanguageLocale: TLanguages): TFileName;
begin
  if aLanguageLocale<>LANGUAGE_NONE then
    result :=  ExtractFilePath(paramstr(0))+
      Ansi7ToString(LanguageAbr[aLanguageLocale])+'.msg' else
    result := '';
end;

{$ifndef USEFORMCREATEHOOK}
procedure TLanguageFile.FormTranslate(Forms: array of TCustomForm);
var f: integer;
begin
................................................................................
    H := Messages.Count - 1;
    while L <= H do begin // use fast binary search algorithm
      I := (L + H) shr 1;
      V := cardinal(Messages.Objects[I]); // our custom Classes.pas unit is fast enough
      if V<Hash then
        L := I+1 else
        if V=Hash then begin
          result := Messages.Strings[I]; // UnicodeString on Delphi 2009 and up
          exit;
        end else
          H := I-1;
    end;
  end;
  result := '';
end;
................................................................................
  FreeAndNil(Messages);
  fBooleanToString[false] := B2SS[false];
  fBooleanToString[true] := B2SS[true];
  Text := '';
  if not FileExists(aFileName) then
    exit;
  // 1. read .msg file with appropriate UTF8 or Unicode conversion
  Text := AnyTextFileToString(aFileName); // appropriate conversion
  // 2. fill Translation[] and Messages[]
  Messages := TStringList.Create;
  P := pointer(Text);
{$ifdef UNICODE}
  if FindSectionFirstLineW(P,'MESSAGES]') then
  while (P<>nil) and (P^<>'[') do begin
    H := GetNextItemCardinalW(P,'=');
................................................................................
procedure TLanguageFile.Translate(var English: string);
// case-sensitive (same as standard gettext)
var result: string;
begin
  result := FindMessage(Hash32(
    // resourcestring are expected to be in English, that is WinAnsi encoded
    // before being hashed
    {$ifdef UNICODE}WinAnsiConvert.UnicodeBufferToAnsi(pointer(English),length(English))
    {$else}English{$endif}));
  if result<>'' then
    English := result;
end;

procedure GetText(var Text: string);
// used for System.LoadResStringTranslate case-sensitive (same as standard gettext)

begin
  if Language<>nil then






    Language.Translate(Text);
end;


function _(const English: WinAnsiString): string;
begin
  if Language<>nil then begin
    result := Language.FindMessage(Hash32(English));
    if result<>'' then



      exit;
  end;

  {$ifdef UNICODE}






  result := WinAnsiToUnicodeString(pointer(English),length(English)); {$else}
  result := CurrentAnsiConvert.AnsiToAnsi(WinAnsiConvert,pointer(English),length(English));
  {$endif}

























end;

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

function U2S(const Text: RawUTF8): string;
begin
{$ifdef UNICODE}
  result := UTF8DecodeToUnicodeString(pointer(Text),length(Text));
{$else}
  result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(Text),length(Text));

{$endif}
end;

function Iso2S(Iso: TTimeLog): string;
begin
  if Iso=0 then
    result := '' else
    result := Language.DateTimeToText(Iso);
end;




























































function TLanguageFile.BooleanToString(Value: boolean): string;
begin
  if self=nil then
    result := B2SS[Value] else begin
    result := fBooleanToString[Value];
    if result='' then
      result := B2SS[Value];
................................................................................
begin
{$ifndef LVCL}if Self=nil then{$endif}
    result := DateTimeToIso(Iso8601(Time).ToTime,false)
{$ifndef LVCL} else
    DateTimeToString(Result, TimeFmt, Iso8601(Time).ToTime);
{$endif}
end;

























(*
procedure POExport(const SourceMsgPath, POFileName: TFileName; SourceLanguage: TLanguages);
var English, Source: TLanguageFile;
    SourceDir: TFileName;
    Dest: TFileStream;
    W: TTextWriter;
    i: integer;
    E: string;
................................................................................
  try
    W.AddLine('"Content-Type: text/plain; charset=UTF-8\n"'#13#10+
      '"Content-Transfer-Encoding: 8bit\n"'#13#10);
    for i := 0 to English.Messages.Count - 1 do begin
      E := English.Messages[i];
      Source.Translate(E);
      W.Add('msgid "%"'#13'msgstr"'#13#13, // #13 will be written as #13#10
        [WinAnsiConvert.StringToUTF8(StringReplace(English.Messages[i],#13#10,'"'#13#10'"',[rfReplaceAll])),
         Source.StringToUTF8(StringReplace(E,#13#10,'"'#13#10'"',[rfReplaceAll]))]);
    end;
  finally
    W.Free;
    Source.Free;
    English.Free;
    Dest.Free;
  end;
end;
*)


{ TLanguage }

function TLanguage.Abr: RawByteString;
begin
  if Index=LANGUAGE_NONE then
    result := '' else
................................................................................
begin
  result := LanguageName(Index);
end;

{$ifdef EXTRACTALLRESOURCES}
var
  // expect english text, converted into WinAnsi before Hash32()
  // - Delphi 2009 and up will do the implicit codepage conversion
  // (usefull for chars with unicode value >255, e.g. '�')
  CB_EnumStrings: TWinAnsiDynArray;
  /// number of items in CB_EnumStrings[]
  CB_EnumStringsCount: integer;
  // store the curently identified Hash32() of each english text
  CB_Enum: TDynArrayHashed;

................................................................................
// code below use the string generic type, which is prefered for the RTTI 
var F: ^Text absolute lparam;
    Reader: TReader;

  procedure ConvertObject(const ParentName, ObjectName: string);
    procedure ConvertValue(const PropName, LastPropName: string);
      procedure WriteProperty(const Value: WinAnsiString);
      // for Delphi 2009 and up, Value: string was converted into a WinAnsiString
      begin
        // ignore components which names begin with '_'
        if (PropName<>LastPropName) and (PropName<>'') then // PropName=Label1.Caption
          if PropName[1]='_' then // ignore _Copyright.Caption
            exit;
        // write value
        if (LastPropName='Caption') or (LastPropName='EditLabel.Caption') or
................................................................................
    ClassList: TList;

  procedure AddEnum(T: PEnumType);
  var index: integer;
  begin
    for index := T^.MinValue to T^.MaxValue do
      AddOnceDynArray(StringToWinAnsi(T^.GetCaption(index)));
      // for Delphi 2009 and up/XE: CaptionName converted into a WinAnsiString
  end;
  procedure AddClass(C: TClass);
  var i: integer;
      P: PPropInfo;
      CP: PClassProp;
  begin 
    if (C=nil) or (ClassList.IndexOf(C)>=0) then
................................................................................
    AddClass(C.ClassParent); // add parent properties first
    CP := InternalClassProp(C);
    if CP=nil then
      exit;
    P := @CP^.PropList;
    for i := 1 to CP^.PropCount do begin // add all field names
      AddOnceDynArray(StringToWinAnsi(TSQLRecord.CaptionName(@P^.ShortName)));
      // for Delphi 2009 and up/XE: CaptionName converted into a WinAnsiString
      with P^.PropType^^ do
      case Kind of
      tkClass:       // add contained objects
        AddClass(ClassType^.ClassType);
      tkEnumeration: // add enumeration values
        AddEnum(EnumBaseType);
      tkSet:
................................................................................
      if Objects[i].InheritsFrom(TSQLModel) then begin
        AddOnceDynArray('ID'); // ID property is never published, but always here
        // add custom captions for all tables of a database model
        with TSQLModel(Objects[i]) do
        for index := 0 to high(Tables) do
        with Tables[index] do begin // TSQLRecord.CaptionName() may be overriden 
          AddOnceDynArray(StringToWinAnsi(CaptionName(nil))); // add table name
          // for Delphi 2009 and up, CaptionName(): string will be converted into a WinAnsiString
          with InternalClassProp(Tables[index])^ do begin
            P := @PropList;
            for j := 1 to PropCount do begin // add all field names
              AddOnceDynArray(StringToWinAnsi(CaptionName(@P^.ShortName)));
              P := P^.Next;
            end;
          end;

  SysUtils;

type
  // you'll have warning about abstract classes, because TSQLRestServer doesn't
  // implement any database engine, but it doesn't matter here
  TServiceServer = class(TSQLRestServer)
  published
    function Sum(aSession: Cardinal; aRecord: TSQLRecord; aParameters: PUTF8Char;
      const aSentData: RawUTF8; out aResp, aHead: RawUTF8): Integer;
  end;


{ TServiceServer }

function TServiceServer.Sum(aSession: Cardinal; aRecord: TSQLRecord;
  aParameters: PUTF8Char; const aSentData: RawUTF8; out aResp, aHead: RawUTF8): Integer;
var a,b: Extended;
begin
  if not UrlDecodeNeedParameters(aParameters,'A,B') then begin
    result := 404; // invalid Request
    exit;
  end;
  while aParameters<>nil do begin
    UrlDecodeExtended(aParameters,'A=',a);
    UrlDecodeExtended(aParameters,'B=',b,@aParameters);
  end;
  aResp := JSONEncodeResult([a+b]);
  // same as : aResp := JSONEncode(['result',a+b],TempMemoryStream);
  result := 200; // success
end;

var
  aModel: TSQLModel;
begin

  SysUtils;

type
  // you'll have warning about abstract classes, because TSQLRestServer doesn't
  // implement any database engine, but it doesn't matter here
  TServiceServer = class(TSQLRestServer)
  published
    function Sum(var aParams: TSQLRestServerCallBackParams): Integer;

  end;


{ TServiceServer }

function TServiceServer.Sum(var aParams: TSQLRestServerCallBackParams): Integer;

var a,b: Extended;
begin
  if not UrlDecodeNeedParameters(aParams.Parameters,'A,B') then begin
    result := 404; // invalid Request
    exit;
  end;
  while aParams.Parameters<>nil do begin
    UrlDecodeExtended(aParams.Parameters,'A=',a);
    UrlDecodeExtended(aParams.Parameters,'B=',b,@aParams.Parameters);
  end;
  aParams.Resp := JSONEncodeResult([a+b]);
  // same as : aResp := JSONEncode(['result',a+b],TempMemoryStream);
  result := 200; // success
end;

var
  aModel: TSQLModel;
begin

        if Tab.Retrieve(Client,Tab.List.Row,false) then
          CopyObject(Tab.CurrentRecord,Rec) else
          exit;
      faImport:
        if isMemo and Open then
        with TSQLSafeMemo(Rec) do begin
          fName := S2U(ExtractFileName(FN));
          fData := S2U(AnyTextFileToString(FN,CurrentLanguage.Index));
          if (RecordClass=TSQLSafeMemo) and not Cypher(CaptionName,fData,true) then
            exit;
        end else
          exit;
      faCreate:
        if ((RecordClass=TSQLData) or (RecordClass=TSQLSafeData)) then
        if Open then begin

        if Tab.Retrieve(Client,Tab.List.Row,false) then
          CopyObject(Tab.CurrentRecord,Rec) else
          exit;
      faImport:
        if isMemo and Open then
        with TSQLSafeMemo(Rec) do begin
          fName := S2U(ExtractFileName(FN));
          fData := S2U(AnyTextFileToString(FN));
          if (RecordClass=TSQLSafeMemo) and not Cypher(CaptionName,fData,true) then
            exit;
        end else
          exit;
      faCreate:
        if ((RecordClass=TSQLData) or (RecordClass=TSQLSafeData)) then
        if Open then begin

  - JSONEncode*() global functions will use an internal TRawByteStringStream
    instead of a supplied TMemoryStream
  - new FormatUTF8() overloaded function, handling both '%' and '?' parameters
    (inserting '?' as inlined :(...): parameters, with proper string quote) -
    with associated regression tests

  Version 1.16



  - TSynLog allows read sharing of the .log created file
  - TSynCache now handle an integer ResultTag: PtrInt value parameter (used e.g.
    to store the row counts of a SQL result cache)
  - TMemoryMapText class (and therefore TSynLogFile) is now able to map/open
    an existing file: it will allow e.g. the SynLogViewer to browse a .log file
    which is actually still opened and working by the main application
  - faster RawUnicodeToUtf8(), WinAnsiBufferToUtf8(), UTF8ToWideChar(),
    UTF8ToWinPChar() functions, thanks to very clever speed-up proposals by Sha
  - new FileSize() and RawByteStringArrayConcat() functions
  - new TPrecisionTimer Pause and Resume methods
  - new TSynLogFamily.IncludeComputerNameInFileName property
  - new ToVarInt64() and FromVarInt64() functions to encode and decode variable
    length signed Int64 values
  - new tftVarInt64 kind of variable Length column in TSynTableFieldType
  - fixed issue in TDynArrayHashed if you do not use the external Count
................................................................................
  TDateTimeDynArray = array of TDateTime;

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

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
















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

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

................................................................................

  PInt64Rec = ^Int64Rec;


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

type
  /// defines a table containing all the unicode characters corresponding to











  // a given code page (non MBCS)
  TAnsiTable = packed array[byte] of Word;






















































































































var
  /// this table contain all the unicode characters corresponding to
  // the Ansi Code page 1252 (i.e. what we call WinAnsi within the framework)
  WinAnsiTable: TAnsiTable;










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

  /// MIME content type used for plain UTF-8 text
................................................................................

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

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

  /// used for fast WinAnsi to Unicode conversion
  // - this table contain all the unicode characters corresponding to
  // the Ansi Code page 1252 (i.e. WinAnsi), which unicode value are > 255
  // - values taken from MultiByteToWideChar(1252,0,@Tmp,256,@WinAnsiTable,256)
  // so these values are available outside the Windows platforms (e.g. Linux/BSD)
  WinAnsiUnicodeChars: packed array[128..159] of cardinal =
    (8364, 129, 8218, 402, 8222, 8230, 8224, 8225, 710, 8240, 352, 8249, 338,
     141, 381, 143, 144, 8216, 8217, 8220, 8221, 8226, 8211, 8212, 732, 8482,
     353, 8250, 339, 157, 382, 376);

  /// used for fast Unicode to WinAnsi conversion
  //-  this table contain all the unicode values corresponding to
  // the Ansi code page 1252 (i.e. WinAnsi), which unicode value are > 255,
  // sorted by increasing order (you can use a fast binary search to lookup
  // for the corresponding Ansi char, with WinAnsiTableSortedAnsi[] below)
  WinAnsiTableSortedWide: array[0..26] of integer =
    (338, 339, 352, 353, 376, 381, 382, 402, 710,
     732, 8211, 8212, 8216, 8217, 8218, 8220, 8221, 8222, 8224, 8225, 8226,
     8230, 8240, 8249, 8250, 8364, 8482);

  /// used for fast Unicode to WinAnsi (Ansi code page 1252) conversion
  // - lookup table for every WinAnsi char corresponding to a WinAnsiTableSortedWide[]
  WinAnsiTableSortedAnsi: array[0..26] of byte =
    (140, 156, 138, 154, 159, 142, 158, 131, 136,
     152, 150, 151, 145, 146, 130, 147, 148, 132, 134, 135, 149, 133, 137,
     139, 155, 128, 153);


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


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

/// internal function called by WideCharToWinAnsi()
// - should not be used in your code, only here to allow inlining of the
// WideCharToWinAnsi function
// - returns -1 if the supplied widechar doesn't belong to the code page 1252 
function WinAnsiTableSortedFind(wc: cardinal): Integer;


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




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





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

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


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


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


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


/// UTF-8 encode one Unicode character into Dest
// - return the number of bytes written into Dest (i.e. 1,2 or 3) 
function UnicodeCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
  {$ifdef HASINLINE}inline;{$endif}

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

/// direct conversion of a WinAnsi PAnsiChar buffer into a UTF-8 encoded buffer
// - Dest^ buffer must be reserved with at least SourceChars*3
function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;


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

/// direct conversion of a WinAnsi (CodePage 1252) string into a Unicode buffer
// - very fast, by using a fixed pre-calculated array for individual chars conversion

procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: integer);


/// direct conversion of a UTF-8 encoded string into a WinAnsi String
function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString; overload;


/// direct conversion of a UTF-8 encoded zero terminated buffer into a WinAnsi String
function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString; overload;


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

/// direct conversion of a UTF-8 encoded buffer into a WinAnsi PAnsiChar buffer
function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;


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

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

/// convert an UTF-8 encoded text into a WideChar array
// - faster than System.UTF8ToUnicode
// - this overloaded function expect a MaxDestChars parameter
// - sourceBytes can not be 0 for this function
// - enough place must be available in dest
................................................................................

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

/// direct conversion of a Unicode encoded buffer into a WinAnsi PAnsiChar buffer
procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: integer);


/// convert a RawUnicode PWideChar into a WinAnsi (code page 1252) string
function RawUnicodeToWinAnsi(P: PWideChar; WideCharCount: integer): WinAnsiString; overload;


/// convert a RawUnicode string into a WinAnsi (code page 1252) string
function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString; overload;


/// convert a WideString into a WinAnsi (code page 1252) string
function WideStringToWinAnsi(const Wide: WideString): WinAnsiString;


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

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


/// convert any generic VCL Text buffer into an UTF-8 encoded buffer
// - Dest must be able to receive at least SourceChars*3 bytes
// - it will work as is with Delphi 2009/2010/XE (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
................................................................................
   const FileName: TFileName=''): RawUTF8;

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

type
  PIntegerDynArray = ^TIntegerDynArray;
  TIntegerDynArray = array of integer;
  PCardinalDynArray = ^TCardinalDynArray;
  TCardinalDynArray = array of cardinal;
  PInt64DynArray = ^TInt64DynArray;
  TInt64DynArray = array of Int64;
  PDoubleDynArray = ^TDoubleDynArray;
  TDoubleDynArray = array of double;
  PCurrencyDynArray = ^TCurrencyDynArray;
  TCurrencyDynArray = array of Currency;
  TWordDynArray = array of word;
  PWordDynArray = ^TWordDynArray;
  TByteDynArray = array of byte;
  PByteDynArray = ^TByteDynArray;

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
................................................................................
    /// the main executable name, without any path nor extension
    ProgramName: RawUTF8;
    /// the main executable details, as used e.g. by TSynLog
    // - e.g. 'C:\Dev\lib\SQLite3\exe\TestSQL3.exe 0.0.0.0 (2011-03-29)'
    ProgramFullSpec: RawUTF8;
    /// same as paramstr(0)
    ProgramFileName: TFileName;


    /// the current executable version
    Version: TFileVersion;
    /// the current computer host name
    Host: RawUTF8;
    /// the current computer user name
    User: RawUTF8;
  end;
................................................................................

/// a TSynLogArchiveEvent handler which will delete older .log files
function EventArchiveDelete(const aOldLogFileName, aDestinationPath: TFileName): boolean;

/// a TSynLogArchiveEvent handler which will compress older .log files
// using our proprietary SynLZ format
// - resulting file will have the .synlz extension and will be located
// in the aDestinationPath directory, i.e. TSynLogFamily.ArchivePath+'\log\YYYYMM\' 
// - use UnSynLZ.dpr tool to uncompress it into .log textual file
// - SynLZ is much faster than zip for compression content, but proprietary
function EventArchiveSynLZ(const aOldLogFileName, aDestinationPath: TFileName): boolean;


resourcestring
  sInvalidIPAddress = '"%s" is an invalid IP v4 address';
................................................................................
  sValidationFieldDuplicate = 'Value already used for this unique key field';


implementation


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




































































































































































































































































































































































































































































































































































function UnicodeCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
begin
  if aWideChar<=$7F then begin
    Dest^ := AnsiChar(aWideChar);
    result := 1;
  end else
................................................................................
    Dest[0] := AnsiChar($C0 or (aWideChar shr 6));
    Dest[1] := AnsiChar($80 or (aWideChar and $3F));
    result := 2;
  end;
end;

function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
// length(Dest) must be reserved with at least SourceChars*3
// a #0 char is appened at the end
var EndSource: PAnsiChar;
    c: Cardinal;
begin
  if Dest=nil then begin
    Result := nil;
    Exit;
  end else
  if (Source<>nil) and (SourceChars>0) then begin
    // first handle 7 bit ASCII WideChars, by quads (Sha optimization)
    EndSource := Source+SourceChars-4;
    if Source<=EndSource then
    repeat
      c := pCardinal(Source)^;
      if c and $80808080<>0 then
        break; // break on first non ASCII quad
      inc(Source,4);
      pCardinal(Dest)^ := c;
      inc(Dest,4);
    until Source>EndSource;
    // generic loop, handling one WideChar per iteration
    inc(EndSource,4);
    if Source<EndSource then
    repeat
      c := byte(Source^); inc(Source);
      if c <= $7F then begin
        Dest^ := AnsiChar(c); // 0..127 don't need any translation
        Inc(Dest);
        if Source<EndSource then continue else break;

      end
      else begin
        c := WinAnsiTable[c]; // convert WinAnsi char into Unicode char
        if c > $7ff then begin
          Dest[0] := AnsiChar($E0 or (c shr 12));
          Dest[1] := AnsiChar($80 or ((c shr 6) and $3F));
          Dest[2] := AnsiChar($80 or (c and $3F));
          Inc(Dest,3);
          if Source<EndSource then continue else break;
        end else begin
          Dest[0] := AnsiChar($C0 or (c shr 6));
          Dest[1] := AnsiChar($80 or (c and $3F));
          Inc(Dest,2);
          if Source<EndSource then continue else break;
        end;
      end;
    until false;
  end;
  Dest^ := #0;
  Result := Dest;
end;

var
  WinAnsiTableA: packed array[AnsiChar] of Word absolute WinAnsiTable;

procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: integer);
var i, L: PtrInt;
begin
  L := PtrInt(S);

  if L<>0 then begin
    L := PPtrInt(L-4)^;
    if L>=DestLen then
      L := DestLen-1;
    for i := 0 to L do // include S[L+1] = last #0
      Dest^[i] := WinAnsiTableA[S[i+1]]; // very fast conversion

  end else
    Dest^[0] := 0;
end;

function WinAnsiToRawUnicode(const S: WinAnsiString): RawUnicode;
var i, L: PtrInt;
    PW: PWordArray;
begin
  result := '';
  if S='' then
    exit;
  L := PPtrInt(PtrInt(S)-4)^;
  SetLength(result,L*2+1); // +1 to include last WideChar(#0)
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrInt(result)-12)^ := 1200; // Codepage for an UnicodeString
{$endif}
  PW := pointer(result);
  for i := 0 to L do // include S[L+1] = last #0
    PW^[i] := WinAnsiTableA[S[i+1]]; // very fast conversion

end;

function WinAnsiToUtf8(const S: WinAnsiString): RawUTF8;
// faster than SysUtils: don't use Utf8Encode(WideString) -> no Windows.Global()
var L: integer;
    tmp: RawByteString; // don't use result as temporary buffer
begin
  result := '';
  if S='' then
    exit;
  L := PPtrInt(PtrInt(S)-4)^;
  SetLength(tmp,L*3); // enough place
  SetString(result,PAnsiChar(pointer(tmp)),
    WinAnsiBufferToUtf8(pointer(tmp),pointer(S),L)-pointer(tmp));

end;

function WinAnsiToUtf8(WinAnsi: PAnsiChar; WinAnsiLen: integer): RawUTF8; overload;
var tmp: RawByteString; // don't use result as temporary buffer
begin
  result := '';
  if WinAnsi='' then
    exit;
  SetLength(tmp,WinAnsiLen*3); // enough place
  SetString(result,PAnsiChar(pointer(tmp)),
    WinAnsiBufferToUtf8(pointer(tmp),WinAnsi,WinAnsiLen)-pointer(tmp));

end;

function WideCharToWinAnsiChar(wc: cardinal): AnsiChar;
begin // code generated for this function is very fast
  if wc<256 then
    if WinAnsiTable[wc]<256 then begin
      result := AnsiChar(wc);
      exit;
    end else begin
      result := ' '; // invalid ansi char for this code page (e.g. #128)
      exit;
    end else begin // wc>255:
      wc := WinAnsiTableSortedFind(wc);

      if integer(wc)>=0 then
        result := AnsiChar(byte(wc)) else
        result := ' '; // space for invalid wide char
    exit;
  end;
end;

function WinAnsiTableSortedFind(wc: cardinal): Integer;
var L,R: PtrInt;
    cmp: integer;
begin
    L := 0;
    R := high(WinAnsiTableSortedWide);
    repeat // very fast binary search
      result := (L + R) shr 1;
      cmp := WinAnsiTableSortedWide[result]-integer(wc);
      if cmp<0 then begin
        L := result + 1;
        if L<=R then Continue else Break;
      end else
      if cmp>0 then begin
        R := result - 1;
        if L<=R then Continue else Break;
      end else begin
        result := WinAnsiTableSortedAnsi[result];
        exit;
      end;
    until false;
  result := -1; // invalid wide char
end;

function WideCharToWinAnsi(wc: cardinal): integer;
begin
  if wc<256 then
    if WinAnsiTable[wc]<256 then
      result := wc else
      result := -1 else // invalid ansi char for this code page (e.g. #128)
      result := WinAnsiTableSortedFind(wc);
end;

function IsWinAnsi(WideText: PWideChar; Length: integer): boolean;
var i: integer;
begin
  result := false;
  if WideText<>nil then
    for i := 1 to Length do
      if WideCharToWinAnsi(cardinal(WideText^))<0 then
        exit else
        inc(WideText);
  result := true;

end;

function IsAnsiCompatible(PC: PAnsiChar): boolean;
begin
  result := false;
  if PC<>nil then
  while true do
................................................................................
    if PC^=#0 then
      break else
    if PC^<=#127 then
      inc(PC) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;






















function IsAnsiCompatible(PW: PWideChar): boolean; overload;
begin
  result := false;
  if PW<>nil then
  while true do
    if Ord(PW^)=0 then
      break else
    if Ord(PW^)<=127 then
      inc(PW) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatible(PW: PWideChar; Len: integer): boolean; overload;
var i: integer;
................................................................................
    for i := 0 to Len-1 do
      if ord(PW[i])>127 then
        exit;
  result := true;
end;

function IsWinAnsi(WideText: PWideChar): boolean;
var L,R,pivot: PtrInt;
    cmp: integer;
    wc: integer;
begin
  result := false;
  if WideText<>nil then
    repeat
      wc := cardinal(WideText^);
      inc(WideText);
      if wc=0 then
        Break else
      if wc<256 then
        if WinAnsiTable[wc]<256 then
          continue else
          exit else begin
          // wc>=256 -> fast binary search of the Unicode value in WinAnsiTable
          L := 0;
          R := high(WinAnsiTableSortedWide);
          repeat // very fast binary search
            pivot := (L + R) shr 1;
            cmp := WinAnsiTableSortedWide[pivot]-wc;
            if cmp=0 then
              break else // found
            if cmp<0 then begin
              L := pivot + 1;
              if L<=R then Continue else exit;
            end else begin
              R := pivot - 1;
              if L<=R then Continue else exit;
            end;
          until false;
        end;
    until false;
  result := true;
end;

function IsWinAnsiU(UTF8Text: PUTF8Char): boolean;
var c: Cardinal;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^); inc(UTF8Text);
      if c=0 then break else
      if c and $80=0 then
        continue else begin
        if UTF8Text^=#0 then break;
        if c and $20=0 then begin
          c := c shl 6+byte(UTF8Text^)-$00003080; inc(UTF8Text);
        end else begin
          c := c shl 6+byte(UTF8Text^); inc(UTF8Text);
          if UTF8Text^=#0 then break;
          c := c shl 6+byte(UTF8Text^)-$000E2080; inc(UTF8Text);

        end;
        if c>255 then begin
          if WinAnsiTableSortedFind(c)<0 then
            exit; // invalid char in the WinAnsi code page
        end else
        if WinAnsiTable[c]>255 then
          exit; // invalid char in the WinAnsi code page
      end;
    until false;
  result := true;
end;

function IsWinAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
var c: Cardinal;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^); inc(UTF8Text);
      if c=0 then break else
      if c and $80=0 then
        continue else begin
        if UTF8Text^=#0 then break;
        if c and $20=0 then begin
          c := c shl 6+byte(UTF8Text^)-$00003080; inc(UTF8Text);
        end else begin
          c := c shl 6+byte(UTF8Text^); inc(UTF8Text);
          if UTF8Text^=#0 then break;
          c := c shl 6+byte(UTF8Text^)-$000E2080; inc(UTF8Text);

        end;
        if (c>255) or (WinAnsiTable[c]>255) then
          exit; // not 8 bit char (like "tm" or such) is marked invalid
      end;
    until false;
  result := true;
end;

function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;
var c: cardinal;
    begd: PAnsiChar;
    endSource: PUTF8Char;
begin
  result := 0;
  if source=nil then exit;
  begd := dest;
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  endSource := source+count-4;
  if source<=endSource then
  repeat
    c := pCardinal(source)^;
    if c and $80808080<>0 then
      break; // break on first non ASCII quad
    inc(source,4);
    pCardinal(Dest)^ := c;
    inc(dest,4);
  until source>endSource;
  // generic loop, handling one UTF-8 code per iteration
  inc(endSource,4);
  if source<endSource then
  repeat
    c := byte(source^); inc(source);
    if byte(c) and $80=0 then begin
      dest^ := AnsiChar(byte(c)); inc(dest);
      if source<endsource then continue else break;
    end else begin
      if source>=endsource then break;
      if c and $20=0 then begin
        c := c shl 6+byte(source^)-$00003080; inc(source);
        if c and $ffffff00=0 then begin
          if WinAnsiTable[c]>255 then
            dest^ := ' ' else // invalid char in the WinAnsi code page
            dest^ := AnsiChar(c);
          inc(dest);  // #128..#255 -> direct copy
          if source<endsource then continue else break;
        end;
      end else begin
        c := c shl 6+byte(source^); inc(source);
        if source>=endsource then break;
        c := c shl 6+byte(source^)-$000E2080; inc(source);
      end;
      // #256.. -> slower but accurate conversion
      c := WinAnsiTableSortedFind(c);
      if integer(c)>=0 then begin
        dest^ := AnsiChar(Byte(c)); // don't add invalid wide char
        inc(dest);
      end;
      if source>=endsource then break;
    end;
  until false;
  result := dest-begd;

end;

procedure UTF8ToShortString(var dest: shortstring; source: PUTF8Char);
var c: cardinal;
    len: integer;
begin
  len := 0;
................................................................................
      end else begin
        c := c shl 6+byte(source^); inc(source);
        if source^=#0 then break;
        c := c shl 6+byte(source^)-$000E2080; inc(source);
      end;
      // #256.. -> slower but accurate conversion
      inc(len);
      c := WinAnsiTableSortedFind(c);
      if integer(c)<0 then
        c := ord('?');
      dest[len] := AnsiChar(byte(c)); // #128..#255 -> direct copy
      if len<255 then continue else break;
    end;
  until false;
  dest[0] := AnsiChar(len);
end;

function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString;
var L: integer;
    tmp: RawByteString; // don't use result as temporary buffer
begin
  if S='' then begin
    result := '';
    exit;
  end;
  L := PPtrInt(PtrInt(S)-4)^;
  SetLength(tmp,L);
  SetString(result,PAnsiChar(pointer(tmp)),UTF8ToWinPChar(pointer(tmp),pointer(S),L));
end;

function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString;
var L: integer;
    tmp: RawByteString; // don't use result as temporary buffer
begin
  L := StrLen(P);
  if L=0 then begin
    result := '';
    exit;
  end;
  SetLength(tmp,L);
  SetString(result,PAnsiChar(pointer(tmp)),UTF8ToWinPChar(pointer(tmp),P,L));
end;

procedure Utf8ToRawUTF8(P: PUTF8Char; var result: RawUTF8);
begin // fast and Delphi 2009/2010/XE ready
  SetString(result,PAnsiChar(P),StrLen(P));
end;

................................................................................
  end;
  result := PtrInt(Dest)-result;
end;

/// convert a RawUnicode PChar into a UTF-8 string
function RawUnicodeToUtf8(P: PWideChar; WideCharCount: integer): RawUTF8;
var L,LW: integer;
    tmp: array[0..511] of AnsiChar;
begin
  if WideCharCount=0 then begin
    result := '';
    exit;
  end;
  LW := WideCharCount*3; // maximum resulting length
  if LW<SizeOf(tmp) then begin // faster computation without temporary heap allocation
    SetString(Result,tmp,RawUnicodeToUtf8(tmp,sizeof(tmp),P,WideCharCount));
    exit;
  end;
  SetString(result,nil,LW);
  L := RawUnicodeToUtf8(pointer(result),LW+1,P,WideCharCount);
  if L<=0 then
    result := '' else
    if L<>LW then
................................................................................
var LW: integer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if WideCharCount=0 then
    exit;
  LW := WideCharCount*3; // maximum resulting length
  SetLength(result,LW);
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrInt(result)-12)^ := CP_UTF8; // use only SetLength() -> force set code page
{$endif}
  UTF8Length := RawUnicodeToUtf8(pointer(result),LW+1,P,WideCharCount);
  if UTF8Length<=0 then
    result := '';
end;

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

function RawUnicodeToSynUnicode(P: PWideChar; WideCharCount: integer): SynUnicode; overload;
begin
  SetString(result,P,WideCharCount);
end;

procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: Integer);
var i: integer;
    wc: integer;
begin
  for i := 0 to WideCharCount-1 do begin
    wc := integer(source[i]);
    if wc<256 then
    if WinAnsiTable[wc]<256 then
      dest[i] := AnsiChar(wc) else
      dest[i] := ' ' else begin
      wc := WinAnsiTableSortedFind(wc);
      if integer(wc)>=0 then
        dest[i] := AnsiChar(byte(wc)) else
        dest[i] := ' '; // space for invalid wide char
    end;
  end;

end;

function RawUnicodeToWinAnsi(P: PWideChar; WideCharCount: integer): WinAnsiString; overload;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if WideCharCount=0 then
    exit;
  SetLength(result,WideCharCount);
{$ifdef UNICODE2} // not needed: SetLength() did already set the codepage
  PWord(PtrInt(result)-12)^ := CODEPAGE_US; // use only SetLength() -> force set code page
{$endif}
  RawUnicodeToWinPChar(pointer(result),P,WideCharCount);
end;

function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString; overload;
begin
  result := RawUnicodeToWinAnsi(pointer(Unicode),length(Unicode) shr 1);
end;

function WideStringToWinAnsi(const Wide: WideString): WinAnsiString; 
begin
  result := RawUnicodeToWinAnsi(pointer(Wide),length(Wide));
end;

procedure UnicodeBufferToWinAnsi(source: PWideChar; out Dest: WinAnsiString);
var L: integer;
begin
  L := StrLenW(source);
  SetLength(Dest,L);
  RawUnicodeToWinPChar(pointer(Dest),source,L);
end;

function UnicodeBufferToString(source: PWideChar): string;
begin
  result := RawUnicodeToString(source,StrLenW(source));
end;

procedure AnsiCharToUTF8(P: PAnsiChar; L: Integer; var result: RawUTF8; ACP: integer);
var tmp: array[0..256*3-1] of AnsiChar;
    U: PWideChar;
    LW: integer;
    RU: RawUnicode;
begin
  if (P=nil) or (L=0) then begin
    result := '';
    exit;

  end;
  if ACP=CODEPAGE_US then begin
    /// we have WinAnsiBufferToUtf8() at hand for direct conversion from WinAnsi
    if L<SizeOf(tmp) div 3 then
      SetString(result,tmp,WinAnsiBufferToUtf8(tmp,P,L)-tmp) else begin
      SetLength(RU,L*3);
      SetString(result,PAnsiChar(pointer(RU)),
        WinAnsiBufferToUtf8(pointer(RU),P,L)-pointer(RU));
    end;
  end else begin
    // not WinAnsi encoding -> rely on Windows API
    if L<SizeOf(tmp) shr 1 then
      U := @tmp else begin
      SetLength(RU,L*2+1);
      U := pointer(RU);
    end;
    LW := MultiByteToWideChar(ACP,0,P,L,U,L);
    result := RawUnicodeToUtf8(U,LW);
  end;
end;

{$ifdef UNICODE}

/// convert a Delphi 2009 Unicode string into our UTF-8 string
function UnicodeStringToUtf8(const S: string): RawUTF8;
begin
  result := RawUnicodeToUtf8(pointer(S),length(S));
end;

function UnicodeStringToWinAnsi(const S: string): WinAnsiString;
begin
................................................................................
    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
................................................................................
function StringToWinAnsi(const Text: string): WinAnsiString;
begin
  result := RawUnicodeToWinAnsi(Pointer(Text),length(Text));
end;
{$else}
function StringToWinAnsi(const Text: string): WinAnsiString;
begin
  if GetACP=CODEPAGE_US then
    result := Text else 
    result := RawUnicodeToWinAnsi(StringToRawUnicode(Text))
end;
{$endif}

{$ifdef UNICODE}
function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char;
begin
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,PWideChar(Source),SourceChars);
end;
{$else}
function StringBufferToUtf8(Dest: PUTF8Char; Source: PChar; SourceChars: PtrInt): PUTF8Char;
var tmp: RawUnicode;
    L: integer;
begin
  if GetACP=CODEPAGE_US then begin // faster than Windows API / Delphi RTL
    result := WinAnsiBufferToUtf8(Dest,Source,SourceChars);
    exit;
  end;
  SetLength(tmp,SourceChars*2);
  L := MultiByteToWideChar(GetACP, 0, Source, SourceChars, pointer(tmp), SourceChars);
  result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,pointer(tmp),L);
end;
{$endif}

{$ifdef UNICODE}
function StringToUTF8(const Text: string): RawUTF8;
begin
  result := RawUnicodeToUtf8(pointer(Text),length(Text));
end;
{$else}
function StringToUTF8(const Text: string): RawUTF8;
var Dest: RawUnicode;
    L: integer;
begin
  if GetACP=CODEPAGE_US then begin
    result := WinAnsiToUtf8(Text); // faster than Windows API / Delphi RTL
    exit;
  end;
  result := '';
  L := length(Text);
  if L=0 then
    exit;
  SetLength(Dest,L*2);
  L := MultiByteToWideChar(GetACP, 0, Pointer(Text), L, pointer(Dest), L);
  result := RawUnicodeToUtf8(pointer(Dest),L);

end;
{$endif}

{$ifdef UNICODE}
function StringToRawUnicode(const S: string): RawUnicode;
begin
  SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;
var i, L: integer;
begin
  L := length(S);
  SetString(result,nil,L*2+1); // +1 for last wide #0
  if GetACP<>CODEPAGE_US then begin
    // low-level MBCS RTL function
    L := MultiByteToWideChar(GetACP, 0, Pointer(s), L, pointer(result), L)*2+1;
    SetLength(result,L);
    result[L-1] := #0; // ensure finish with last widechar #0
  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]];

end;
{$endif}

{$ifdef UNICODE}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
  SetString(result,PAnsiChar(P),L*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
var i: integer;
begin
  SetString(result,nil,L*2+1); // +1 for last wide #0
  if GetACP<>CODEPAGE_US then begin
    // low-level MBCS RTL function
    L := MultiByteToWideChar(GetACP, 0, P, L, pointer(result), L)*2+1;
    SetLength(result,L);
    result[L-1] := #0; // ensure finish with last widechar #0
  end else
    // fast WinAnsi conversion
    for i := 0 to L do // includes S[L]=#0 -> last widechar #0
      PWordArray(result)[i] := WinAnsiTableA[P[i]];

end;
{$endif}


{$ifdef UNICODE}
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;
begin
  SetString(result,P,L);
end;
{$else}
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;
begin
  if (GetACP=CODEPAGE_US) or IsAnsiCompatible(P,L) then
    result := RawUnicodeToWinAnsi(P,L) else begin
    SetLength(result,WideCharToMultiByte(GetACP,0,P,L,nil,0,nil,nil));
    WideCharToMultiByte(GetACP,0,P,L,pointer(result),length(result),nil,nil);
  end;
end;
{$endif}

{$ifdef UNICODE}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;
begin
  SetString(result,P,L);
end;
{$else}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;
begin
  if (GetACP=CODEPAGE_US) or IsAnsiCompatible(P,L) then
    result := RawUnicodeToWinAnsi(P,L) else begin
    SetLength(result,WideCharToMultiByte(GetACP,0,P,L,nil,0,nil,nil));
    WideCharToMultiByte(GetACP,0,P,L,pointer(result),length(result),nil,nil);
  end;
end;
{$endif}

{$ifdef UNICODE}
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  SetString(result,PWideChar(pointer(U)),StrLenW(Pointer(U)));
end;
{$else}
function RawUnicodeToString(const U: RawUnicode): string;
var L: Integer;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  L := StrLenW(Pointer(U));
  if (GetACP=CODEPAGE_US) or IsAnsiCompatible(Pointer(U),L) then
    result := RawUnicodeToWinAnsi(pointer(U),L) else begin
    SetLength(result,WideCharToMultiByte(GetACP,0,pointer(U),L,nil,0,nil,nil));
    WideCharToMultiByte(GetACP,0,pointer(U),L,pointer(result),length(result),nil,nil);
  end;

end;
{$endif}

{$ifdef UNICODE}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
  result := UTF8DecodeToUnicodeString(P,L);
end;
{$else}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
var Dest: RawUnicode;
    short: array[byte] of char;
begin
  if GetACP=CODEPAGE_US then begin
    if (P=nil) or (L=0) then
      result := '' else
    if L<sizeof(short) then // mostly avoid tmp memory allocation on heap
      SetString(result,PAnsiChar(@short),UTF8ToWinPChar(short,P,L)) else begin
      SetLength(Dest,L); // faster than Windows API / Delphi RTL
      SetString(result,PAnsiChar(pointer(Dest)),UTF8ToWinPChar(pointer(Dest),P,L));

    end;
    exit;
  end;
  result := '';
  if (P=nil) or (L=0) then
    exit;
  SetLength(Dest,L*2);
  L := UTF8ToWideChar(pointer(Dest),P,L) shr 1;
  SetLength(result,WideCharToMultiByte(GetACP,0,pointer(Dest),L,nil,0,nil,nil));
  WideCharToMultiByte(GetACP,0,pointer(Dest),L,pointer(result),length(result),nil,nil);
end;
{$endif}


function UTF8ToString(const Text: RawUTF8): string;
begin
  result := UTF8DecodeToString(pointer(Text),length(Text));
end;







function UTF8ToWideString(const Text: RawUTF8): WideString;
begin
  UTF8ToWideString(Text,result);
end;

procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString);
................................................................................
begin
  if Offset = 1 then
    Result := Pos(RawByteString(SubStr),RawByteString(S)) else begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S)-LenSubStr+1;
    C := SubStr[1];
    while I <= Len do begin
      if S[I]=C then begin
        X := 1;
        while (X<LenSubStr) and (S[I+X]=SubStr[X+1]) do
          Inc(X);
        if X=LenSubStr then begin
          Result := I;
          exit;
................................................................................
  for i := 0 to 255 do begin
    d := NormToUpperByte[i];
    if d in [ord('A')..ord('Z')] then
      inc(d,32);
    NormToLowerByte[i] := d;
  end;
{$endif OWNNORMTOUPPER}
  for i := 0 to 255 do
    if (i>=low(WinAnsiUnicodeChars)) and (i<=high(WinAnsiUnicodeChars)) then
      WinAnsiTable[i] := WinAnsiUnicodeChars[i] else
      WinAnsiTable[i] := i;
  // code below is 55 bytes long, therefore shorter than a const array
  fillchar(ConvertHexToBin[0],sizeof(ConvertHexToBin),255); // all to 255
  v := 0;
  for i := ord('0') to ord('9') do begin
    ConvertHexToBin[i] := v;
    inc(v);
  end;
  for i := ord('A') to ord('F') do begin
    ConvertHexToBin[i] := v;
    ConvertHexToBin[i+(ord('a')-ord('A'))] := v;
    inc(v);
  end;



end;

{$ifdef MSWINDOWS}
const                    
  // lpMinimumApplicationAddress retrieved from Windows is very low $10000
  // - i.e. maximum number of ID per table would be 65536 in TSQLRecord.GetID
  // - so we'll force an higher and almost "safe" value as 1,048,576
  // (real value from runnning Windows is greater than $400000)
  MIN_PTR_VALUE = $100000;

  // see http://msdn.microsoft.com/en-us/library/ms724833(v=vs.85).aspx
................................................................................
      result := NormToUpperByte[result];  {$else}
      result := NormToUpperAnsi7Byte[result]); {$endif}
    exit;
  end else
  if result and $20=0 then begin
    result := result shl 6+byte(U[1])-$00003080;
    inc(U,2);
    if (result<=255) and (WinAnsiTable[result]<=255) then
  {$ifdef USENORMTOUPPER}
        result := NormToUpperByte[result]  {$else}
        result := NormToUpperAnsi7Byte[result]) {$endif} else
      result := ord('?'); // char ignored for soundex
    exit;
  end else begin
    inc(U,3);
................................................................................
    if c and $80=0 then begin
      D[result] := AnsiChar(Table[c]);
      inc(result);
    end else
    if c and $20=0  then begin // UTF-8 decode
      c := c shl 6+byte(P[0])-$00003080;
      inc(P);
      if (c<=255) and (WinAnsiTable[c]<=255) then begin
        c := WinAnsiTable[Table[c]]; // convert to Unicode
        if c<=127 then begin
          D[result] := AnsiChar(Table[c]);
          inc(result);
        end else
          goto nxt; // leave UTF-8 encoding untouched
        continue;
      end;
................................................................................
  FileWrite(F,pointer(aLine)^,length(aLine));
  FileClose(F);
end;

procedure LogToTextFile(Msg: RawUTF8);
begin
  if Msg='' then begin
    Msg := RawUTF8(SysErrorMessage(GetLastError));
    if Msg='' then
      exit;
  end;
  AppendToTextFile(Msg,ChangeFileExt(paramstr(0),'.log'));
end;


................................................................................
    vtInt64:    Add(VInt64^);
    vtExtended: Add(VExtended^);
  end;
end;

procedure TTextWriter.AddJSONEscapeString(const s: string);
{$ifndef UNICODE}
var tmp: RawUnicode;
    i, L: PtrInt;
{$endif}
begin
  {$ifdef UNICODE}
  AddJSONEscapeW(pointer(s));
  {$else}
  L := length(S);
  SetLength(tmp,L*2); 
  if GetACP=CODEPAGE_US then
    for i := 0 to L-1 do
      PWordArray(tmp)[i] := WinAnsiTable[PByteArray(s)[i]] else
    L := MultiByteToWideChar(GetACP,0,pointer(s),L,pointer(tmp),L);
  AddJSONEscapeW(pointer(tmp),L);

  {$endif}
end;

procedure TTextWriter.AddPropName(const PropName: ShortString);
begin
  if ord(PropName[0])=0 then
    exit;
................................................................................
  ch: PtrInt;
begin
  State := STATE_BEGIN;
  subdomains := 1;
  if P<>nil then
  repeat
    ch := NextUTF8Char(P,P);
    if (ch<=255) and (WinAnsiTable[ch]<=255) then
      // convert into WinAnsi char
      c := AnsiChar(ch) else
      // invalid char
      c := #127;
    case State of
    STATE_BEGIN:
      if c in atom_chars then
................................................................................
    Check(IsWinAnsi(pointer(Unic),length(Unic)shr 1)=WA);
    Check(IsWinAnsiU(pointer(U))=WA);
    Check(UpperCase(LowerCase(U))=UpperCase(U));
    {$ifndef ENHANCEDRTL}
    Check(LowerCase(U)=RawUTF8(SysUtils.LowerCase(string(U))));
    Check(UpperCase(U)=RawUTF8(SysUtils.UpperCase(string(U))));
    {$endif}

    if GetACP=CODEPAGE_US then // initial text is WinAnsiString (CP 1252)
      Check(StringToUTF8(UTF8ToString(U))=U);
    Up := UpperCaseUnicode(U);
    Check(Up=UpperCaseUnicode(LowerCaseUnicode(U)));
    Check(kr32(0,pointer(U),length(U))=kr32pas(pointer(U),length(U)));
    if U='' then
      continue;
    Check(UnQuoteSQLString(pointer(QuotedStr(U,'"')),res)<>nil);
................................................................................
    end;
end;

{$ifdef USESYNTABLEVARIANT}
function TSynTableFieldProperties.GetVariant(FieldBuffer: pointer): Variant;
var len: integer;
    PB: PByte absolute FieldBuffer;
    PC: PAnsiChar absolute FieldBuffer;

    tmp: RawByteString;
begin
  case FieldType of
  // fixed-sized field value
  tftBoolean:
    result := PBoolean(FieldBuffer)^;
  tftUInt8:
................................................................................
  tftVarInt32:
    result := FromVarInt32(PB);
  tftVarUInt64:
    result := FromVarUInt64(PB);
  tftVarInt64:
    result := FromVarInt64(PB);
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi, tftUTF8: begin
    len := FromVarUInt32(PB);
    if len>0 then begin
      if FieldType=tftUTF8 then
        SetString(tmp,PC,len) else
        {$ifdef UNICODE}
        begin
          result := WinAnsiToUnicodeString(PC,len);
          exit;
        end;
        {$else}
        if GetACP=CODEPAGE_US then begin
          SetString(tmp,PC,len);
          result := tmp;
          exit;
        end else
          tmp := WinAnsiToUtf8(PC,len);
        {$endif}
      result := UTF8ToString(tmp);
    end else
      result := '';
  end;
  tftBlobInternal: begin
    len := FromVarUInt32(PB);
    SetString(tmp,PC,len);
    result := tmp; // return internal BLOB content as string
  end
  else
    result := ''; // tftBlobExternal fields e.g. must be directly accessed
  end;
end;
{$endif}
................................................................................
    result := Int64ToUtf8(FromVarInt64(PB));
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi, tftUTF8, tftBlobInternal: begin
    len := FromVarUInt32(PB);
    if len>0 then
      if FieldType<>tftWinAnsi then
        SetString(result,PC,len) else
        result := WinAnsiToUtf8(PC,len) else
      result := '';
  end;
  else
    result := ''; // tftBlobExternal fields e.g. must be directly accessed
  end;
end;

................................................................................
      SetString(result,PAnsiChar(@VD),sizeof(VD));
    end;
    tftWinAnsi: begin
      VS := Value;
      {$ifdef UNICODE}
      ToSBFStr(UnicodeStringToWinAnsi(VS),result);
      {$else}
      if GetACP=CODEPAGE_US then
        ToSBFStr(VS,result) else
        ToSBFStr(Utf8ToWinAnsi(StringToUTF8(VS)),result);
      {$endif}
    end;
    tftUTF8: begin
      VS := Value;
      ToSBFStr(StringToUTF8(VS),result);
    end;
    else
................................................................................
var HostTmp, UserTmp: array[byte] of AnsiChar;
    HostSize, UserSize: cardinal;
    i: integer;
begin
  with ExeVersion do
  if Version=nil then begin
    ProgramFileName := paramstr(0);

    Version := TFileVersion.Create(ProgramFileName,DefaultVersion);
    GarbageCollector.Add(Version);
    ProgramFullSpec := FormatUTF8(EXE_FMT,
      [ProgramFileName,Version.Detailed,DateToIso8601Text(Version.BuildDateTime)]);
    ProgramName := StringToUTF8(ExtractFileName(ProgramFileName));
    i := length(ProgramName);
    while i>0 do
................................................................................
finalization
  SynLogExceptionEnabled := false;
  GarbageCollector.Free; // free all global instances (avoid memory leak)
{$ifdef USESYNTABLEVARIANT}
  SynVariantTypes.Free;
{$endif}
end.

  - JSONEncode*() global functions will use an internal TRawByteStringStream
    instead of a supplied TMemoryStream
  - new FormatUTF8() overloaded function, handling both '%' and '?' parameters
    (inserting '?' as inlined :(...): parameters, with proper string quote) -
    with associated regression tests

  Version 1.16
  - introducing new TSynAnsiConvert and TSynAnsiFixedWidth classes, able to
    process Unicode to/from Ansi conversion in all possible code pages, with
    generic access methods and optimized handling of fixed width encodings
  - TSynLog allows read sharing of the .log created file
  - TSynCache now handle an integer ResultTag: PtrInt value parameter (used e.g.
    to store the row counts of a SQL result cache)
  - TMemoryMapText class (and therefore TSynLogFile) is now able to map/open
    an existing file: it will allow e.g. the SynLogViewer to browse a .log file
    which is actually still opened and working by the main application
  - faster RawUnicodeToUtf8() and UTF8ToWideChar() functions, thanks to very
    clever speed-up proposals by Sha (also included in TSynAnsi* classes)
  - new FileSize() and RawByteStringArrayConcat() functions
  - new TPrecisionTimer Pause and Resume methods
  - new TSynLogFamily.IncludeComputerNameInFileName property
  - new ToVarInt64() and FromVarInt64() functions to encode and decode variable
    length signed Int64 values
  - new tftVarInt64 kind of variable Length column in TSynTableFieldType
  - fixed issue in TDynArrayHashed if you do not use the external Count
................................................................................
  TDateTimeDynArray = array of TDateTime;

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

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

  PIntegerDynArray = ^TIntegerDynArray;
  TIntegerDynArray = array of integer;
  PCardinalDynArray = ^TCardinalDynArray;
  TCardinalDynArray = array of cardinal;
  PInt64DynArray = ^TInt64DynArray;
  TInt64DynArray = array of Int64;
  PDoubleDynArray = ^TDoubleDynArray;
  TDoubleDynArray = array of double;
  PCurrencyDynArray = ^TCurrencyDynArray;
  TCurrencyDynArray = array of Currency;
  TWordDynArray = array of word;
  PWordDynArray = ^TWordDynArray;
  TByteDynArray = array of byte;
  PByteDynArray = ^TByteDynArray;

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

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

................................................................................

  PInt64Rec = ^Int64Rec;


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

type
  /// an abstract class to handle Ansi to/from Unicode translation
  // - implementations of this class will handle efficiently all Code Pages
  // - this default implementation will use the Operating System APIs
  // - you should not create your own class instance by yourself, but should
  // better retrieve an instance using TSynAnsiConvert.Engine(), which will
  // initialize either a TSynAnsiFixedWidth or a TSynAnsiConvert instance on need
  TSynAnsiConvert = class
  protected
    fCodePage: Integer;
  public
    /// initialize the internal conversion engine
    constructor Create(aCodePage: integer); reintroduce; virtual;
    /// returns the engine corresponding to a given code page

    // - a global list of TSynAnsiConvert instances is handled by the unit -
    // therefore, caller should not release the returned instance
    // - will return nil in case of unhandled code page
    class function Engine(aCodePage: integer): TSynAnsiConvert;
    /// direct conversion of a PAnsiChar buffer into an Unicode buffer
    // - Dest^ buffer must be reserved with at least SourceChars*2 bytes
    // - this default implementation will use the Operating System APIs
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): PWideChar; overload; virtual;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    // - a #0 char is appended at the end (and result will point to it)
    // - this default implementation will use the Operating System APIs
    function AnsiBufferToUTF8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char; overload; virtual;
    /// convert any Ansi Text into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(const AnsiText: RawByteString): RawUnicode; overload;
    /// convert any Ansi buffer into an Unicode String
    // - returns a value using our RawUnicode kind of string
    function AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode; overload; virtual;
    /// convert any Ansi buffer into an Unicode String
    // - returns a SynUnicode, i.e. Delphi 2009+ UnicodeString or a WideString
    function AnsiToUnicodeString(Source: PAnsiChar; SourceChars: Cardinal): SynUnicode; 
    /// convert any Ansi Text into an UTF-8 encoded String
    // - internaly calls AnsiBufferToUTF8 virtual method
    function AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
    /// direct conversion of a PAnsiChar buffer into a UTF-8 encoded string
    // - will call AnsiBufferToUnicode() overloaded virtual method
    function AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8; overload;
    /// direct conversion of an Unicode buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars*3 bytes
    function UnicodeBufferToAnsi(Dest: PAnsiChar; Source: PWideChar; SourceChars: Cardinal): PAnsiChar; overload; virtual;
    /// direct conversion of an Unicode buffer into an Ansi Text
    function UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString; overload;
    /// convert any Unicode-encoded String into Ansi Text
    // - internaly calls UnicodeBufferToAnsi virtual method
    function RawUnicodeToAnsi(const Source: RawUnicode): RawByteString;
    /// direct conversion of an UTF-8 encoded buffer into a PAnsiChar buffer
    // - Dest^ buffer must be reserved with at least SourceChars bytes
    function UTF8BufferToAnsi(Dest: PAnsiChar; Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar; overload; virtual; 
    /// convert any UTF-8 encoded buffer into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal): RawByteString; overload;
    /// convert any UTF-8 encoded String into Ansi Text
    // - internaly calls UTF8BufferToAnsi virtual method
    function UTF8ToAnsi(const UTF8: RawUTF8): RawByteString;
    /// convert any Ansi Text (providing a From converted) into Ansi Text
    function AnsiToAnsi(From: TSynAnsiConvert; const Source: RawByteString): RawByteString; overload; 
    /// convert any Ansi buffer (providing a From converted) into Ansi Text
    function AnsiToAnsi(From: TSynAnsiConvert; Source: PAnsiChar; SourceChars: cardinal): RawByteString; overload;
    /// corresponding code page
    property CodePage: Integer read fCodePage;
  end;

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


var



  /// global TSynAnsiConvert instance to handle WinAnsi encoding (code page 1252)
  // - this instance is global and instantied during the whole program life time
  WinAnsiConvert: TSynAnsiFixedWidth;

  /// global TSynAnsiConvert instance to handle current system encoding
  // - this is the encoding as used by the AnsiString Delphi
  // - this instance is global and instantied during the whole program life time
  CurrentAnsiConvert: TSynAnsiConvert;


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

  /// MIME content type used for plain UTF-8 text
................................................................................

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

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





























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

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






  {$ifdef HASINLINE}inline;{$endif}

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

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

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

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

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

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

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

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

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

/// UTF-8 encode one Unicode character into Dest
// - return the number of bytes written into Dest (i.e. 1,2 or 3) 
function UnicodeCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
  {$ifdef HASINLINE}inline;{$endif}

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

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

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

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

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

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

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

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

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

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

/// convert an UTF-8 encoded text into a WideChar array
// - faster than System.UTF8ToUnicode
// - this overloaded function expect a MaxDestChars parameter
// - sourceBytes can not be 0 for this function
// - enough place must be available in dest
................................................................................

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

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

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

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

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

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

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

/// convert any generic VCL Text buffer into an UTF-8 encoded buffer
// - Dest must be able to receive at least SourceChars*3 bytes
// - it will work as is with Delphi 2009/2010/XE (direct unicode conversion)
// - under older version of Delphi (no unicode), it will use the
// current RTL codepage, as with WideString conversion (but without slow
// WideString usage)
................................................................................
   const FileName: TFileName=''): RawUTF8;

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

















/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
// - R is the last index of available entries in P^ (i.e. Count-1)
// - string comparison is case-sensitive (so will work with any PAnsiChar)
// - returns -1 if the specified Value was found (i.e. adding will duplicate a value)
function FastLocatePUTF8CharSorted(P: PPUTF8CharArray; R: PtrInt; Value: PUTF8Char): PtrInt; overload;

/// retrieve the index where to insert a PUTF8Char in a sorted PUTF8Char array
................................................................................
    /// the main executable name, without any path nor extension
    ProgramName: RawUTF8;
    /// the main executable details, as used e.g. by TSynLog
    // - e.g. 'C:\Dev\lib\SQLite3\exe\TestSQL3.exe 0.0.0.0 (2011-03-29)'
    ProgramFullSpec: RawUTF8;
    /// same as paramstr(0)
    ProgramFileName: TFileName;
    /// same as ExtractFilePath(paramstr(0))
    ProgramFilePath: TFileName; 
    /// the current executable version
    Version: TFileVersion;
    /// the current computer host name
    Host: RawUTF8;
    /// the current computer user name
    User: RawUTF8;
  end;
................................................................................

/// a TSynLogArchiveEvent handler which will delete older .log files
function EventArchiveDelete(const aOldLogFileName, aDestinationPath: TFileName): boolean;

/// a TSynLogArchiveEvent handler which will compress older .log files
// using our proprietary SynLZ format
// - resulting file will have the .synlz extension and will be located
// in the aDestinationPath directory, i.e. TSynLogFamily.ArchivePath+'\log\YYYYMM\'
// - use UnSynLZ.dpr tool to uncompress it into .log textual file
// - SynLZ is much faster than zip for compression content, but proprietary
function EventArchiveSynLZ(const aOldLogFileName, aDestinationPath: TFileName): boolean;


resourcestring
  sInvalidIPAddress = '"%s" is an invalid IP v4 address';
................................................................................
  sValidationFieldDuplicate = 'Value already used for this unique key field';


implementation


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

var
  // internal list of TSynAnsiConvert instances
  SynAnsiConvertList: TObjectList = nil;


{ TSynAnsiConvert }

const
  DefaultChar: AnsiChar = '?';

function TSynAnsiConvert.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal): PWideChar;
var c: cardinal;
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars>=4 then
  repeat
    c := pCardinal(Source)^;
    if c and $80808080<>0 then
      break; // break on first non ASCII quad
    dec(SourceChars,4);
    inc(Source,4);
    pCardinal(Dest)^ := (c shl 8 or (c and $FF)) and $00ff00ff;
    c := c shr 16;
    pCardinal(Dest+2)^ := (c shl 8 or c) and $00ff00ff;
    inc(Dest,4);
  until SourceChars<4;
  if (SourceChars>0) and (ord(Source^)<128) then
  repeat
    dec(SourceChars);
    Dest^ := WideChar(ord(Source^));
    inc(Source);
    inc(Dest);
  until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else
    result := Dest+MultiByteToWideChar(fCodePage,0,Source,SourceChars,Dest,SourceChars);
  result^ := #0;
end;

function TSynAnsiConvert.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
var tmp: array[byte] of WideChar;
    c: cardinal;
    U: PWideChar;
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars>=4 then
  repeat
    c := pCardinal(Source)^;
    if c and $80808080<>0 then
      break; // break on first non ASCII quad
    pCardinal(Dest)^ := c;
    dec(SourceChars,4);
    inc(Source,4);
    inc(Dest,4);
  until SourceChars<4;
  if (SourceChars>0) and (ord(Source^)<128) then
  repeat
    Dest^ := Source^;
    dec(SourceChars);
    inc(Source);
    inc(Dest);
  until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else
    if SourceChars<SizeOf(tmp) shr 1 then
      result := Dest+RawUnicodeToUTF8(Dest,SourceChars*3,tmp,
        AnsiBufferToUnicode(tmp,Source,SourceChars)-tmp) else begin
      GetMem(U,SourceChars*2+2);
      result := Dest+RawUnicodeToUtf8(Dest,SourceChars*3,U,
        AnsiBufferToUnicode(U,Source,SourceChars)-U);
      FreeMem(U);
    end;
  result^ := #0;
end;

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

function TSynAnsiConvert.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
var U: PWideChar;
begin
  if SourceChars=0 then
    result := '' else begin
    SetString(result,nil,SourceChars*2+1);
    U := AnsiBufferToUnicode(pointer(result),Source,SourceChars);
    U^ := #0;
    SetLength(result,PtrUInt(U)-PtrUInt(result)+1);
  end;
end;

function TSynAnsiConvert.AnsiToUnicodeString(Source: PAnsiChar;
  SourceChars: Cardinal): SynUnicode;
begin
  result := '';
  if SourceChars<>0 then begin
    SetLength(result,SourceChars);
    SetLength(result,AnsiBufferToUnicode(pointer(result),Source,SourceChars)-pointer(result));
  end;
end;

function TSynAnsiConvert.AnsiToUTF8(const AnsiText: RawByteString): RawUTF8;
begin
  result := AnsiBufferToRawUTF8(pointer(AnsiText),length(AnsiText));
end;

function TSynAnsiConvert.AnsiBufferToRawUTF8(Source: PAnsiChar; SourceChars: Cardinal): RawUTF8;
var tmpU8: array[0..256*3] of AnsiChar;
    U8: PUTF8Char;
begin
  if SourceChars=0 then
    result := '' else
  if SourceChars<SizeOf(tmpU8) div 3 then
    SetString(result,tmpU8,AnsiBufferToUTF8(tmpU8,Source,SourceChars)-tmpU8) else begin
    Getmem(U8,SourceChars*3);
    SetString(result,U8,AnsiBufferToUTF8(U8,Source,SourceChars)-U8);
    FreeMem(U8);
  end;
end;

constructor TSynAnsiConvert.Create(aCodePage: integer);
begin
  fCodePage := aCodePage;
end;

function IsFixedWidthCodePage(aCodePage: integer): boolean;
begin
  result := (aCodePage>=1250) and (aCodePage<=1257);
end;

class function TSynAnsiConvert.Engine(aCodePage: integer): TSynAnsiConvert;
var i: integer;
begin
  if SynAnsiConvertList=nil then begin
    SynAnsiConvertList := TObjectList.Create;
    GarbageCollector.Add(SynAnsiConvertList); // global list
  end else
    for i := 0 to SynAnsiConvertList.Count-1 do begin
      result := SynAnsiConvertList.List[i];
      if result.CodePage=aCodePage then
        exit;
    end;
  if IsFixedWidthCodePage(aCodePage) then
    result := TSynAnsiFixedWidth.Create(aCodePage) else
    result := TSynAnsiConvert.Create(aCodePage);
  SynAnsiConvertList.Add(result);
end;

function TSynAnsiConvert.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
begin
  // first handle trailing 7 bit ASCII chars, by pairs (Sha optimization)
  if SourceChars>=2 then
  repeat
    c := PCardinal(Source)^;
    if c and $ff80ff80<>0 then
      break; // break on first non ASCII pair
    dec(SourceChars,2);
    inc(Source,2);
    c := c shr 8 or c;
    pWord(Dest)^ := c;
    inc(Dest,2);
  until SourceChars<2;
  if (SourceChars>0) and (ord(Source^)<128) then
  repeat
    Dest^ := AnsiChar(ord(Source^));
    dec(SourceChars);
    inc(Source);
    inc(Dest);
  until (SourceChars=0) or (ord(Source^)>=128);
  // rely on the Operating System for all remaining ASCII characters
  if SourceChars=0 then
    result := Dest else
    result := Dest+WideCharToMultiByte(
      fCodePage,0,Source,SourceChars,Dest,SourceChars*3,@DefaultChar,nil);
end;

function TSynAnsiConvert.UTF8BufferToAnsi(Dest: PAnsiChar;
  Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar;
var tmp: array[0..256*2-1] of WideChar;
    U: PWideChar;
begin
  if SourceChars<SizeOf(tmp) shr 1 then
    result := UnicodeBufferToAnsi(Dest,tmp,UTF8ToWideChar(tmp,Source,SourceChars) shr 1) else begin
    Getmem(U,SourceChars*2+1);
    result := UnicodeBufferToAnsi(Dest,U,UTF8ToWideChar(U,Source,SourceChars) shr 1);
    Freemem(U);
  end;
end;

function TSynAnsiConvert.UTF8BufferToAnsi(Source: PUTF8Char; SourceChars: Cardinal): RawByteString;
var tmpA: array[byte] of AnsiChar;
    A: PAnsiChar;
begin
  if SourceChars=0 then
    result := '' else begin
    if SourceChars<SizeOf(tmpA) then
      SetString(result,tmpA,Utf8BufferToAnsi(tmpA,Source,SourceChars)-tmpA) else begin
      Getmem(A,SourceChars+1);
      SetString(result,A,Utf8BufferToAnsi(A,Source,SourceChars)-A);
      FreeMem(A);
    end;
{$ifdef UNICODE}
    PWord(PtrInt(result)-12)^ := fCodePage; // force set code page
{$endif}
  end;
end;

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

function TSynAnsiConvert.UnicodeBufferToAnsi(Source: PWideChar; SourceChars: Cardinal): RawByteString;
var tmpA: array[byte] of AnsiChar;
    A: PAnsiChar;
begin
  if SourceChars=0 then
    result := '' else begin
    if SourceChars<SizeOf(tmpA) then
      SetString(result,tmpA,UnicodeBufferToAnsi(tmpA,Source,SourceChars)-tmpA) else begin
      Getmem(A,SourceChars+1);
      SetString(result,A,UnicodeBufferToAnsi(A,Source,SourceChars)-A);
      FreeMem(A);
    end;
{$ifdef UNICODE}
    PWord(PtrInt(result)-12)^ := fCodePage; // force set code page
{$endif}
  end;
end;

function TSynAnsiConvert.RawUnicodeToAnsi(const Source: RawUnicode): RawByteString;
begin
  result := UnicodeBufferToAnsi(pointer(Source),length(Source));
end;

function TSynAnsiConvert.AnsiToAnsi(From: TSynAnsiConvert; const Source: RawByteString): RawByteString;
begin
  if From=self then
    result := Source else
    result := AnsiToAnsi(From,pointer(Source),length(Source));
end;

function TSynAnsiConvert.AnsiToAnsi(From: TSynAnsiConvert; Source: PAnsiChar; SourceChars: cardinal): RawByteString; 
var tmpU: array[byte] of WideChar;
    U: PWideChar;
begin
  if From=self then
    SetString(result,Source,SourceChars) else
  if SourceChars<sizeof(tmpU) shr 1 then
    result := UnicodeBufferToAnsi(tmpU,From.AnsiBufferToUnicode(tmpU,Source,SourceChars)-tmpU) else begin
    GetMem(U,SourceChars*2+2);
    result := UnicodeBufferToAnsi(U,From.AnsiBufferToUnicode(U,Source,SourceChars)-U);
    FreeMem(U);
  end;
end;


{ TSynAnsiFixedWidth }

function TSynAnsiFixedWidth.AnsiBufferToUnicode(Dest: PWideChar;
  Source: PAnsiChar; SourceChars: Cardinal): PWideChar;
var i: Integer;
begin
  for i := 1 to SourceChars shr 2 do begin
    Dest[0] := WideChar(fAnsiToWide[Ord(Source[0])]);
    Dest[1] := WideChar(fAnsiToWide[Ord(Source[1])]);
    Dest[2] := WideChar(fAnsiToWide[Ord(Source[2])]);
    Dest[3] := WideChar(fAnsiToWide[Ord(Source[3])]);
    inc(Source,4);
    inc(Dest,4);
  end;
  for i := 1 to SourceChars and 3 do begin
    Dest^ := WideChar(fAnsiToWide[Ord(Source^)]);
    inc(Dest);
    inc(Source);
  end;
  result := Dest;
end;

function TSynAnsiFixedWidth.AnsiBufferToUTF8(Dest: PUTF8Char;
  Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;
var EndSource, EndSourceBy4: PAnsiChar;
    c: Cardinal;
label By4, By1; // ugly but faster
begin
  if (self=nil) or (Dest=nil) then begin
    Result := nil;
    Exit;
  end else
  if (Source<>nil) and (SourceChars>0) then begin
    // first handle 7 bit ASCII WideChars, by quads (Sha optimization)
    EndSource := Source+SourceChars;
    EndSourceBy4 := EndSource-4;
    if Source<=EndSourceBy4 then
    repeat
By4:  c := pCardinal(Source)^;
      if c and $80808080<>0 then
        goto By1; // break on first non ASCII quad
      inc(Source,4);
      pCardinal(Dest)^ := c;
      inc(Dest,4);
    until Source>EndSourceBy4;
    // generic loop, handling one WideChar per iteration
    if Source<EndSource then
    repeat
By1:  c := byte(Source^); inc(Source);
      if c<=$7F then begin
        Dest^ := AnsiChar(c); // 0..127 don't need any translation
        Inc(Dest);
        if Source<EndSource then continue else break;
      end
      else begin
        c := fAnsiToWide[c]; // convert WinAnsi char into Unicode char
        if c>$7ff then begin
          Dest[0] := AnsiChar($E0 or (c shr 12));
          Dest[1] := AnsiChar($80 or ((c shr 6) and $3F));
          Dest[2] := AnsiChar($80 or (c and $3F));
          Inc(Dest,3);
          if Source<EndSourceBy4 then goto By4 else
          if Source<EndSource then continue else break;
        end else begin
          Dest[0] := AnsiChar($C0 or (c shr 6));
          Dest[1] := AnsiChar($80 or (c and $3F));
          Inc(Dest,2);
          if Source<EndSourceBy4 then goto By4 else
          if Source<EndSource then continue else break;
        end;
      end;
    until false;
  end;
  Dest^ := #0;
  Result := Dest;
end;

function TSynAnsiFixedWidth.AnsiToRawUnicode(Source: PAnsiChar; SourceChars: Cardinal): RawUnicode;
begin
  if SourceChars=0 then
    result := '' else begin
    SetString(result,nil,SourceChars*2+1);
    AnsiBufferToUnicode(pointer(result),Source,SourceChars)^ := #0;
  end;
end;

constructor TSynAnsiFixedWidth.Create(aCodePage: integer);
var i: integer;
    PW: PWideChar;
    A256: array[0..256] of AnsiChar;
    U256: array[0..256] of WideChar; // AnsiBufferToUnicode() write a last #0
begin
  inherited;
  if IsFixedWidthCodePage(aCodePage) then begin
    // create internal look-up tables from Operating System returned values
    SetLength(fAnsiToWide,256);
    for i := 0 to 255 do
      A256[i] := AnsiChar(i);
    PW := inherited AnsiBufferToUnicode(U256,A256,256);
    Assert(PW-U256=256);
    move(U256,fAnsiToWide[0],256*2);
    SetLength(fWideToAnsi,65536);
    fillchar(fWideToAnsi[1],65535,ord('?')); // '?' for unknown char
    for i := 1 to 255 do
      if fAnsiToWide[i]<>0 then
        fWideToAnsi[fAnsiToWide[i]] := i;
  end else
    raise Exception.CreateFmt('%s.Create - Invalid code page %d',[ClassName,fCodePage]);
end;

function TSynAnsiFixedWidth.IsValidAnsi(WideText: PWideChar; Length: integer): boolean;
var i: integer;
    wc: cardinal;
begin
  result := false;
  if WideText<>nil then
    for i := 0 to Length-1 do begin
      wc := cardinal(WideText[i]);
      if wc=0 then
        break else
      if wc<256 then
        if fAnsiToWide[wc]<256 then
          continue else
          exit else
          if fWideToAnsi[wc]=ord('?') then
            exit else
            continue;
    end;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsi(WideText: PWideChar): boolean;
var wc: cardinal;
begin
  result := false;
  if WideText<>nil then
    repeat
      wc := cardinal(WideText^);
      inc(WideText);
      if wc=0 then
        break else
      if wc<256 then
        if fAnsiToWide[wc]<256 then
          continue else
          exit else
          if fWideToAnsi[wc]=ord('?') then
            exit else
            continue;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsiU(UTF8Text: PUTF8Char): boolean;
var c: Cardinal;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^); inc(UTF8Text);
      if c=0 then break else
      if c and $80=0 then
        continue else begin
        if UTF8Text^=#0 then break;
        if c and $20=0 then begin
          c := c shl 6+byte(UTF8Text^)-$00003080; inc(UTF8Text);
        end else begin
          c := c shl 6+byte(UTF8Text^); inc(UTF8Text);
          if UTF8Text^=#0 then break;
          c := c shl 6+byte(UTF8Text^)-$000E2080; inc(UTF8Text);
        end;
        if fWideToAnsi[c]=ord('?') then
          exit; // invalid char in the WinAnsi code page
      end;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.IsValidAnsiU8Bit(UTF8Text: PUTF8Char): boolean;
var c: Cardinal;
begin
  result := false;
  if UTF8Text<>nil then
    repeat
      c := byte(UTF8Text^); inc(UTF8Text);
      if c=0 then break else
      if c and $80=0 then
        continue else begin
        if UTF8Text^=#0 then break;
        if c and $20=0 then begin
          c := c shl 6+byte(UTF8Text^)-$00003080; inc(UTF8Text);
        end else begin
          c := c shl 6+byte(UTF8Text^); inc(UTF8Text);
          if UTF8Text^=#0 then break;
          c := c shl 6+byte(UTF8Text^)-$000E2080; inc(UTF8Text);
        end;
        if (c>255) or (fAnsiToWide[c]>255) then
          exit; // not 8 bit char (like "tm" or such) is marked invalid
      end;
    until false;
  result := true;
end;

function TSynAnsiFixedWidth.UnicodeBufferToAnsi(Dest: PAnsiChar;
  Source: PWideChar; SourceChars: Cardinal): PAnsiChar;
var i: Integer;
begin
  for i := 1 to SourceChars shr 2 do begin
    Dest[0] := AnsiChar(fWideToAnsi[Ord(Source[0])]);
    Dest[1] := AnsiChar(fWideToAnsi[Ord(Source[1])]);
    Dest[2] := AnsiChar(fWideToAnsi[Ord(Source[2])]);
    Dest[3] := AnsiChar(fWideToAnsi[Ord(Source[3])]);
    inc(Source,4);
    inc(Dest,4);
  end;
  for i := 1 to SourceChars and 3 do begin
    Dest^ := AnsiChar(fWideToAnsi[Ord(Source^)]);
    inc(Dest);
    inc(Source);
  end;
  result := Dest;
end;

function TSynAnsiFixedWidth.UTF8BufferToAnsi(Dest: PAnsiChar;
  Source: PUTF8Char; SourceChars: Cardinal): PAnsiChar;
var c: cardinal;
    begd: PAnsiChar;
    endSource, endSourceBy4: PUTF8Char;
label By1, By4; // ugly but faster
begin
  begd := Dest;
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  endSource := Source+SourceChars;
  endSourceBy4 := endSource-4;
  if Source<=endSourceBy4 then
  repeat
By4:c := pCardinal(Source)^;
    if c and $80808080<>0 then
      goto By1; // break on first non ASCII quad
    inc(Source,4);
    pCardinal(Dest)^ := c;
    inc(Dest,4);
  until Source>endSourceBy4;
  // generic loop, handling one UTF-8 code per iteration
  if Source<endSource then
  repeat
By1:c := byte(Source^); inc(Source);
    if byte(c) and $80=0 then begin
      Dest^ := AnsiChar(byte(c));
      inc(Dest);
      if Source<endSource then continue else break;
    end else begin
      if Source>=endSource then break;
      if c and $20=0 then begin
        c := c shl 6+byte(Source^)-$00003080; inc(Source);
      end else begin
        c := c shl 6+byte(Source^); inc(Source);
        if Source>=endSource then break;
        c := c shl 6+byte(Source^)-$000E2080; inc(Source);
      end;
      Dest^ := AnsiChar(fWideToAnsi[c]);
      inc(Dest);
      if Source<endSourceBy4 then goto By4 else
      if Source<endSource then continue else break;
    end;
  until false;
  result := Dest;
end;

function TSynAnsiFixedWidth.WideCharToAnsiChar(wc: cardinal): integer;
begin
  if wc<256 then
    if fAnsiToWide[wc]<256 then
      result := wc else
      result := -1 else
      if wc<=65535 then begin
        result := fWideToAnsi[wc];
        if result=ord('?') then
          result := -1;
      end else
      result := -1;
end;


function UnicodeCharToUtf8(Dest: PUTF8Char; aWideChar: PtrUInt): integer;
begin
  if aWideChar<=$7F then begin
    Dest^ := AnsiChar(aWideChar);
    result := 1;
  end else
................................................................................
    Dest[0] := AnsiChar($C0 or (aWideChar shr 6));
    Dest[1] := AnsiChar($80 or (aWideChar and $3F));
    result := 2;
  end;
end;

function WinAnsiBufferToUtf8(Dest: PUTF8Char; Source: PAnsiChar; SourceChars: Cardinal): PUTF8Char;




begin

























  result := WinAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);
end;
























procedure WinAnsiToUnicodeBuffer(const S: WinAnsiString; Dest: PWordArray; DestLen: integer);
var L: PtrInt;
begin

  L := length(S);
  if L<>0 then begin

    if L>=DestLen then
      L := DestLen-1; // truncate to avoid buffer overflow


    WinAnsiConvert.AnsiBufferToUnicode(PWideChar(Dest),pointer(S),L); // include last #0
  end else
    Dest^[0] := 0;
end;

function WinAnsiToRawUnicode(const S: WinAnsiString): RawUnicode;


begin











  WinAnsiConvert.AnsiToRawUnicode(S);
end;

function WinAnsiToUtf8(const S: WinAnsiString): RawUTF8;



begin







  result := WinAnsiConvert.AnsiBufferToRawUTF8(pointer(S),length(s));
end;

function WinAnsiToUtf8(WinAnsi: PAnsiChar; WinAnsiLen: integer): RawUTF8; 

begin






  result := WinAnsiConvert.AnsiBufferToRawUTF8(WinAnsi,WinAnsiLen);
end;

function WideCharToWinAnsiChar(wc: cardinal): AnsiChar;





begin




  wc := WinAnsiConvert.WideCharToAnsiChar(wc);
  if integer(wc)=-1 then













    result := '?' else


    result := AnsiChar(wc);











end;

function WideCharToWinAnsi(wc: cardinal): integer;
begin




  result := WinAnsiConvert.WideCharToAnsiChar(wc);
end;

function IsWinAnsi(WideText: PWideChar; Length: integer): boolean;

begin







  result := WinAnsiConvert.IsValidAnsi(WideText,Length);
end;

function IsAnsiCompatible(PC: PAnsiChar): boolean;
begin
  result := false;
  if PC<>nil then
  while true do
................................................................................
    if PC^=#0 then
      break else
    if PC^<=#127 then
      inc(PC) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatible(PC: PAnsiChar; Len: integer): boolean;
var i: integer;
begin
  result := false;
  if PC<>nil then begin
    for i := 1 to Len shr 2 do
      if PCardinal(PC)^ and $80808080<>0 then
        exit else
        inc(PC,4);
    for i := 0 to (Len and 3)-1 do
      if PC[i]>=#127 then
        exit;
  end;
  result := true;
end;

function IsAnsiCompatible(const Text: RawByteString): boolean; overload;
begin
  result := IsAnsiCompatible(PAnsiChar(pointer(Text)),length(Text));
end;

function IsAnsiCompatible(PW: PWideChar): boolean; overload;
begin
  result := false;
  if PW<>nil then
  while true do
    if ord(PW^)=0 then
      break else
    if ord(PW^)<=127 then
      inc(PW) else // 7 bits chars are always OK, whatever codepage/charset is used
      exit;
  result := true;
end;

function IsAnsiCompatible(PW: PWideChar; Len: integer): boolean; overload;
var i: integer;
................................................................................
    for i := 0 to Len-1 do
      if ord(PW[i])>127 then
        exit;
  result := true;
end;

function IsWinAnsi(WideText: PWideChar): boolean;



begin




  result := WinAnsiConvert.IsValidAnsi(WideText);




















end;






function IsWinAnsiU(UTF8Text: PUTF8Char): boolean;

begin














  result := WinAnsiConvert.IsValidAnsiU(UTF8Text);
end;











function IsWinAnsiU8Bit(UTF8Text: PUTF8Char): boolean;

begin














  result := WinAnsiConvert.IsValidAnsiU8Bit(UTF8Text);
end;







function UTF8ToWinPChar(dest: PAnsiChar; source: PUTF8Char; count: integer): integer;



begin
















































  result := WinAnsiConvert.UTF8BufferToAnsi(dest,source,count)-dest;
end;

procedure UTF8ToShortString(var dest: shortstring; source: PUTF8Char);
var c: cardinal;
    len: integer;
begin
  len := 0;
................................................................................
      end else begin
        c := c shl 6+byte(source^); inc(source);
        if source^=#0 then break;
        c := c shl 6+byte(source^)-$000E2080; inc(source);
      end;
      // #256.. -> slower but accurate conversion
      inc(len);



      dest[len] := AnsiChar(WinAnsiConvert.WideCharToAnsiChar(c));
      if len<255 then continue else break;
    end;
  until false;
  dest[0] := AnsiChar(len);
end;

function Utf8ToWinAnsi(const S: RawUTF8): WinAnsiString;


begin

  result := WinAnsiConvert.UTF8ToAnsi(S);





end;

function Utf8ToWinAnsi(P: PUTF8Char): WinAnsiString;


begin


  result := WinAnsiConvert.UTF8ToAnsi(P);




end;

procedure Utf8ToRawUTF8(P: PUTF8Char; var result: RawUTF8);
begin // fast and Delphi 2009/2010/XE ready
  SetString(result,PAnsiChar(P),StrLen(P));
end;

................................................................................
  end;
  result := PtrInt(Dest)-result;
end;

/// convert a RawUnicode PChar into a UTF-8 string
function RawUnicodeToUtf8(P: PWideChar; WideCharCount: integer): RawUTF8;
var L,LW: integer;
    U8: array[0..511] of AnsiChar;
begin
  if WideCharCount=0 then begin
    result := '';
    exit;
  end;
  LW := WideCharCount*3; // maximum resulting length
  if LW<SizeOf(U8) then begin // faster computation without temporary heap allocation
    SetString(Result,U8,RawUnicodeToUtf8(U8,sizeof(U8),P,WideCharCount));
    exit;
  end;
  SetString(result,nil,LW);
  L := RawUnicodeToUtf8(pointer(result),LW+1,P,WideCharCount);
  if L<=0 then
    result := '' else
    if L<>LW then
................................................................................
var LW: integer;
begin
  result := ''; // somewhat faster if result is freed before any SetLength()
  if WideCharCount=0 then
    exit;
  LW := WideCharCount*3; // maximum resulting length
  SetLength(result,LW);



  UTF8Length := RawUnicodeToUtf8(pointer(result),LW+1,P,WideCharCount);
  if UTF8Length<=0 then
    result := '';
end;

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

function RawUnicodeToSynUnicode(P: PWideChar; WideCharCount: integer): SynUnicode; overload;
begin
  SetString(result,P,WideCharCount);
end;

procedure RawUnicodeToWinPChar(dest: PAnsiChar; source: PWideChar; WideCharCount: Integer);


begin












  WinAnsiConvert.UnicodeBufferToAnsi(dest,source,WideCharCount);
end;

function RawUnicodeToWinAnsi(P: PWideChar; WideCharCount: integer): WinAnsiString; overload;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(P,WideCharCount);







end;

function RawUnicodeToWinAnsi(const Unicode: RawUnicode): WinAnsiString;
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(Unicode),length(Unicode) shr 1);
end;

function WideStringToWinAnsi(const Wide: WideString): WinAnsiString; 
begin
  result := WinAnsiConvert.UnicodeBufferToAnsi(pointer(Wide),length(Wide));
end;

procedure UnicodeBufferToWinAnsi(source: PWideChar; out Dest: WinAnsiString);
var L: integer;
begin
  L := StrLenW(source);
  SetLength(Dest,L);
  WinAnsiConvert.UnicodeBufferToAnsi(pointer(Dest),source,L);
end;

function UnicodeBufferToString(source: PWideChar): string;
begin
  result := RawUnicodeToString(source,StrLenW(source));
end;

procedure AnsiCharToUTF8(P: PAnsiChar; L: Integer; var result: RawUTF8; ACP: integer);




begin



  result := TSynAnsiConvert.Engine(ACP).AnsiBufferToRawUTF8(P,L);
end;




















{$ifdef UNICODE}


function UnicodeStringToUtf8(const S: string): RawUTF8;
begin
  result := RawUnicodeToUtf8(pointer(S),length(S));
end;

function UnicodeStringToWinAnsi(const S: string): WinAnsiString;
begin
................................................................................
    SetLength(result,L2);
end;

function WinAnsiToUnicodeString(WinAnsi: PAnsiChar; WinAnsiLen: integer): UnicodeString;
var i: integer;
begin
  SetString(result,nil,WinAnsiLen);
  WinAnsiConvert.AnsiBufferToUnicode(pointer(result),WinAnsi,WinAnsiLen);

end;
{$endif}

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


end;
{$endif}

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


begin

  result := CurrentAnsiConvert.AnsiBufferToUTF8(Dest,Source,SourceChars);





end;
{$endif}

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


begin











  result := CurrentAnsiConvert.AnsiToUTF8(Text);
end;
{$endif}

{$ifdef UNICODE}
function StringToRawUnicode(const S: string): RawUnicode;
begin
  SetString(result,PAnsiChar(pointer(S)),length(S)*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(const S: string): RawUnicode;

begin











  result := CurrentAnsiConvert.AnsiToRawUnicode(S);
end;
{$endif}

{$ifdef UNICODE}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;
begin
  SetString(result,PAnsiChar(P),L*2+1); // +1 for last wide #0
end;
{$else}
function StringToRawUnicode(P: PChar; L: integer): RawUnicode;

begin










  result := CurrentAnsiConvert.AnsiToRawUnicode(P,L);
end;
{$endif}


{$ifdef UNICODE}
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;
begin
  SetString(result,P,L);
end;
{$else}
function RawUnicodeToString(P: PWideChar; L: integer): string; overload;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);




end;
{$endif}

{$ifdef UNICODE}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;
begin
  SetString(result,P,L);
end;
{$else}
procedure RawUnicodeToString(P: PWideChar; L: integer; var result: string); overload;
begin
  result := CurrentAnsiConvert.UnicodeBufferToAnsi(P,L);




end;
{$endif}

{$ifdef UNICODE}
function RawUnicodeToString(const U: RawUnicode): string;
begin // uses StrLenW() and not length(U) to handle case when was used as buffer
  SetString(result,PWideChar(pointer(U)),StrLenW(Pointer(U)));
end;
{$else}
function RawUnicodeToString(const U: RawUnicode): string;

begin // uses StrLenW() and not length(U) to handle case when was used as buffer






  result := CurrentAnsiConvert.UnicodeBufferToAnsi(Pointer(U),StrLenW(Pointer(U)));
end;
{$endif}

{$ifdef UNICODE}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;
begin
  result := UTF8DecodeToUnicodeString(P,L);
end;
{$else}
function UTF8DecodeToString(P: PUTF8Char; L: integer): string;


begin







  result := CurrentAnsiConvert.UTF8BufferToAnsi(P,L);
end;










{$endif}

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

function UTF8ToWideString(const Text: RawUTF8): WideString;
begin
  UTF8ToWideString(Text,result);
end;

procedure UTF8ToWideString(const Text: RawUTF8; var result: WideString);
................................................................................
begin
  if Offset = 1 then
    Result := Pos(RawByteString(SubStr),RawByteString(S)) else begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S)-LenSubStr+1;
    C := SubStr[1];
    while I<=Len do begin
      if S[I]=C then begin
        X := 1;
        while (X<LenSubStr) and (S[I+X]=SubStr[X+1]) do
          Inc(X);
        if X=LenSubStr then begin
          Result := I;
          exit;
................................................................................
  for i := 0 to 255 do begin
    d := NormToUpperByte[i];
    if d in [ord('A')..ord('Z')] then
      inc(d,32);
    NormToLowerByte[i] := d;
  end;
{$endif OWNNORMTOUPPER}




  // code below is 55 bytes long, therefore shorter than a const array
  fillchar(ConvertHexToBin[0],sizeof(ConvertHexToBin),255); // all to 255
  v := 0;
  for i := ord('0') to ord('9') do begin
    ConvertHexToBin[i] := v;
    inc(v);
  end;
  for i := ord('A') to ord('F') do begin
    ConvertHexToBin[i] := v;
    ConvertHexToBin[i+(ord('a')-ord('A'))] := v;
    inc(v);
  end;
  // initialize our most used TSynAnsiConvert engines
  WinAnsiConvert := TSynAnsiConvert.Engine(CODEPAGE_US) as TSynAnsiFixedWidth;
  CurrentAnsiConvert := TSynAnsiConvert.Engine(GetACP);
end;

{$ifdef MSWINDOWS}
const
  // lpMinimumApplicationAddress retrieved from Windows is very low $10000
  // - i.e. maximum number of ID per table would be 65536 in TSQLRecord.GetID
  // - so we'll force an higher and almost "safe" value as 1,048,576
  // (real value from runnning Windows is greater than $400000)
  MIN_PTR_VALUE = $100000;

  // see http://msdn.microsoft.com/en-us/library/ms724833(v=vs.85).aspx
................................................................................
      result := NormToUpperByte[result];  {$else}
      result := NormToUpperAnsi7Byte[result]); {$endif}
    exit;
  end else
  if result and $20=0 then begin
    result := result shl 6+byte(U[1])-$00003080;
    inc(U,2);
    if (result<=255) and (WinAnsiConvert.AnsiToWide[result]<=255) then
  {$ifdef USENORMTOUPPER}
        result := NormToUpperByte[result]  {$else}
        result := NormToUpperAnsi7Byte[result]) {$endif} else
      result := ord('?'); // char ignored for soundex
    exit;
  end else begin
    inc(U,3);
................................................................................
    if c and $80=0 then begin
      D[result] := AnsiChar(Table[c]);
      inc(result);
    end else
    if c and $20=0  then begin // UTF-8 decode
      c := c shl 6+byte(P[0])-$00003080;
      inc(P);
      if (c<=255) and (WinAnsiConvert.AnsiToWide[c]<=255) then begin
        c := WinAnsiConvert.AnsiToWide[Table[c]]; // convert to Unicode
        if c<=127 then begin
          D[result] := AnsiChar(Table[c]);
          inc(result);
        end else
          goto nxt; // leave UTF-8 encoding untouched
        continue;
      end;
................................................................................
  FileWrite(F,pointer(aLine)^,length(aLine));
  FileClose(F);
end;

procedure LogToTextFile(Msg: RawUTF8);
begin
  if Msg='' then begin
    Msg := StringToUTF8(SysErrorMessage(GetLastError));
    if Msg='' then
      exit;
  end;
  AppendToTextFile(Msg,ChangeFileExt(paramstr(0),'.log'));
end;


................................................................................
    vtInt64:    Add(VInt64^);
    vtExtended: Add(VExtended^);
  end;
end;

procedure TTextWriter.AddJSONEscapeString(const s: string);
{$ifndef UNICODE}
var tmp: PWideChar;
    L: PtrInt;
{$endif}
begin
  {$ifdef UNICODE}
  AddJSONEscapeW(pointer(s));
  {$else}
  L := length(S);
  GetMem(tmp,L*2+2);
  L := CurrentAnsiConvert.AnsiBufferToUnicode(tmp,pointer(s),L)-tmp;



  AddJSONEscapeW(pointer(tmp),L);
  Freemem(tmp);
  {$endif}
end;

procedure TTextWriter.AddPropName(const PropName: ShortString);
begin
  if ord(PropName[0])=0 then
    exit;
................................................................................
  ch: PtrInt;
begin
  State := STATE_BEGIN;
  subdomains := 1;
  if P<>nil then
  repeat
    ch := NextUTF8Char(P,P);
    if (ch<=255) and (WinAnsiConvert.AnsiToWide[ch]<=255) then
      // convert into WinAnsi char
      c := AnsiChar(ch) else
      // invalid char
      c := #127;
    case State of
    STATE_BEGIN:
      if c in atom_chars then
................................................................................
    Check(IsWinAnsi(pointer(Unic),length(Unic)shr 1)=WA);
    Check(IsWinAnsiU(pointer(U))=WA);
    Check(UpperCase(LowerCase(U))=UpperCase(U));
    {$ifndef ENHANCEDRTL}
    Check(LowerCase(U)=RawUTF8(SysUtils.LowerCase(string(U))));
    Check(UpperCase(U)=RawUTF8(SysUtils.UpperCase(string(U))));
    {$endif}
    if CurrentAnsiConvert.CodePage=CODEPAGE_US then
       // initial text above is WinAnsiString (CP 1252)
      Check(StringToUTF8(UTF8ToString(U))=U);
    Up := UpperCaseUnicode(U);
    Check(Up=UpperCaseUnicode(LowerCaseUnicode(U)));
    Check(kr32(0,pointer(U),length(U))=kr32pas(pointer(U),length(U)));
    if U='' then
      continue;
    Check(UnQuoteSQLString(pointer(QuotedStr(U,'"')),res)<>nil);
................................................................................
    end;
end;

{$ifdef USESYNTABLEVARIANT}
function TSynTableFieldProperties.GetVariant(FieldBuffer: pointer): Variant;
var len: integer;
    PB: PByte absolute FieldBuffer;
    PA: PAnsiChar absolute FieldBuffer;
    PU: PUTF8Char absolute FieldBuffer;
    tmp: RawByteString;
begin
  case FieldType of
  // fixed-sized field value
  tftBoolean:
    result := PBoolean(FieldBuffer)^;
  tftUInt8:
................................................................................
  tftVarInt32:
    result := FromVarInt32(PB);
  tftVarUInt64:
    result := FromVarUInt64(PB);
  tftVarInt64:
    result := FromVarInt64(PB);
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi: begin
    len := FromVarUInt32(PB);
    if len>0 then
      {$ifdef UNICODE}
      result := WinAnsiToUnicodeString(PA,len)
      {$else}
      result := CurrentAnsiConvert.AnsiToAnsi(WinAnsiConvert,PA,len)
      {$endif} else
      result := '';
  end;
  tftUTF8: begin
    len := FromVarUInt32(PB);
    if len>0 then
      {$ifdef UNICODE}
      result := UTF8DecodeToUnicodeString(PU,len)
      {$else}
      result := CurrentAnsiConvert.UTF8BufferToAnsi(PU,len)
      {$endif} else


      result := '';
  end;
  tftBlobInternal: begin
    len := FromVarUInt32(PB);
    SetString(tmp,PA,len);
    result := tmp; // return internal BLOB content as string
  end
  else
    result := ''; // tftBlobExternal fields e.g. must be directly accessed
  end;
end;
{$endif}
................................................................................
    result := Int64ToUtf8(FromVarInt64(PB));
  // text storage - WinAnsi could use less space than UTF-8
  tftWinAnsi, tftUTF8, tftBlobInternal: begin
    len := FromVarUInt32(PB);
    if len>0 then
      if FieldType<>tftWinAnsi then
        SetString(result,PC,len) else
        result := WinAnsiConvert.AnsiBufferToRawUTF8(PC,len) else
      result := '';
  end;
  else
    result := ''; // tftBlobExternal fields e.g. must be directly accessed
  end;
end;

................................................................................
      SetString(result,PAnsiChar(@VD),sizeof(VD));
    end;
    tftWinAnsi: begin
      VS := Value;
      {$ifdef UNICODE}
      ToSBFStr(UnicodeStringToWinAnsi(VS),result);
      {$else}
      ToSBFStr(WinAnsiConvert.AnsiToAnsi(CurrentAnsiConvert,VS),result);


      {$endif}
    end;
    tftUTF8: begin
      VS := Value;
      ToSBFStr(StringToUTF8(VS),result);
    end;
    else
................................................................................
var HostTmp, UserTmp: array[byte] of AnsiChar;
    HostSize, UserSize: cardinal;
    i: integer;
begin
  with ExeVersion do
  if Version=nil then begin
    ProgramFileName := paramstr(0);
    ProgramFilePath := ExtractFilePath(ProgramFileName);
    Version := TFileVersion.Create(ProgramFileName,DefaultVersion);
    GarbageCollector.Add(Version);
    ProgramFullSpec := FormatUTF8(EXE_FMT,
      [ProgramFileName,Version.Detailed,DateToIso8601Text(Version.BuildDateTime)]);
    ProgramName := StringToUTF8(ExtractFileName(ProgramFileName));
    i := length(ProgramName);
    while i>0 do
................................................................................
finalization
  SynLogExceptionEnabled := false;
  GarbageCollector.Free; // free all global instances (avoid memory leak)
{$ifdef USESYNTABLEVARIANT}
  SynVariantTypes.Free;
{$endif}
end.

    metadata; new header with 8 bit characters; correct outlines and other
    minor issues: now pass www.pdf-tools.com/pdf/pdfa-online-pruefen.aspx test

  Version 1.15
  - unit now tested with Delphi XE2 (32 Bit)

  Version 1.16

  - fixed issue in TPdfDocument.CreateOrGetImage about guessing if a bitmap is
    to be reused as a pdf object
  - added TPdfDocument.ForceNoBitmapReuse property
  - added a "Decimals: cardinal=6" parameter to TPdfCanvas.ConcatToCTM
  - TPdfCanvas.SetDash parameter is now an array of integer
  - set PDF_MAX_FONTSIZE limit to 2000 - should be big enough in practice
  - fixed an issue when the first time a font was used is as Unicode
................................................................................
    JPG, TIF, PNG and GIF image types (prefered way, but need XP or later OS)
  - if you'd rather use the default jpeg unit (and add some more code to your
    executable), undefine this conditional }

interface

uses
  Windows,
  SysConst, SysUtils, Classes,
  {$ifdef ISDELPHIXE2}
  VCL.Graphics,
  {$else}
  Graphics,
  {$endif}
  SynCommons,
  {$ifdef USE_SYNGDIPLUS}
  SynGdiPlus; // use our GDI+ library for handling TJpegImage and such
  {$else}
  jpeg;            
  {$endif}


................................................................................
    gdi, old: THandle;
    aFontName: RawUTF8;
    i, L: integer;
    Rec: ^TNameRecord;
begin
  aFontName := FTrueTypeFonts[aFontIndex];
  result := TrueTypeFontName(aFontName,AStyle);
  if IsAnsiCompatible(PAnsiChar(pointer(aFontName))) then
    exit; // no need to search for the PostScript name field in TTF content
  gdi := CreateFontIndirectW(ALogFont);
  if gdi=0 then
    exit; // if the function failed, the return value is NULL
  old := SelectObject(FDC,gdi);
  try
    name := GetTTFData(FDC,'name',fName);
................................................................................
end;

{$endif}

procedure TPdfCanvas.ShowText(const text: PDFString; NextLine: boolean);
begin
  if (FContents<>nil) and (text<>'') then
    if (fDoc.FCharSet=ANSI_CHARSET) or IsAnsiCompatible(PAnsiChar(pointer(text))) then begin
      if FPage.Font.Unicode and (FPage.FFont.FTrueTypeFontsIndex<>0) then
        SetPDFFont(TPdfFontTrueType(FPage.Font).WinAnsiFont,FPage.FontSize);
      FContents.Writer.Add('(').AddEscapeText(pointer(text),FPage.Font).Add(')').
        Add(SHOWTEXTCMD[NextLine])
    end else begin
      if FPage.FFont.FTrueTypeFontsIndex<>0 then
        // write TrueType text after conversion to unicode
................................................................................
begin
  result := (fUsedWideChar.Count>0);
end;

function TPdfFontTrueType.GetWideCharWidth(aWideChar: WideChar): Integer;
begin
  self := self.WinAnsiFont; // we need fUsedWide[] to be used glyphs
  if cardinal(aWideChar)<256 then
    if WinAnsiTable[cardinal(aWideChar)]<256 then
      result := cardinal(aWideChar) else
      result := -1 else // invalid ansi char for this code page (e.g. #128)
      result := WinAnsiTableSortedFind(cardinal(aWideChar));
  if result>=0 then
    if (fWinAnsiWidth<>nil) and (result>=32) then
      result := fWinAnsiWidth[AnsiChar(result)] else
      result := fDefaultWidth else
      result := fUsedWide[FindOrAddUsedWideChar(aWideChar)].Width;
end;

................................................................................
                  CreateFontPackage := GetProcAddress(FontSub,'CreateFontPackage');
              end;
              if (FontSub<>0) and (@CreateFontPackage<>nil) then begin
                // subset magic is done by Windows (API available since XP) :)
                Used.Count := 0;
                for i := fFirstChar to fLastChar do
                  if AnsiChar(i) in fWinAnsiUsed then
                    Used.Add(WinAnsiTable[i]);
                with fUsedWideChar do
                  for i := 0 to Count-1 do
                    Used.Add(Values[i]);
                if CreateFontPackage(pointer(ttf),ttfSize,
                    SubSetData,SubSetMem,SubSetSize,
                    TTFCFP_FLAGS_SUBSET,0,TTFMFP_SUBSET,0,
                    TTFCFP_MS_PLATFORMID,TTFCFP_UNICODE_CHAR_SET,

    metadata; new header with 8 bit characters; correct outlines and other
    minor issues: now pass www.pdf-tools.com/pdf/pdfa-online-pruefen.aspx test

  Version 1.15
  - unit now tested with Delphi XE2 (32 Bit)

  Version 1.16
  - includes new TSynAnsiConvert classes for handling Ansi charsets
  - fixed issue in TPdfDocument.CreateOrGetImage about guessing if a bitmap is
    to be reused as a pdf object
  - added TPdfDocument.ForceNoBitmapReuse property
  - added a "Decimals: cardinal=6" parameter to TPdfCanvas.ConcatToCTM
  - TPdfCanvas.SetDash parameter is now an array of integer
  - set PDF_MAX_FONTSIZE limit to 2000 - should be big enough in practice
  - fixed an issue when the first time a font was used is as Unicode
................................................................................
    JPG, TIF, PNG and GIF image types (prefered way, but need XP or later OS)
  - if you'd rather use the default jpeg unit (and add some more code to your
    executable), undefine this conditional }

interface

uses
  Windows, 
  SysConst, SysUtils, Classes,
  {$ifdef ISDELPHIXE2}
  VCL.Graphics,
  {$else}
  Graphics,
  {$endif}
  SynCommons, 
  {$ifdef USE_SYNGDIPLUS}
  SynGdiPlus; // use our GDI+ library for handling TJpegImage and such
  {$else}
  jpeg;            
  {$endif}


................................................................................
    gdi, old: THandle;
    aFontName: RawUTF8;
    i, L: integer;
    Rec: ^TNameRecord;
begin
  aFontName := FTrueTypeFonts[aFontIndex];
  result := TrueTypeFontName(aFontName,AStyle);
  if IsAnsiCompatible(aFontName) then
    exit; // no need to search for the PostScript name field in TTF content
  gdi := CreateFontIndirectW(ALogFont);
  if gdi=0 then
    exit; // if the function failed, the return value is NULL
  old := SelectObject(FDC,gdi);
  try
    name := GetTTFData(FDC,'name',fName);
................................................................................
end;

{$endif}

procedure TPdfCanvas.ShowText(const text: PDFString; NextLine: boolean);
begin
  if (FContents<>nil) and (text<>'') then
    if (fDoc.FCharSet=ANSI_CHARSET) or IsAnsiCompatible(text) then begin
      if FPage.Font.Unicode and (FPage.FFont.FTrueTypeFontsIndex<>0) then
        SetPDFFont(TPdfFontTrueType(FPage.Font).WinAnsiFont,FPage.FontSize);
      FContents.Writer.Add('(').AddEscapeText(pointer(text),FPage.Font).Add(')').
        Add(SHOWTEXTCMD[NextLine])
    end else begin
      if FPage.FFont.FTrueTypeFontsIndex<>0 then
        // write TrueType text after conversion to unicode
................................................................................
begin
  result := (fUsedWideChar.Count>0);
end;

function TPdfFontTrueType.GetWideCharWidth(aWideChar: WideChar): Integer;
begin
  self := self.WinAnsiFont; // we need fUsedWide[] to be used glyphs
  result := WideCharToWinAnsi(ord(aWideChar));




  if result>=0 then
    if (fWinAnsiWidth<>nil) and (result>=32) then
      result := fWinAnsiWidth[AnsiChar(result)] else
      result := fDefaultWidth else
      result := fUsedWide[FindOrAddUsedWideChar(aWideChar)].Width;
end;

................................................................................
                  CreateFontPackage := GetProcAddress(FontSub,'CreateFontPackage');
              end;
              if (FontSub<>0) and (@CreateFontPackage<>nil) then begin
                // subset magic is done by Windows (API available since XP) :)
                Used.Count := 0;
                for i := fFirstChar to fLastChar do
                  if AnsiChar(i) in fWinAnsiUsed then
                    Used.Add(WinAnsiConvert.AnsiToWide[i]);
                with fUsedWideChar do
                  for i := 0 to Count-1 do
                    Used.Add(Values[i]);
                if CreateFontPackage(pointer(ttf),ttfSize,
                    SubSetData,SubSetMem,SubSetSize,
                    TTFCFP_FLAGS_SUBSET,0,TTFMFP_SUBSET,0,
                    TTFCFP_MS_PLATFORMID,TTFCFP_UNICODE_CHAR_SET,