
//////////////////////////////////////////////////
//  DB Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  CRXml
//////////////////////////////////////////////////

{$IFNDEF EntityDAC}
{$I Dac.inc}
unit CRXml;
{$ENDIF}

interface

uses
  Classes, SysUtils,
{$IFDEF NEXTGEN}
  Generics.Collections,
{$ELSE}
  Contnrs,
{$ENDIF}
{$IFNDEF CLR}
  {$IFNDEF EntityDAC}
  CLRClasses,
  {$ELSE}
  EntityDAC.Common.CLRClasses,
  {$ENDIF}
{$ENDIF}
{$IFNDEF EntityDAC}
  CRTypes;
{$ELSE}
  EntityDAC.Common.Types;
{$ENDIF}

type
  StreamWriter = class
  private
    FStream: TStream;
    FReleaseStream: Boolean;
    FEncoding: Encoding;
  public
    constructor Create(const path: string; Append: Boolean); overload;
    constructor Create(output: TStream; aEncoding: Encoding); overload;
    destructor Destroy; override;

    procedure Close;
    procedure Flush;
    procedure Write(const value: WideString);
    procedure WriteLine(const value: WideString);
  end;

  XmlException = class(Exception);

  XmlNodeType = (ntNone, ntElement, ntAttribute, ntEndElement, ntComment, ntDeclaration, ntDocumentType, ntText);
  XmlReadState = (Initial, Interactive, Error, EndOfFile, Closed);

  XmlTextReader = class
  private
    FBlocks: TStringList;
    FStream: TStream;
    FTmpBlock: TBytes;
    FStreamPosition: int64;// When this class created through constructor Create(str: string), FStreamPosition = FFullSize
    FBlockSize: integer;
    FFullSize: int64;
    FMaxNumBlock: integer;
    FCurPosition: integer;
    FActualPosition: integer;
    FLastBlockSize: integer;
    FPrefix: string;
    FValue: string;
    FName: string;
    FNodeType: XmlNodeType;
    FAttrNames: TStringList;
    FAttrPrefix: TStringList;
    FAttrValues: TStringList;
    FState: XmlReadState;
    FCurrElementName: string;
    function GetHasAttributes: Boolean;
    function GetDepth: integer;
    function GetAttributeCount: integer;
    procedure GetXMLNodeAttributes(const Node: string; AttrNames, AttrValues: TStrings);
    procedure InitInstance;
    function GetEof: Boolean;
    function LoadNextBlock(Count: integer): boolean;
    procedure FreeLastBlocks(Count: integer);
    function ReadTo(const SubStr: string; out ResultStr: string;
      const AdvLenth: integer = 0): Boolean; overload;
    function IsToken(const SubStr: string): Boolean;
    function GetNextSymbol: char;
    function MoveTo(const Lexem: string): Boolean;
  protected
    property AttrNames: TStringList read FAttrNames;
    property AttrValues: TStringList read FAttrValues;
  public
    constructor Create(Stream: TStream); overload;
    constructor Create(const Str: string {UTF8}); overload; // Parameter "Str" mast content only XML Text, Url for XML not supported
    destructor Destroy; override;

    procedure MoveToAttribute(i: integer); overload;
    function MoveToAttribute(name: string): Boolean; overload;
    function Read: boolean;
    function Items(const Index: Integer): string; overload; virtual;
    function Items(const AttrName: string): string; overload;

    property Name: string read FName;
    property Prefix: string read FPrefix;
    property Value: string read FValue;
    property NodeType: XmlNodeType read FNodeType;
    property AttributeCount: integer read GetAttributeCount;
    property Depth: integer read GetDepth;
    property ReadState: XmlReadState read FState;
    property Eof: Boolean read GetEof;
    property HasAttributes: Boolean read GetHasAttributes;
  end;

  XmlFormatting = (fmtNone, fmtIndented);
  XmlWriteState = (wsAttribute, wsClosed, wsContent, wsElement, wsStart);

  XmlTextWriter = class
  private
    FText: WideString;
    FFormatting: XmlFormatting;
    FIndentation: Integer;
    FIndentChar: WideChar;
    FQuoteChar: WideChar;
    FWriteState: XmlWriteState;
    FDepth: Integer;
    FPosStack: TStack{$IFDEF NEXTGEN}<Pointer>{$ENDIF};
    FTagStack: TStringList;
    FWriter: StreamWriter;
    function IndentStr: WideString;
    function PopTagName: string;
    procedure PushTagName(const TagName: string);
    procedure InternalCloseStartTag;
  protected
    procedure InternalWriteStartElement(const Prefix, LocalName, ns: string);
    procedure InternalWriteElementString(const LocalName, ns: string; Value: WideString);
    procedure InternalWriteAttributeString(const Prefix, LocalName, ns: string; Value: WideString);
    procedure InternalWriteEndElement;
    procedure FlushData;
  public
    constructor Create(w: StreamWriter);
    destructor Destroy; override;

    procedure WriteStartElement(const LocalName: string); overload;
    procedure WriteStartElement(const Prefix, LocalName, ns: string); overload;
    procedure WriteStartElement(const LocalName, ns: string); overload;
    procedure WriteEndElement;
    procedure WriteFullEndElement;
    procedure WriteString(const Text: WideString);
    procedure WriteElementString(const LocalName, ns: string; Value: WideString); overload;
    procedure WriteElementString(const LocalName: string; Value: WideString); overload;

    procedure WriteAttributeString(const LocalName: string; Value: WideString); overload;
    procedure WriteAttributeString(const Prefix, LocalName, ns: string; Value: WideString); overload;
    procedure Close;

    property Formatting: XmlFormatting read FFormatting write FFormatting;
    property Indentation: Integer read FIndentation write FIndentation;
    property IndentChar: WideChar read FIndentChar write FIndentChar;
    property QuoteChar: WideChar read FQuoteChar write FQuoteChar;
    property WriteState: XmlWriteState read FWriteState;
  end;

