Core/DBDWriterXML.pas - master - YakuninAV/Convertors

Core/DBDWriterXML.pas
770 строк31 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
/// Модуль соддержащий обявление класса TDBDWriterXML, предназначенного для формирование XML-текста
unit DBDWriterXML;

{$I mormot.defines.inc}

interface

uses

{$IFDEF ISDELPHIXE2}
  System.Types, System.SysUtils, System.Classes
{$ELSE}
  Types, SysUtils, Classes
{$ENDIF}
  , mormot.core.base, mormot.core.os, mormot.core.unicode, mormot.core.json, mormot.core.datetime, mormot.core.text,
    mormot.core.buffers, mormot.core.fmt
  , DBDCommons
  , DBDWindows
  , DBDIntfs
  , DBDUtils
  , DBDStrUtils
  , dbdutf8utils
{$IFDEF FPC}
  , XMLValidateFPC
{$ELSE}
  , XMLValidate
{$ENDIF}
  ;

type

  /// Класс для формирования XML-файлов
  TDBDWriterXMLV1 = class(TInterfacedObject, IDBDWriterXMLV1)
  private
    FPricePrecision: Integer;
    FQuantityPrecision: Integer;
    FValuePrecision: Integer;
    FNamespaceSchemaLocation: TFileName;
    FOptions: TDBDXMLWriterOptions;
    FError: string;
    function GetError: string;
    function GetOptions: TDBDXMLWriterOptions;
    function GetNamespaceSchemaLocation: TFileName;
    function GetPricePrecision: Integer;
    function GetQuantityPrecision: Integer;
    function GetText: RawUTF8;
    function GetValuePrecision: Integer;
    procedure SetPricePrecision(const Value: Integer);
    procedure SetQuantityPrecision(const Value: Integer);
    procedure SetValuePrecision(const Value: Integer);
    procedure SetNamespaceSchemaLocation(const Value: TFileName);
    procedure SetOptions(const Value: TDBDXMLWriterOptions);
  protected
    Txt: TTextWriter;
    FRootName: RawUTF8;
    FReady: Boolean;
    FClosed: Boolean;
    FCurrentLevel: Integer;
    procedure WriteIdent;
  public
    /// Локальная копия установок форматирования чисел и дат
    class var XMLFormatSettings: TFormatSettings;
    /// Описание ошибки, возникшей при формировании текста
    property Error: string read GetError;
    /// Опции формирования XML-текста
    property Options: TDBDXMLWriterOptions read GetOptions write SetOptions;
    /// Файл содержащий схему
    property NamespaceSchemaLocation: TFileName read GetNamespaceSchemaLocation write SetNamespaceSchemaLocation;
    /// Точность округления вещественного числа представляющего значение типа "Price"
    property PricePrecision: Integer read GetPricePrecision write SetPricePrecision;
    /// Точность округления вещественного числа представляющего значение типа "Quantity"
    property QuantityPrecision: Integer read GetQuantityPrecision write SetQuantityPrecision;
    /// Точность округления вещественного числа представляющего значение типа "Value"
    property ValuePrecision: Integer read GetValuePrecision write SetValuePrecision;
    /// XML-текст
    property Text: RawUTF8 read GetText;
    /// Конструктор
    constructor Create(const FileName: TFileName; const aOptions: TDBDXMLWriterOptions=[dbdxmlEachElemOnNewLine]); overload;
    /// Конструктор
    constructor Create(Stream: TStream; const aOptions: TDBDXMLWriterOptions=[dbdxmlEachElemOnNewLine]); overload;
    /// Деструктор
    destructor Destroy; override;
    /// Функция добавляет в XML схему из файла
    function AddSchemaFromFile(const FN: TFileName; const FileNameOnly: Boolean=False): Boolean;
    /// Функция добавляет в XML схему из ресурса приложения
    function AddSchemaFromResource(const ResID: string; const SchemaName: string): Boolean;
    /// Процедура добавляет атрибут в строку атрибутов
    class procedure AttrStringU(var Attr: RawUTF8; const Name: RawUTF8; const Value: string);
    /// Функция выполняет трансформацию XML-текста в соответствии с заданным XLST
    class function Transform(const XMLFile, StyleSheet: TFileName; out ResultStr: string): Boolean;
    /// Функция проверяет XML-текст на соответствие схеме
    class function Validate(const XMLFile: TFileName; const SchemaFile: TFileName = ''): Boolean;
    /// Функция формирует начало XML-текста
    function BeginXML(const RootName: RawUTF8; const SchemaLocation: RawUTF8=''; const Addition: RawUtf8=''): Boolean;
    /// Процедура выводит в текст завершающий таг (закрывающий таг корневого элемента
    procedure EndXML;
    /// Функция возвращает true, если XML-текст сформирован
    function IsClosed: Boolean;
    /// Функция возвращает true, если объект готов к работе (может принимать текст)
    function IsReady: Boolean;
    /// Функция проверяет сформированный XLM-текст на соответствие схеме
    function isValid(const SchemaFile: TFileName; const isResource: Boolean=True): Boolean;
    /// Функция возвращает строку со схемой, хранимой в ресурсе программы
    class function SchemaFromResource(const ResID: string): WideString;
    ///Процедура выводит в текст элемент являющийся булевым значением
    procedure WriteBoolean(const ElemName: string; const ElemValue: Boolean); inline;
    ///Процедура выводит в текст элемент являющийся булевым значением
    procedure WriteBooleanU(const ElemName: RawUTF8; const ElemValue: Boolean);
    ///Процедура выводит в текст элемент являющийся символом
    procedure WriteChar(const ElemName: string; const ElemValue: AnsiChar); inline;
    ///Процедура выводит в текст элемент являющийся символом
    procedure WriteCharU(const ElemName: RawUTF8; const ElemValue: AnsiChar);
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков
    procedure WriteCurrency(const ElemName: string; const ElemValue: Currency; const Prec: Integer=DBD_PRICE_PREC; const Scale: Integer=1); inline;
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков
    procedure WriteCurrencyU(const ElemName: RawUTF8; const ElemValue: Currency; const Prec: Integer=DBD_PRICE_PREC; const Scale: Integer=1);
    ///Процедура выводит в текст элемент являющийся датой
    procedure WriteDate(const ElemName: string; const ElemValue: TDateTime); inline;
    ///Процедура выводит в текст элемент являющийся датой
    procedure WriteDateU(const ElemName: RawUTF8; const ElemValue: TDateTime);
    ///Процедура выводит в текст элемент являющийся датой
    procedure WriteDateTime(const ElemName: string; const ElemValue: TDateTime);
    ///Процедура выводит в текст элемент являющийся датой
    procedure WriteDateTimeU(const ElemName: RawUTF8; const ElemValue: TDateTime);
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков
    procedure WriteDouble(const ElemName: string; const ElemValue: Double; const Prec: Integer=-1; const Scale: Integer=1); inline;
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до заданного числа знаков
    procedure WriteDoubleU(const ElemName: RawUTF8; const ElemValue: Double; const Prec: Integer=-1; const Scale: Integer=1);
    ///Процедура выводит в текст элемент являющийся целым числом
    procedure WriteInteger(const ElemName: string; const ElemValue: Integer); inline;
    ///Процедура выводит в текст элемент являющийся целым числом
    procedure WriteIntegerU(const ElemName: RawUTF8; const ElemValue: Integer);
    ///Процедура выводит в текст элемент являющийся процентным числом, округляя его до соответсвующего числа знаков
    procedure WritePercent(const ElemName: string; const ElemValue: Double);
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков
    procedure WritePrice(const ElemName: string; const ElemValue: Double; const Scale: Integer=1); inline;
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков
    procedure WritePriceU(const ElemName: RawUTF8; const ElemValue: Double; const Scale: Integer=1); inline;
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков
    procedure WriteQuantity(const ElemName: string; const ElemValue: Double); inline;
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков
    procedure WriteQuantityU(const ElemName: RawUTF8; const ElemValue: Double); inline;
    ///Процедура выводит в текст элемент являющийся текстом
    procedure WriteString(const ElemName, ElemValue: string; HtmlEscape: Boolean=True);
    ///Процедура выводит в текст элемент являющийся текстом
    procedure WriteStringU(const ElemName: RawUTF8; const ElemValue: string; HtmlEscape: Boolean=True);
    ///Процедура выводит в текст элемент являющийся текстом
    procedure WriteUTF8(const ElemName: string; const ElemValue: RawUTF8; HtmlEscape: Boolean=True);
    ///Процедура выводит в текст элемент являющийся текстом
    procedure WriteUTF8U(const ElemName, ElemValue: RawUTF8; HtmlEscape: Boolean=True);
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков
    procedure WriteValue(const ElemName: string; const ElemValue: Double); overload; inline;
    ///Процедура выводит в текст элемент являющийся вещественным числом, округляя его до соответсвующего числа знаков
    procedure WriteValueU(const ElemName: RawUTF8; const ElemValue: Double); overload; inline;
    ///Процедура выводит в текст открывающий таг
    procedure WriteTagOpenU(const ElemName: RawUTF8; const OnNewLine: Boolean = true);
    ///Процедура выводит в текст открывающий таг со списком аттрибутов
    procedure WriteTagOpenExU(const ElemName: RawUTF8; const ElemAttrs: RawUTF8=''; const isEmpty: Boolean=false);
    ///Процедура выводит в текст закрывающий таг
    procedure WriteTagCloseU(const ElemName: RawUTF8; const OnSameLine: Boolean = False);
    /// Процедура выводит в текст перевод строки
    procedure WriteCR; inline;
  end;