function XMLEncode(const AStr: WideString): WideString;
function XMLDecode(const AStr: string): string;

implementation

uses
  Math,
{$IFNDEF EntityDAC}
  CRFunctions, CRParser, MemUtils;
{$ELSE}
  EntityDAC.Common.Functions, EntityDAC.Common.Parser, EntityDAC.Common.MemUtils;
{$ENDIF}

const
  XMLLineSeparator = #13#10;
  SInvalidXML = 'Invalid XML';

type
  TXmlParser = class(TParser)
  public
    constructor Create(const Text: string); override;
    function GetNextIdent(out Lexem: string): integer;
  end;

var
  XmlSymbolLexems, XmlKeywordLexems: TIntValueStringList;
  XmlSymbolChars: TCharSet;

procedure DeleteInvisibleSymbol(var s: string);
var
  i: Integer;
begin
  for i := Length(s) downto 1 do
    if not CharInSet(s[i], ['a'..'z', 'A'..'Z']) and (s[i] <> '.') and (s[i] <> ':') then
      Delete(s, i, 1);
end;

{ XmlTextReader }

function XmlTextReader.LoadNextBlock(Count: integer): boolean;
var
  Str: string;
begin
  Result := False;
  if FStream = nil then
    Exit;

  if FBlocks.Count >= Count then begin
    Result := True;
    Exit;
  end;

  FLastBlockSize := FStream.Read(FTmpBlock[0], FBlockSize);
  FStreamPosition := FStream.Position;
  Result := FLastBlockSize <> 0;
  if Result then begin
    Str := Encoding.Default.GetString(FTmpBlock, 0, FLastBlockSize);
    FBlocks.Add(Str);
    FCurPosition := 1;
  end;
end;

procedure XmlTextReader.FreeLastBlocks(Count: integer);
begin
  while FBlocks.Count > Count do
    FBlocks.Delete(0);
end;

function XmlTextReader.GetEof: Boolean;
begin
  Result := (((FStreamPosition - FLastBlockSize) + FActualPosition) > FFullSize) or
            ((FCurPosition - 1) > FLastBlockSize);
end;

function XmlTextReader.IsToken(const SubStr: string): boolean;
var
  i, BlockPos, BlockNo: integer;
begin
  BlockPos := FActualPosition;
  BlockNo := 0;

  for i := 1 to Length(SubStr) do begin
    if BlockPos > Length(FBlocks[BlockNo]) then begin
      Inc(BlockNo);
      if not LoadNextBlock(BlockNo + 1) then begin
        Result := False;
        Exit;
      end;
      BlockPos := 1;
    end;

    if FBlocks[BlockNo][BlockPos] <> SubStr[i] then begin
      Result := False;
      Exit;
    end;
    Inc(BlockPos);
  end;

  FActualPosition := BlockPos;
  FCurPosition := BlockPos;

  FreeLastBlocks(1);
  if (FActualPosition > Length(FBlocks[0])) and (FStream <> nil) then begin
    FreeLastBlocks(0);
    LoadNextBlock(1);
    FActualPosition := 1;
  end;

  Result := True;
end;

function XmlTextReader.MoveTo(const Lexem: string): boolean;
begin
  Result := False;
  while (FActualPosition <= FFullSize) and not Eof do begin
    if IsToken(Lexem) then begin
      Result := True;
      Exit;
    end;

    Inc(FActualPosition);

    if (FActualPosition > Length(FBlocks[0])) and (FStream <> nil) then begin
      FreeLastBlocks(0);
      LoadNextBlock(1);
      FActualPosition := 1;
    end;
  end;
end;

function XmlTextReader.GetNextSymbol: char;
begin
  if (FCurPosition > Length(FBlocks[0])) and (FStream <> nil) then begin
    FreeLastBlocks(0);
    LoadNextBlock(1);
    FActualPosition := 1;
  end;
  Result := FBlocks[0][FCurPosition];
  Inc(FCurPosition);
end;

function XmlTextReader.ReadTo(const SubStr: string; out ResultStr: string;
  const AdvLenth: integer): boolean;
var
  i, BlockNo, FoundBlockNo, SubStrIndex, SubStrLen,
  CurPos, StartPos, FoundPos, Len, Offset, l: integer;
begin
  BlockNo := 0;
  FoundBlockNo := 0;
  SubStrIndex := 1;
  StartPos := FActualPosition;
  FoundPos := -1;
  SubStrLen := Length(SubStr);
  Result := False;
  CurPos := StartPos;

  while BlockNo <= (FMaxNumBlock - 1) do begin
    while CurPos <= Length(FBlocks[BlockNo]) do begin

      if FBlocks[BlockNo][CurPos] <> SubStr[SubStrIndex] then begin
        SubStrIndex := 1;
        FoundPos := -1;
        Inc(CurPos);
        Continue;
      end;

      if FoundPos = -1 then begin
        FoundPos := CurPos;
        FoundBlockNo := BlockNo;
      end;

      if SubStrIndex = SubStrLen then begin
        Len := FoundPos - StartPos + FBlockSize * FoundBlockNo + AdvLenth;
        SetLength(ResultStr, Len);

        if Len > FBlockSize - StartPos + 1 then
          Len := FBlockSize - StartPos + 1;
        Move(FBlocks[0][StartPos], ResultStr[1], Len * sizeof(char));
        Offset := Len + 1;

        i := 1;
        Len := Length(ResultStr) - Offset + 1;
        while Len > 0 do begin
          if i >= FBlocks.Count then
            LoadNextBlock(FBlocks.Count + 1);

          l := Min(Len, FBlockSize);
          Move(FBlocks[i][1], ResultStr[Offset], l * sizeof(char));
          Inc(Offset, l);
          Dec(Len, l);
          Inc(i);
        end;

        FreeLastBlocks(FBlocks.Count - FoundBlockNo);

        FCurPosition := FoundPos;
        FActualPosition := FoundPos;
        Result := True;
        Exit;
      end;

      Inc(CurPos);
      Inc(SubStrIndex);
    end;

    Inc(BlockNo);
    CurPos := 1;
    if not LoadNextBlock(BlockNo + 1) then
      Exit;
  end;