procedure WrtXMLBegin(wrt: TTextWriter; const Name, Attributes: RawUtf8);
procedure WrtTag(wrt: TTextWriter; const Name, Attributes: RawUtf8; const isOpen: Boolean; const isEmpty: Boolean=False);
procedure WrtTagClose(wrt: TTextWriter; const Name: RawUtf8);
procedure WrtTagEmpty(wrt: TTextWriter; const Name: RawUtf8; const Attributes: RawUtf8=''; const NoCloseTag: Boolean=True);
procedure WrtIdent(wrt: TTextWriter; const Level: Integer=0; const SpaceTab: Integer=0);
procedure WrtText(wrt: TTextWriter; const Tag,Val: RawUtf8); overload;
procedure WrtTextEsc(wrt: TTextWriter; const Tag,Val: RawUtf8; const Opt: Boolean=False); overload;
procedure WrtInt(wrt: TTextWriter; const Tag: RawUtf8; const Val: Integer; const Opt: Boolean=False); overload;
procedure WrtDate(wrt: TTextWriter; const Tag: RawUtf8; const Val: TDateTime; Opt: Boolean=False);
procedure WrtDbl(wrt: TTextWriter; const Tag: RawUtf8; const Val: Double; const Prec: Integer=2; const Opt: Boolean=False);
procedure WrtGuid(wrt: TTextWriter; const Tag: RawUtf8; const Val: TGuid; const TrimBrackets: Boolean = True);