end;

constructor XmlTextReader.Create(Stream: TStream);
begin
  inherited Create;
  FBlocks := TStringList.Create;
  FStream := Stream;
  FStream.Position := 0;
  FLastBlockSize := 0;
  FStreamPosition := 0;
  FFullSize := FStream.Size;
  FBlockSize := 8192;
  SetLength(FTmpBlock, FBlockSize);
  FMaxNumBlock := (FFullSize div FBlockSize) + 1;
  FActualPosition := 1;
  FCurPosition := 1;
  LoadNextBlock(1);
  InitInstance;
end;

constructor XmlTextReader.Create(const Str: string);
begin
  inherited Create;
  FBlocks := TStringList.Create;
  FBlocks.Add(Str); // Count of blocks always  = 1
  FStream := nil; // When  FStream = nil  procedure NormalizeBuffer not working
  FFullSize := Length(Str);
  FLastBlockSize := FFullSize;
  FStreamPosition := FFullSize;
  FBlockSize := FFullSize;
  FMaxNumBlock := 1;
  FActualPosition := 1;
  FCurPosition := 1;
  InitInstance;
end;

destructor XmlTextReader.Destroy;
begin
  FBlocks.Free;
  FAttrNames.Free;
  FAttrPrefix.Free;
  FAttrValues.Free;

  inherited;
end;

procedure XmlTextReader.InitInstance;
begin
  FState := Initial;
  FNodeType := ntNone;
  FAttrNames := TStringList.Create;
  FAttrPrefix := TStringList.Create;
  FAttrValues := TStringList.Create;
  FCurrElementName := '';
end;

function XmlTextReader.Read: boolean;
var
  EndTagName, Value: string;
  IsTextFound: Boolean;
  a: char;
begin
  Result := False;

  FAttrNames.Clear;
  FAttrValues.Clear;
  FAttrPrefix.Clear;

  if FState in [Initial, Interactive] then begin
    IsTextFound := False;
    if NodeType = ntElement then begin
      a := GetNextSymbol;
      while (a <> '<') and not Eof do begin
        if CharInSet(a, ['a'..'z', 'A'..'Z', '0'..'9', '.', ':']) then begin
          IsTextFound := True;
          break;
        end;
        a := GetNextSymbol;
      end;
      if IsTextFound then
        FNodeType := ntText;
    end;

    if not IsTextFound then begin
      if not MoveTo('<') then begin
        if Eof then
          Exit;
        FState := Error;
        XmlException.Create('Root element missing');
      end;

      if IsToken('?') then
        FNodeType := ntDeclaration
      else
      if IsToken('!--') then
        FNodeType := ntComment
      else if IsToken('!DOCTYPE') then
        FNodeType := ntDocumentType
      else if IsToken('/') then begin
        FNodeType := ntEndElement;
      end
      else
        FNodeType := ntElement;
    end;
    FState := Interactive;
  end;

  FName := '';
  FValue := '';
  FPrefix := '';

  case FNodeType of
    ntDeclaration: begin
      ReadTo(' ', Value);
      FName := Trim(Value);
      if  not ReadTo('?>', Value) then
      begin
        FState := Error;
        raise XmlException.Create('Invalid declaration tag');
      end;
      FValue := Trim(Value);
      Result := True;
    end;

    ntComment: begin
      if not ReadTo('-->', Value) then
      begin
        FState := Error;
        raise XmlException.Create('Invalid comment tag');
      end;
      FValue := Trim(Value);
      Result := True;
    end;

    ntDocumentType: begin
      if not ReadTo('[<', Value) then begin
        FState := Error;
        raise XmlException.Create('Invalid Document type tag');
      end;
      FName := Trim(Value);
      ReadTo('>]', Value);
      FValue := Trim(Value);
      Result := True;
    end;

    ntEndElement: begin
      Result := ReadTo('>', Value);
      FName := Trim(Value);
    end;

    ntElement: begin
      if ReadTo('>', Value, 1) then begin
        FName := Trim(Copy(Value, 1, Pos(' ', Value) - 1));
        if FName = '' then
          FName := Trim(Copy(Value, 1, Pos('>', Value) - 1));

        Delete(Value, 1, Length(FName));
        GetXMLNodeAttributes({$IFNDEF EntityDAC}CRFunctions{$ELSE}EntityDAC.Common.Functions{$ENDIF}.UTF8Decode(AnsiString(Value)), FAttrNames, FAttrValues);

        FCurrElementName := FName;
        if FName[Length(FName)] = '/' then
          Delete(FName, Length(FName), 1);

        Result := True;
      end;
    end;

    ntText: begin
      EndTagName := FCurrElementName;
      DeleteInvisibleSymbol(EndTagName);
      EndTagname := '</' + EndTagName + '>';

      if FCurrElementName[Length(FCurrElementName)] <> '/' then begin
        Inc(FActualPosition);
        ReadTo(EndTagName, Value);
        FValue := XMLDecode({$IFNDEF EntityDAC}CRFunctions{$ELSE}EntityDAC.Common.Functions{$ENDIF}.UTF8Decode(AnsiString(Trim(Value))));
      end;
      Result := True;
    end;
  else
    begin
     FState := Error;
     Assert(False);
    end;
  end;
end;

procedure XmlTextReader.GetXMLNodeAttributes(const Node: string; AttrNames, AttrValues: TStrings);
var
  Parser: TXmlParser;
  Code: integer;
  Lexem, AttrName, AttrValue, AttrPrefix: string;
  WithColon: boolean;
begin
  Parser := TXmlParser.Create(Node);
  try
    while True do begin
      Code := Parser.GetNextIdent(Lexem);
      case Code of
        lcEnd, 18, 20: // '<', '>'
          break;
        lcIdent: begin
          WithColon := False;
          AttrName := Lexem;
          AttrPrefix := '';
          Code := Parser.GetNextIdent(Lexem);
          if Code = lcIdent then begin
            AttrName := Lexem;
            Code := Parser.GetNextIdent(Lexem);
          end;
          if Code in [16, 19] then begin
            if Code = 16 then begin // ':'
              Code := Parser.GetNextIdent(Lexem);
              if Code <> lcIdent then
                raise XmlException.Create(SInvalidXML);
              AttrPrefix := AttrName;
              AttrName := AttrPrefix + ':' + Lexem;
              Code := Parser.GetNextIdent(Lexem);
              WithColon := True;
            end;

            if Code = 19 then begin // '='
              Code := Parser.GetNext(Lexem);
              if (Code <> lcIdent) and (Code <> lcString) then
                raise XmlException.Create(SInvalidXML);
              AttrValue := XMLDecode(Lexem);
              if WithColon and (LowerCase(AttrName) = 'name') then
                AttrName := ':' + AttrName;
              AttrNames.Add(AttrName);
              AttrValues.Add(AttrValue);
              FAttrPrefix.Add(AttrPrefix);
            end;
          end;
        end;
      end;
    end;
  finally
    Parser.Free;
  end;
  Assert(AttrNames.Count = AttrValues.Count);
end;

function XMLEncode(const AStr: WideString): WideString;
var
  sb: WideStringBuilder;