implementation

procedure WrtXMLBegin(wrt: TTextWriter; const Name, Attributes: RawUtf8);
begin
  wrt.AddString('<?xml version="1.0" encoding="UTF-8"?>');
  wrt.AddCR;
  wrt.HumanReadableLevel:=0;
  wrt.Add('<'); wrt.AddString(Name);
  if Attributes<>'' then begin wrt.Add(' '); wrt.AddString(Attributes); end;
  wrt.Add('>');
end;

procedure WrtTag(wrt: TTextWriter; const Name, Attributes: RawUtf8; const isOpen: Boolean; const isEmpty: Boolean=False);
begin
  if isOpen then begin
//    wrt.AddCRAndIndent;
    wrt.AddCRAndIndent;
    wrt.HumanReadableLevel:=wrt.HumanReadableLevel+1;
    wrt.Add('<'); wrt.AddString(Name);
    if Attributes<>'' then begin wrt.Add(' '); wrt.AddString(Attributes); end;
    if isEmpty then begin
      wrt.Add(' ','/');
    end;
    wrt.Add('>');
  end else begin
    wrt.HumanReadableLevel:=wrt.HumanReadableLevel-1;
    wrt.AddCRAndIndent;
    wrt.Add('<', '/'); wrt.AddString(Name);
    wrt.Add('>');
  end;