begin
  sb := WideStringBuilder.Create(AStr, Length(AStr));
  try
    sb.Replace('&', '&#x26;');
    sb.Replace('''', '&#x27;');
    sb.Replace('"', '&#x22;');
    sb.Replace('<', '&#x3c;');
    sb.Replace('>', '&#x3e;');
    Result := sb.ToString;
  finally
    sb.Free;
  end;
end;

function XMLDecode(const AStr: string): string;
var
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(AStr, Length(AStr));
  try
    sb.Replace('&#x27;', '''');
    sb.Replace('&#x39;', '''');
    sb.Replace('&#x92;', '''');
    sb.Replace('&#x96;', '''');
    sb.Replace('&#x22;', '"');
    sb.Replace('&#x3c;', '<');
    sb.Replace('&#x3e;', '>');
    sb.Replace('&#x26;', '&');
    sb.Replace('&amp;', '&');
    sb.Replace('&quot;', '"');
    sb.Replace('&gt;', '>');
    sb.Replace('&lt;', '<');
    sb.Replace('&#13;', #13);
    sb.Replace('&#10;', #10);
    Result := sb.ToString;
  finally
    sb.Free;
  end;
end;

function XmlTextReader.Items(const Index: Integer): string;
begin
  Result := FAttrValues[Index];
end;

function XmlTextReader.Items(const AttrName: string): string;
begin
  Result := Items(FAttrNames.IndexOf(AttrName));
end;

function XmlTextReader.GetAttributeCount: integer;
begin
  Result := FAttrNames.Count;
end;

procedure XmlTextReader.MoveToAttribute(i: integer);
begin
  try
    FName := FAttrNames[i];
    FValue := FAttrValues[i];
    FPrefix := FAttrPrefix[i];
  except
    raise XmlException.Create(Format('Attribute not found (%d)', [i]));
  end;
end;

function XmlTextReader.MoveToAttribute(name: string): Boolean;
begin
  try
    MoveToAttribute(FAttrNames.IndexOf(name));
    Result := True;
  except
    Result := False;
  end;
end;

function XmlTextReader.GetDepth: integer;
begin
  Result := 0;
end;

function XmlTextReader.GetHasAttributes: Boolean;
begin
  Result := FAttrNames.Count > 0;
end;

{ XmlTextWriter }

constructor XmlTextWriter.Create(w: StreamWriter);
begin
  FFormatting := fmtNone;
  FIndentation := 2;
  FIndentChar := ' ';
  FQuoteChar := '"';
  FWriteState := wsStart;
  FDepth := 0;
  FPosStack := TStack{$IFDEF NEXTGEN}<Pointer>{$ENDIF}.Create;
  FTagStack := TStringList.Create;
  FWriter := w;
end;

destructor XmlTextWriter.Destroy;
begin
  FPosStack.Free;
  FTagStack.Free;

  inherited;
end;

procedure XmlTextWriter.InternalWriteStartElement(const Prefix, LocalName, ns: string);
var
  EndTagPos: Integer;
begin
  InternalCloseStartTag;
  if FWriteState = wsContent then
    FlushData;

  if FDepth > 0 then
    FText := FText + XMLLineSeparator;

  if Prefix <> '' then
    FText := FText + IndentStr + '<' + Prefix + ':' + LocalName
  else
    FText := FText + IndentStr + '<' + LocalName;

  if ns <> '' then
    if Prefix <> '' then
      FText := FText + ' ' + 'xmlns:' + Prefix + '=' + FQuoteChar + ns + FQuoteChar
    else
      FText := FText + ' ' + 'xmlns=' + FQuoteChar + ns + FQuoteChar;

  EndTagPos := Length(FText);

  inc(FDepth);

  FPosStack.Push(PtrOffset(nil, EndTagPos));
  if Prefix <> '' then
    PushTagName(Prefix + ':' + LocalName)
  else
    PushTagName(LocalName);

  FWriteState := wsElement;
end;

procedure XmlTextWriter.InternalWriteElementString(const LocalName, ns: string; Value: WideString);
begin
  InternalCloseStartTag;
  if FWriteState = wsElement then
    inc(FDepth);
  FText := FText + XMLLineSeparator;
  FText := FText + IndentStr + '<' + LocalName;

  if ns <> '' then
    FText := FText + ' xmlns=' + FQuoteChar + ns + FQuoteChar + '>'
  else
    FText := FText + '>';

  if Value <> '' then
    FText := FText + XMLEncode(Value);
  FText := FText + '</' + LocalName + '>';
  if FWriteState = wsElement then
    dec(FDepth);
  FlushData;
  FWriteState := wsContent;
end;

procedure XmlTextWriter.InternalWriteAttributeString(const Prefix, LocalName, ns: string; Value: WideString);
var
  AttrPos: Integer;
  AttrStr: WideString;
begin
  if FWriteState in [wsElement, wsAttribute] then
    AttrPos := Integer(FPosStack.Pop {$IFDEF FPC}- nil{$ENDIF}) + 1
  else
    raise XmlException.Create('Token WriteAttributeString in state Content would result in an invalid XML document.');

  if Prefix <> '' then
    AttrStr := ' ' + Prefix + ':'
  else
    AttrStr := ' ';

  AttrStr := AttrStr + LocalName + '=' + FQuoteChar + XMLEncode(Value) + FQuoteChar;// + ' ';

  Insert(AttrStr, FText, AttrPos);
                                                           
  AttrPos := AttrPos + Length(AttrStr);

  if ns <> '' then begin
    AttrStr := 'xmlns:' + Prefix + '=' + FQuoteChar + ns + FQuoteChar;// + ' ';
    Insert(AttrStr, FText, AttrPos);
    AttrPos := AttrPos + Length(AttrStr);
  end;

  FPosStack.Push(PtrOffset(nil, AttrPos - 1));
  FWriteState := wsAttribute;
end;

procedure XmlTextWriter.FlushData;
begin
  FWriter.Write(FText);
  FText := '';
end;

procedure XmlTextWriter.Close;
begin
  FlushData;
end;

procedure XmlTextWriter.WriteStartElement(const LocalName: string);
begin
  InternalWriteStartElement('', LocalName, '');
end;

procedure XmlTextWriter.WriteStartElement(const Prefix, LocalName, ns: string);
begin
  if (Prefix <> '') and (ns = '') then
    raise XmlException.Create('Cannot use a prefix with an empty namespace.');

  InternalWriteStartElement(Prefix, LocalName, ns);
end;

procedure XmlTextWriter.WriteStartElement(const LocalName, ns: string);
begin
  InternalWriteStartElement('', LocalName, ns);
end;

procedure XmlTextWriter.WriteEndElement;
begin
  dec(FDepth);
  if (FWriteState = wsAttribute) then begin
    FText := FText + ' />';
    PopTagName;
    FWriteState := wsContent;
  end
  else
    InternalWriteEndElement;
  FlushData;
end;

procedure XmlTextWriter.InternalWriteEndElement;
var
  Len: Integer;
begin
  InternalCloseStartTag;
  Len := Length(FText);
  if (FText = '') or ((Len >= 2) and (FText[Len] <> #10) and (FText[Len-1] <> #13)) then
    FText := FText + XMLLineSeparator + IndentStr + '</' + PopTagName + '>'
  else
    FText := FText + '</' + PopTagName + '>';
  FWriteState := wsContent;
end;

procedure XmlTextWriter.WriteFullEndElement;
begin
  dec(FDepth);
  InternalWriteEndElement;
  FlushData;
end;

procedure XmlTextWriter.WriteString(const Text: WideString);
begin
  InternalCloseStartTag;
  FText := FText + Text;
  FWriteState := wsContent;
end;

procedure XmlTextWriter.WriteElementString(const LocalName, ns: string; Value: WideString);
begin
  InternalWriteElementString(LocalName, ns, Value);
end;

procedure XmlTextWriter.WriteElementString(const LocalName: string; Value: WideString);
begin
  InternalWriteElementString(LocalName, '', Value);
end;

procedure XmlTextWriter.WriteAttributeString(const LocalName: string; Value: WideString);
begin
  InternalWriteAttributeString('', LocalName, '', Value);
end;

procedure XmlTextWriter.WriteAttributeString(const Prefix, LocalName, ns: string; Value: WideString);
begin
  if (Prefix <> '') and (ns = '') then
    raise XmlException.Create('Cannot use a prefix with an empty namespace.');

  InternalWriteAttributeString(Prefix, LocalName, ns, Value);
end;

function XmlTextWriter.IndentStr: WideString;
var
  i: Integer;
begin
  Result := '';
  if (FFormatting = fmtIndented) and (FDepth <> 0) then
    for i := 1 to FDepth * FIndentation do
      Result := Result + FIndentChar;
end;

function XmlTextWriter.PopTagName: string;
begin
  if FTagStack.Count = 0 then
    raise XmlException.Create('There was no XML start tag open.');
  Result := FTagStack[FTagStack.Count-1];
  FTagStack.Delete(FTagStack.Count-1);
end;

procedure XmlTextWriter.PushTagName(const TagName: string);
begin
  FTagStack.Add(TagName);
end;

procedure XmlTextWriter.InternalCloseStartTag;
begin
  if FWriteState in [wsElement, wsAttribute] then begin
    FPosStack.Pop;
    FText := TrimRight(FText);
    FText := FText + '>';
  end;
end;

{ StreamWriter }

constructor StreamWriter.Create(const path: string; Append: Boolean);
begin
  inherited Create;

  if FileExists(path) and Append then begin
    FStream := TFileStream.Create(path, fmOpenReadWrite);
    FStream.Seek(0, soFromEnd);
  end
  else
    FStream := TFileStream.Create(path, fmCreate);
  FReleaseStream := True;
  FEncoding := Encoding.Default;
end;

constructor StreamWriter.Create(output: TStream; aEncoding: Encoding);
begin
  inherited Create;

  FStream := output;
  FReleaseStream := False;
  FEncoding := aEncoding;
end;

destructor StreamWriter.Destroy;
begin
  if FReleaseStream then
    FStream.Free;

  inherited;
end;

procedure StreamWriter.Close;
begin
end;

procedure StreamWriter.Flush;
begin
end;

procedure StreamWriter.Write(const value: WideString);
var
  bytes: TBytes;
begin
  bytes := FEncoding.{$IFNDEF VER5}GetBytes{$ELSE}GetBytesWide{$ENDIF}(value);
  FStream.Write(Pointer(bytes)^, Length(bytes));
end;

procedure StreamWriter.WriteLine(const value: WideString);
begin
  Write(value + XMLLineSeparator);
end;

{ TXmlParser }

constructor TXmlParser.Create(const Text: string);
begin
  inherited;

  FSymbolLexems := XmlSymbolLexems;
  FSymbolChars := XmlSymbolChars;

  FKeywordLexems := XmlKeywordLexems;
  FOmitKeywords := True; // XmlKeywordLexems.Count = 0
end;

function TXmlParser.GetNextIdent(out Lexem: string): integer;
var
  i: integer;
begin
{$IFDEF PERF_COUNTER}
  PerfCounters[2].Start;//}
  try
{$ENDIF}
  Result := InternalGetNext; // Result is not in KeywordLexems

  if Result = lcIdent then begin// Optimize
    if Result > 0 then begin
      Assert(FLexem <> '');
      Lexem := FLexem
    end
    else begin
      if FLexemLength = 0 then
        Lexem := ''
      else
      begin
        Assert(FLexemPos > 0);
        Lexem := CopyText(FLexemPos, FLexemLength);
      end;
    end;
  end;

  if not FOmitKeywords and (Result = lcIdent) then begin
    Assert(FLexemPos > 0);
    Assert(FLexemLength > 0);
    i := FindLexemIndex(FLexemPos, FLexemLength, FKeywordLexems);
    if i <> -1 then begin
      Result := FKeywordLexems.Values[i];
      Assert(Result > 0);
      if Uppered then
        Lexem := AnsiUpperCase(Lexem);  //WAR problem with macros as key words
    end;
  end;

  Assert(Result <> - MaxInt);
{$IFDEF PERF_COUNTER}
  finally
    PerfCounters[2].Stop;
  end;
{$ENDIF}
end;

var
  i: integer;

initialization
  XmlSymbolLexems := TIntValueStringList.Create;
  XmlKeywordLexems := TIntValueStringList.Create;

  XmlSymbolLexems.Add(':', 16);
  XmlSymbolLexems.Add('=', 19);
  XmlSymbolLexems.Sort;

  // Performance optimization
  XmlSymbolChars := [];
  for i := 0 to XmlSymbolLexems.Count - 1 do
    XmlSymbolChars := XmlSymbolChars + [AnsiChar(XmlSymbolLexems[i][1])];

finalization
  XmlSymbolLexems.Free;
  XmlKeywordLexems.Free;

end.