//  if isOpen then wrt.HumanReadableLevel:=wrt.HumanReadableLevel+1;
end;
procedure WrtTagClose(wrt: TTextWriter; const Name: RawUtf8);
begin
  wrt.HumanReadableLevel:=wrt.HumanReadableLevel-1;
  wrt.AddCRAndIndent;
  wrt.Add('<','/'); wrt.AddString(Name); wrt.Add('>');
end;
procedure WrtTagEmpty(wrt: TTextWriter; const Name: RawUtf8; const Attributes: RawUtf8; const NoCloseTag: Boolean);
begin
  wrt.Add('<'); wrt.AddString(Name);
  if Attributes<>'' then begin wrt.Add(' '); wrt.AddString(Attributes); end;
  if NoCloseTag then begin
    wrt.Add(' ','/');
  end else begin
    wrt.Add('<', '/'); wrt.AddString(Name);
  end;
  wrt.Add('>');
//  wrt.AddCRAndIndent;
end;
procedure WrtIdent(wrt: TTextWriter; const Level: Integer; const SpaceTab: Integer);
var i: Integer;
begin
  if Level<1 then Exit;
  for i :=0 to Level-1 do
    if SpaceTab<1 then wrt.Add(#9)
                  else wrt.AddChars(' ',SpaceTab);
end;
procedure WrtText(wrt: TTextWriter; const Tag,Val: RawUtf8); overload;
begin
  wrt.AddCRAndIndent;
  wrt.Add('<'); wrt.AddString(Tag); wrt.Add('>');
  wrt.AddString(Val);
  wrt.Add('<','/'); wrt.AddString(Tag); wrt.Add('>');
end;
procedure WrtTextEsc(wrt: TTextWriter; const Tag,Val: RawUtf8; const Opt: Boolean=False); overload;
begin
  if (Val='') then begin
    if not Opt then begin wrt.AddCRAndIndent; wrt.Add('<'); wrt.AddString(Tag); wrt.AddString('/>'); end;
  end else begin
    wrt.AddCRAndIndent;
    wrt.Add('<'); wrt.AddString(Tag); wrt.Add('>');
    wrt.AddHtmlEscape(@Val[1]);
    wrt.Add('<','/'); wrt.AddString(Tag); wrt.Add('>');
  end;
end;
procedure WrtInt(wrt: TTextWriter; const Tag: RawUtf8; const Val: Integer; const Opt: Boolean=False); overload;
begin
  if (Val<>0) or (not Opt) then begin
    wrt.AddCRAndIndent;
    wrt.Add('<'); wrt.AddString(Tag); wrt.Add('>');
    wrt.Add(Val);
    wrt.Add('<','/'); wrt.AddString(Tag); wrt.Add('>');
  end;
end;
procedure WrtDbl(wrt: TTextWriter; const Tag: RawUtf8; const Val: Double; const Prec: Integer=2; const Opt: Boolean=False);
var r: RawUtf8;
begin
  if (Val<>0.0) or (not Opt) then begin
    wrt.AddCRAndIndent;
    //TODO: округление
    r:=DoubleToStr(Val);
    wrt.Add('<'); wrt.AddString(Tag); wrt.Add('>');
    wrt.AddString(r);
    wrt.Add('<','/'); wrt.AddString(Tag); wrt.Add('>');
  end;
end;
procedure WrtDate(wrt: TTextWriter; const Tag: RawUtf8; const Val: TDateTime; Opt: Boolean=False);
var r: RawUtf8; D,M,Y: Word;
begin
  if (Val<>0.0) or (not Opt) then begin
    DecodeDate(Val, Y,M,D);
    wrt.AddCRAndIndent;
    if Tag<>'' then WrtTag(wrt, Tag, '',True);
      WrtInt(wrt,'Year',Y);
      WrtInt(wrt,'Month',M);
      WrtInt(wrt,'Day',D);
    if Tag<>'' then WrtTag(wrt, Tag, '',False);
  end;
end;
procedure WrtGuid(wrt: TTextWriter; const Tag: RawUtf8; const Val: TGuid; const TrimBrackets: Boolean);
var r: RawUtf8; l: Integer;
begin
  r:=GuidToRawUtf8(Val);
  if TrimBrackets then begin
    l:=Length(r);
    if (r[1]='{') and (r[l]='}') then r:=Copy(r,2,l-2);
  end;
  WrtText(wrt, Tag, r);
end;


{ TDBDWriterXML }

function TDBDWriterXMLV1.AddSchemaFromFile(const FN: TFileName; const FileNameOnly: Boolean): Boolean;
begin

end;

function TDBDWriterXMLV1.AddSchemaFromResource(const ResID: string; const SchemaName: string): Boolean;
begin

end;

class procedure TDBDWriterXMLV1.AttrStringU(var Attr: RawUTF8; const Name: RawUTF8; const Value: string);
begin
  if (Value='') or (Name='') then Exit;
  Attr:=Attr + ' ' + Name + '="' + StringToUTF8(Value) + '"';
end;

function TDBDWriterXMLV1.BeginXML(const RootName, SchemaLocation: RawUTF8; const Addition: RawUtf8): Boolean;
var r: RawUtf8;
begin
  Result := (RootName<>''); if not Result then Exit;
  FRootName := RootName;
  Txt.AddString(XML_HEADER);
  Txt.AddCR;
  Txt.Add(cLt); Txt.AddString(FRootName);
  if SchemaLocation<>'' then begin
    r:='xmlns:xsi="'+XML_NAMESPACE+'"';
    Txt.Add(' '); Txt.AddString(r);
    Txt.AddString(XML_NAMESPACE_SCHEME_SLOCATION);
    Txt.AddString(SchemaLocation); Txt.Add(cDQ);
  end;
  if Addition<>'' then begin
    Txt.Add(' '); Txt.AddString(Addition);
  end;
  Txt.Add(cGT);
//  Txt.AddCR;
  FClosed:=False;
  FCurrentLevel:=0;
end;

constructor TDBDWriterXMLV1.Create(const FileName: TFileName; const aOptions: TDBDXMLWriterOptions);
begin
  inherited Create;
  FPricePrecision:= DBD_PRICE_PREC;
  FQuantityPrecision:= DBD_QUANTITY_PREC;
  FValuePrecision:= DBD_VALUE_PREC;
  SetOptions(aOptions);
  FCurrentLevel:=0;
try
  if FileName<>'' then Txt := TTextWriter.CreateOwnedFileStream(FileName)
  else begin
    ShowMsg('FileName is empty','TDBDWriterXMLV1.Create');
  end;
except
  on E: Exception do ShowMsg(E.Message,'TDBDWriterXMLV1.Create');
end;
  FReady := Assigned(Txt);
  FClosed := True;
end;

constructor TDBDWriterXMLV1.Create(Stream: TStream; const aOptions: TDBDXMLWriterOptions);
begin
  inherited Create;
  FPricePrecision:= DBD_PRICE_PREC;
  FQuantityPrecision:= DBD_QUANTITY_PREC;
  FValuePrecision:= DBD_VALUE_PREC;
  SetOptions(aOptions);
  FCurrentLevel:=0;
  if Assigned(Stream) then Txt := TTextWriter.Create(Stream);
  FReady := Assigned(Txt);
  FClosed := True;
end;

destructor TDBDWriterXMLV1.Destroy;
begin
  if FReady then Txt.FlushFinal;
  if Assigned(Txt) then FreeAndNil(Txt);
  inherited;
end;

procedure TDBDWriterXMLV1.EndXML;
begin
  Txt.AddCR;
  Txt.Add(cLt, cSL); Txt.AddString(FRootName); Txt.Add(cGT);
  FClosed := True;
end;

function TDBDWriterXMLV1.GetError: string;
begin
  Result:=FError;
end;

function TDBDWriterXMLV1.GetNamespaceSchemaLocation: TFileName;
begin
  Result:=FNamespaceSchemaLocation;
end;

function TDBDWriterXMLV1.GetOptions: TDBDXMLWriterOptions;
begin
  Result:=FOptions;
end;

function TDBDWriterXMLV1.GetPricePrecision: Integer;
begin
  Result:=FPricePrecision;
end;

function TDBDWriterXMLV1.GetQuantityPrecision: Integer;
begin
  Result:=FQuantityPrecision;
end;

function TDBDWriterXMLV1.GetText: RawUTF8;
begin
  Result := Txt.Text;
end;

function TDBDWriterXMLV1.GetValuePrecision: Integer;
begin
  Result:=FValuePrecision;
end;

function TDBDWriterXMLV1.IsClosed: Boolean;
begin
  Result := FClosed;
end;

function TDBDWriterXMLV1.IsReady: Boolean;
begin
  Result := FReady and Assigned(Txt);
end;

function TDBDWriterXMLV1.isValid(const SchemaFile: TFileName; const isResource: Boolean): Boolean;
var w: WideString; sXml: WideString;
begin
  FError:='-';
  if isResource then begin
    w:=SchemaFromResource(SchemaFile);
    if w='' then begin
      FError :='Не удалось загрузить схему из ресурса "' + SchemaFile + '"';
      Result:=False;
      Exit;
    end;
  end else if FileExists(SchemaFile) then w:=Utf8ToWideString(StringFromFile(SchemaFile))
  else begin
    FError :='Не удалось загрузить схему из файла "' + SchemaFile + '"';
    Result:=False;
    Exit;
  end;
{$IFDEF FPC}
  FError:='';
{$ELSE}
  sXml := UTF8ToWideString(Txt.Text);
{$IFDEF  ISDELPHIXE2}
    if w      <> '' then FError := ValidateXMLString(sXml, w);
    if FError <> '' then FError := ValidateMSXML6(UTF8ToString(Txt.Text),'');
{$ELSE}
    if w      <> '' then FError := ValidateXMLString(sXml, w);
    if FError <> '' then FError := ValidateXMLDoc(UTF8ToString(Txt.Text),'');
{$ENDIF}
{$ENDIF}
  Result := (FError='');
end;

class function TDBDWriterXMLV1.SchemaFromResource(const ResID: string): WideString;
var r: RawByteString;
begin
  ResourceToRawByteString(ResID, RT_RCDATA, r);
  Result := Utf8ToWideString(r);
end;

procedure TDBDWriterXMLV1.SetNamespaceSchemaLocation(const Value: TFileName);
begin
  FNamespaceSchemaLocation := Value;
end;

procedure TDBDWriterXMLV1.SetOptions(const Value: TDBDXMLWriterOptions);
begin
  FOptions := Value;
end;

procedure TDBDWriterXMLV1.SetPricePrecision(const Value: Integer);
begin
  FPricePrecision := Value;
end;

procedure TDBDWriterXMLV1.SetQuantityPrecision(const Value: Integer);
begin
  FQuantityPrecision := Value;
end;

procedure TDBDWriterXMLV1.SetValuePrecision(const Value: Integer);
begin
  FValuePrecision := Value;
end;

class function TDBDWriterXMLV1.Transform(const XMLFile, StyleSheet: TFileName; out ResultStr: string): Boolean;
begin
  Result:=TransformXML(XMLFile, StyleSheet, ResultStr);
end;

class function TDBDWriterXMLV1.Validate(const XMLFile, SchemaFile: TFileName): Boolean;
begin
  Result:=ValidateXML(XMLFile, SchemaFile)='';
end;

procedure TDBDWriterXMLV1.WriteBooleanU(const ElemName: RawUTF8; const ElemValue: Boolean);
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  if ElemValue then Txt.AddString('true') else Txt.AddString('false');
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteBoolean(const ElemName: string; const ElemValue: Boolean);
begin
  WriteBooleanU(StringToUTF8(ElemName), ElemValue);
end;

procedure TDBDWriterXMLV1.WriteCharU(const ElemName: RawUTF8; const ElemValue: AnsiChar);
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  Txt.Add(ElemValue);
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteCR;
begin
  Txt.AddCR;
end;

procedure TDBDWriterXMLV1.WriteCurrency(const ElemName: string; const ElemValue: Currency; const Prec: Integer; const Scale: Integer);
begin
  WriteCurrencyU(StringToUTF8(ElemName), ElemValue, Prec, Scale);
end;

procedure TDBDWriterXMLV1.WriteCurrencyU(const ElemName: RawUTF8; const ElemValue: Currency; const Prec: Integer; const Scale: Integer);
var c:Currency;
var i: Int64 absolute ElemValue; s: string; r: RawUtf8; d: Double;
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  if (Scale<>0) and (Scale<>1) then d:=ElemValue/Scale else d:=ElemValue;
  s:=Format('%.2f',[d], DBDFormatSettings);
    Txt.AddString(StringToUtf8(s));
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteChar(const ElemName: string; const ElemValue: AnsiChar);
begin
  WriteCharU(StringToUTF8(ElemName), ElemValue);
end;

procedure TDBDWriterXMLV1.WriteDateU(const ElemName: RawUTF8; const ElemValue: TDateTime);
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  Txt.AddString(DateToIso8601Text(ElemValue));
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteDate(const ElemName: string; const ElemValue: TDateTime);
begin
  WriteDateU(StringToUTF8(ElemName), ElemValue);
end;

procedure TDBDWriterXMLV1.WriteDateTime(const ElemName: string; const ElemValue: TDateTime);
begin
  WriteDateTime(StringToUTF8(ElemName), ElemValue);
end;

procedure TDBDWriterXMLV1.WriteDateTimeU(const ElemName: RawUTF8; const ElemValue: TDateTime);
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  Txt.AddString(DateTimeToIso8601Text(ElemValue));
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteDoubleU(const ElemName: RawUTF8; const ElemValue: Double; const Prec: Integer; const Scale: Integer);
var r: RawUTF8; pr: Integer; d: Double; s: string;
begin
  if Prec<0 then pr:=DBD_VALUE_PREC else pr:=Prec;
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  if (Scale<>0) and (Scale<>1) then d:=ElemValue/Scale else d:=ElemValue;
//  r := StringToUTF8(DBDDoubleToString(d,pr));
  s:=FloatToStringP(d,pr);
  r := StringToUTF8(s);
  r:=DBDTruncString(r);
  Txt.Addstring(r);
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteDouble(const ElemName: string; const ElemValue: Double; const Prec: Integer; const Scale: Integer);
begin
  WriteDoubleU(StringToUTF8(ElemName), ElemValue, Prec, Scale);
end;

procedure TDBDWriterXMLV1.WriteIntegerU(const ElemName: RawUTF8; const ElemValue: Integer);
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  Txt.Add(ElemValue);
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteIdent;
var i: Integer;
begin
  if not (dbdxmlNodeAutoIndent in FOptions) then Exit;
  if FCurrentLevel<1 then Exit;
  for i :=0 to FCurrentLevel-1 do
     Txt.Add(cTab);
//     Txt.AddString('  ');
end;

procedure TDBDWriterXMLV1.WriteInteger(const ElemName: string; const ElemValue: Integer);
begin
  WriteIntegerU(StringToUTF8(ElemName), ElemValue);
end;

procedure TDBDWriterXMLV1.WritePriceU(const ElemName: RawUTF8; const ElemValue: Double; const Scale: Integer);
var d: Double;
begin
  if (Scale<>0) and (Scale<>1) then d:=ElemValue/Scale else d:=ElemValue;
  WriteDoubleU(ElemName, d, FPricePrecision);
end;

procedure TDBDWriterXMLV1.WritePercent(const ElemName: string; const ElemValue: Double);
var i: Integer;
begin
  i:=Round(ElemValue);
  if i=ElemValue then WriteInteger(ElemName, i)
                 else WriteCurrency(ElemName,ElemValue);
end;

procedure TDBDWriterXMLV1.WritePrice(const ElemName: string; const ElemValue: Double; const Scale: Integer);
var d: Double;
begin
  if (Scale<>0) and (Scale<>1) then d:=ElemValue/Scale else d:=ElemValue;
  WriteDoubleU(StringToUTF8(ElemName),d, FPricePrecision);
end;

procedure TDBDWriterXMLV1.WriteQuantityU(const ElemName: RawUTF8; const ElemValue: Double);
begin
  WriteDoubleU(ElemName, ElemValue, FQuantityPrecision);
end;

procedure TDBDWriterXMLV1.WriteQuantity(const ElemName: string; const ElemValue: Double);
begin
  WriteDoubleU(StringToUTF8(ElemName), ElemValue, FQuantityPrecision);
end;

procedure TDBDWriterXMLV1.WriteString(const ElemName, ElemValue: string; HtmlEscape: Boolean);
var r,ev: RawUTF8;
begin
  WriteUTF8U(StringToUTF8(ElemName),StringToUTF8(ElemValue),HtmlEscape);
Exit;
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  r := StringToUTF8(ElemName);
  Txt.Add(cLt); Txt.AddString(r); Txt.Add(cGt);
  if HtmlEscape then Txt.AddHtmlEscapeString(ElemValue)
                else Txt.AddString(StringToUTF8(ElemValue));
  Txt.Add(cLT, cSL); Txt.AddString(r); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteStringU(const ElemName: RawUTF8; const ElemValue: string; HtmlEscape: Boolean);
var r,ev: RawUTF8;
begin
  WriteUTF8U(ElemName,StringToUTF8(ElemValue),HtmlEscape);
Exit;
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  if HtmlEscape then Txt.AddHtmlEscapeString(ElemValue)
                else Txt.AddString(StringToUTF8(ElemValue));
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteUTF8U(const ElemName, ElemValue: RawUTF8; HtmlEscape: Boolean);
var ev: RawUTF8;
begin
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  ev:=DBDTextNormalization(ElemValue,dbdTNODust);
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
  if HtmlEscape then AddHtmlEscapeUTF8(Txt,ev)
                else Txt.AddString(ev);
  Txt.Add(cLT, cSL); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteUTF8(const ElemName: string; const ElemValue: RawUTF8; HtmlEscape: Boolean);
var r,ev: RawUTF8;
begin
  WriteUTF8U(StringToUTF8(ElemName),ElemValue,HtmlEscape);
Exit;
  r := StringToUTF8(ElemName);
  if (dbdxmlEachElemOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  ev:=DBDTextNormalization(ElemValue,dbdTNODust);
  Txt.Add(cLt); Txt.AddString(r); Txt.Add(cGt);
  if HtmlEscape then AddHtmlEscapeUTF8(Txt,ev)
                else Txt.AddString(ev);
  Txt.Add(cLT, cSL); Txt.AddString(r); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteValue(const ElemName: string; const ElemValue: Double);
begin
  WriteDoubleU(StringToUTF8(ElemName), ElemValue, FValuePrecision);
end;

procedure TDBDWriterXMLV1.WriteValueU(const ElemName: RawUTF8; const ElemValue: Double);
begin
  WriteDoubleU(ElemName, ElemValue, FValuePrecision);
end;

procedure TDBDWriterXMLV1.WriteTagCloseU(const ElemName: RawUTF8; const OnSameLine: Boolean);
begin
  if (not OnSameLine) or (dbdxmlEachTagOnNewLine in FOptions) then Txt.AddCR;
  Dec(FCurrentLevel);
  WriteIdent;
  Txt.Add(cLt, cSl); Txt.AddString(ElemName); Txt.Add(cGt);
end;

procedure TDBDWriterXMLV1.WriteTagOpenU(const ElemName: RawUTF8; const OnNewLine: Boolean);
begin
  if OnNewLine or (dbdxmlEachElemOnNewLine in FOptions) or (dbdxmlEachTagOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Inc(FCurrentLevel);
  Txt.Add(cLt); Txt.AddString(ElemName); Txt.Add(cGt);
//  if (dbdxmlEachTagOnNewLine in FOptions) then Txt.AddCR;
end;

procedure TDBDWriterXMLV1.WriteTagOpenExU(const ElemName, ElemAttrs: RawUTF8; const isEmpty: Boolean);
begin
  if (dbdxmlEachElemOnNewLine in FOptions) or (dbdxmlEachTagOnNewLine in FOptions) then Txt.AddCR;
  WriteIdent;
  Inc(FCurrentLevel);
  Txt.Add(cLt); Txt.AddString(ElemName);
  if ElemAttrs<>'' then begin Txt.Add(cSP); Txt.AddString(ElemAttrs); end;
  if isEmpty then Txt.Add(cSL);
  Txt.Add(cGt);
//  if (dbdxmlEachTagOnNewLine in FOptions) then Txt.AddCR;
end;

procedure initModule;
var tf: TFormatSettings;
begin
  {$IFDEF ISDELPHIXE2}
  tf := TFormatSettings.Create(0);
  {$ELSE}
    GetLocaleFormatSettings(0,tf);
  {$ENDIF}
  tf.DecimalSeparator := '.';
  TDBDWriterXMLV1.XMLFormatSettings:=tf;
end;

initialization
  initModule;
end.